## This is the smb module for tkchooser2
## This file defines and provides a higher-level
## API to the underlying software layer (Netatalk, in this case)
## and handles non service-specific stuff
## Ideally a plugin relying on smb doesn't need to know
## what the underlying smb layer is built with. A
## CAP smb module could drop in and replace this one
## without the plugins caring at all.
##
## Major protocol modules must provide a start function,
## a setcurrzone function, and an unload function
##
## Ethan Gold <etgold@cs.vassar.edu> 2/24/98
## 3/1/99 - added smbmaster hook and -W switch
## 3/7/99 - reworked smbclient calls, error testing,
##          netbios name discovery
##
## Sander De Graaf <sendy@dds.nl> 10/nov/99
##        - Hopefully solved the quote problems.

if {[debug]} { puts "Loading samba smb module..." }

#### Smb global variables ####
## global "smbdir" defined in the config file
set smb_currzone ""
set smb_defzone ""
set smb_zonelist ""
set smb_zones(dummy) dum
unset smb_zones(dummy)

## delay between zonelist refreshed in milliseconds
## this doesn't need to happen very often
set smb_zonedelay 180000
set smb_afterID ""
set smb_domainflag 0
set smb_domain "-1"
set smb_domainsave 0
set smb_domainuser "-1"
set smb_domainpass "-1"
set smb_localname "localhost"

## external program names
set smbclient "smbclient"


#### End Smb global variables ####

############ Required functions - API to main ##############

## startup procedure
proc smb.start {} {
    global smb_currzone smb_defzone env smb_localname
    if {[debug]} { puts "smb: starting smb module" }
    ## get the local hostname - we'll replace this with
    ## a netbios name if we can.
    if {[info exists env(HOSTNAME)]} {
	set smb_tmpname $env(HOSTNAME)
    } else {
	catch {exec hostname -s} smb_tmpname
    }
    if {[debug]} {puts "smb.start: I think the local hostname is $smb_tmpname"}
    ## if it's too long, shorten it. (assumption that this will still work)
    if {[regexp {.+\..*} $smb_tmpname]} {
	set smb_tmpname [lindex [split $smb_tmpname "."] 0]
    }
    ## make sure we can connect with this name, otherwise
    ## leave the default
    set testfd [smb.smbclient $smb_tmpname "" "" "" ""]
    set badflag 0
    for {set i 0} {$i < 10} {incr i} {
	gets $testfd line
	if {[smb.smbclienterrtest $line 0]} {set badflag 1; break}
    }
    if {!$badflag} {set smb_localname $smb_tmpname}

    smb.delzones
    smb.delmachines
    smb.getdefzone
    smb.setcurrzone "$smb_defzone"
    smb.refresh
    smb.setdefzone
    #smb.setmachines
}

## shutdown procedure
proc smb.stop {} {
    global smb_afterID
    if {[debug]} { puts "smb: stopping smb module" }
    after cancel $smb_afterID
}

## procedure to set the current zone
proc smb.setcurrzone {newzone} {
    global smb_currzone
    set smb_currzone $newzone
    if {[debug]} {puts "smb: setting current zone to $newzone"}
}

############ End Required functions - API to main ##############
############ Functions plugins will need ##############

## function to return current zone
proc smb.getcurrzone {} {
    global smb_currzone
    return $smb_currzone
}

## function to lookup a given entity
proc smb.nbplkup {entity} {
    set results ""
    return $results
}

## function to return the current zone
proc smb.getcurrzone {} {
    global smb_currzone
    return $smb_currzone
}

## function to parse names out of entity lists
proc smb.namesfromlkup {results} {
    set names [list]
    return $names
}

## function to return the local machine name we're using
proc smb.getlocalname {} {
    global smb_localname
    return $smb_localname
}
## function to send a file to the printer using
## whatever the printer-talking utility is called.
## This MIGHT have to move into the plugin if all
## sorts of happy printer options are to be supported.
## (looks like it has)
proc smb.print {printer filename} {
    set result ""
    return $result
}

#########  End Functions plugins will need ############

######### begin general utility functions ###########

## Function to handler all smbclient calls. Returns
## a file descriptor on a pipe which must be closed
## by the caller. A return value of -1 indicates an error
## note that we must send the password from the commandline
## because otherwise smbclient insists on reading the password from
## from the controlling terminal instead of inherited stdin.
proc smb.smbclient {hostname workgroup username password smbflags} {
    global smbclient smb_localname smb_domainflag
    ## initialize it to something - stdin?
    set smbfd -1
    set cmdline "$smbclient"
    ## make sure we carry the embedded spaces through
    #set hostname "\"[lindex $hostname 0]\""
    #set hostname [lindex [list $hostname] 0]
    
    if {[debug]} {
	regsub -all {.} $password "\*" fakepass
	puts "smb.smbclient called with: $hostname, $workgroup, $username\
		$username, $fakepass, $smbflags"
    }
    #### build the commandline ####
    ## hostname
    if {![string compare $hostname ""]} {
	error "smbclient" "smb.smbclient invoked with null hostname"
	#return -1
	set hostname $smb_localname
    }
    set cmdline "$cmdline -L \"$hostname\""

    ## workgroup
    if {[string compare $workgroup ""]} {
	set cmdline "$cmdline -W \"$workgroup\""
    }
    ## username & password
    #set cmdline "$cmdline -U $username%$password"
    set cmdline "$cmdline -U \"$username%$password\" -N"

    ## other flags
    if {[string compare $smbflags ""]} {
	set cmdline "$cmdline $smbflags"
    }

    ## run the command and save the pipe descriptor
    if {[debug]} {
	regsub "$password" $cmdline $fakepass printcmdline
	puts "smb: smbclient commandline: $printcmdline"
    }
    eval set smbfd [open "|$cmdline" r+]

    ## return the pipe descriptor
    return $smbfd
}


## function to test for an error line from smbclient
## may pick up non errors too...
proc smb.smbclienterrtest {line {notify 1}} {
    if {[regexp {.*ERR.*} $line] ||\
	    [regexp -nocase {.*error.*} $line] ||\
	    [regexp -nocase {.*failed.*} $line]} {
	if {$notify} {error "smbclient" "$line"}
	return 1
    }
    return 0
}


## function to return zones
proc smb.getzones {} {
    global smb_zones smbmaster
    set plugframe [plug_frame]
    #set smb_zonelist ""
    set smb_zonelist [list]
    set workgroup [smb.getdefzone]
    if {[info exists smbmaster]} {
	set hostname $smbmaster
	if {[debug]} {puts "smb: using static workgroup master: $hostname"}
    } else { set hostname [smb.getlocalname] }

    if {[debug]} {puts "smb: getting workgroups..."}
    set smb_zones($workgroup) $hostname
    
    if {[debug]} {puts "smb: using $hostname for workgroup lookup"}

    $plugframe.status configure -text "reading workgroups..."
    update

    ## just in case we don't find anything
    set master "$hostname"
    
    ## search for the workgroup master
    #set info [open "|$smbclient -L $hostname -U %" r]
    set info [smb.smbclient $hostname "" "" "" ""]
    if {$info < 0} {
	error "smb.getzones" "error running smbclient"
	return $smb_zonelist
    }

    while {[gets $info line] != -1} {
	if {[debug]} {puts "smb: $line"}
	## parse out the workgroup and master
	if { [regexp "^\[\t| \]($workgroup)\ +" $line] } {
	    if {[debug]} {puts "smb: workgroup master?: $line"}
	    set master [lindex $line 1]
	    regsub "^\[\t| \]+$workgroup\ (\[.| \]+)" $line {\1} master
	    set master [string trim $master]
	    if {[debug]} {puts "smb: master is $master"}
	    break
	}
    }
    catch {close $info}

    if {![string length $master]} {
	error "smb.getzones" "could not find a master \
		for workgroup \"$workgroup\""
    }
    ## open pipe to smbclient - echo in a null string
    ## in case it asks for a password
    ## just in case the idiot asks for a password
    #set info [open "|$smbclient -L $master -U %" r]
    set info [smb.smbclient $master "" "" "" ""]
    if {$info < 0} {
	error "smb.getzones" "error running smbclient"
	return $smb_zonelist
    }

    while {[gets $info line] != -1} {
	if { [regexp {.*Workgroup.*Master.*} $line] } {
	    if {[debug]} {puts "smb: $line"}
	    ## eat the visual seperator line
	    gets $info line
	    ## read the workgroups and masters
	    while {[gets $info line] != -1} {
		## idiotic unparseable smbclient formatting
		if {[debug]} {puts "$line"}
		set newmaster [string range $line 22 end]
		regsub -all "\t(.+)($newmaster)" $line {\1} newgrp
		set newgrp [string trim $newgrp]
		if {[debug]} {puts "smb: newgrp = $newgrp; newmaster = $newmaster"}
		#set smb_zonelist "$smb_zonelist \"$newgrp\""
		lappend smb_zonelist $newgrp
		## save the master for each zone
		set smb_zones($newgrp) $newmaster
	    }
	}
    }
    catch {close $info}
    
    $plugframe.status configure -text "ready."
    update
    if {[debug]} { puts "smb: workgroups: $smb_zonelist" }
    
    if {[debug]} {puts "smb: done getting workgroups."}
    return $smb_zonelist
}

## function to return the names of machines
## in a zone
proc smb.getmachines {workgroup} {
    global smb_zones smbclient smb_currzone smbmaster
    global smb_domainflag smb_domainuser smb_domainpass
    set master $smb_zones($workgroup)
    
    set smb_machinelist ""
    set plugframe [plug_frame]
    if {[debug]} {puts "smb: getmachines: scanning $workgroup with $master"}
    
    $plugframe.status configure -text "scanning $smb_currzone..."
    update
    
    ## open pipe to smbclient - echo in a null string
    ## in case it asks for a password
    ## just in case the idiot asks for a password
    #set info [open "|$smbclient -L $master -W $workgroup -U %" r]
    set info [smb.smbclient $master $workgroup "" "" ""]
    if {$info < 0} {
	error "smb.getmachine" "error running smbclient"
	return $smb_machinelist
    }

    ## I can't quite figure out how this works
    ## anymore, but I managed to modify it successfully anyway
    while {[gets $info line] != -1} {
	if { [regexp {.*Server.*Comment.*} $line] } {
	    if {[debug]} {puts "smb: $line"}
	    ## eat the visual seperator line
	    gets $info line
	    ## read the servers in the workgroup
	    gets $info line
	    while {![regexp {.*Workgroup.*Master*} $line] \
		    && ![regexp {.*This machine has.*} $line] } {
		## idiotic unparseable smbclient formatting
		set comment [string range $line 22 end]
		#regsub -all "\t(.+)($comment)" $line {\1} newmachine
		#set newmachine [string trim $newmachine]
		set newmachine [string trim [string range $line 1 21]]
		if {[debug]} {
		    puts "smb: newmachine = $newmachine; comment = $comment"
		}
		#set smb_machinelist "$smb_machinelist \"$newmachine\""
		if {[string length $newmachine]} {
		    lappend smb_machinelist $newmachine}
		if {[gets $info line] == -1} { break }
	    }
	}
    }
    catch {close $info}
    if {[debug]} {puts "smb: getmachines: $smb_machinelist"}
    $plugframe.status configure -text "ready."
    update
    return $smb_machinelist
}

## procedure to list the machine names
## in the plugin's listbox window. This
## is being done in the smb module because
## windows networks are machine oriented, not
## service oriented.
proc smb.setmachines {} {
    global smb_currzone
    set pluglist [plug_list]
    
    smb.delmachines
    set machines [smb.getmachines "$smb_currzone"]
    foreach machine $machines {
	if {[string compare $machine ""] != 0} {
	    $pluglist insert end $machine
	}
    }
    update
}

proc smb.delmachines {} {    
    set pluglist [plug_list]
    $pluglist delete 0 end
}


## function to return a list of services of a
## given type for a given machine
proc smb.getservices {machine type guestflag username password} {
    global smbclient
    if {[debug]} {
	regsub -all {.} $password "\*" fakepass
	puts "smb.getservices called with: $machine, $type, \
		$guestflag, $username, $fakepass"
	unset fakepass
    }
    set servname ""
    #set servlist ""
    set servlist [list]
    ## open pipe to smbclient - echo in a null string
    ## in case it asks for a password
    ## just in case the idiot asks for a password
    if {$guestflag || [string compare $username ""] == 0} {
	set name ""
	set password ""
    } else {
	set name "$username"
    }
    #set info [open "|$smbclient $name -L $machine -U %" r]
    set info [smb.smbclient $machine "" $name $password ""]
    if {$info < 0} {
	error "smb.getservices" "error running smbclient"
	return $servlist
    }
    
    while {[gets $info line] != -1} {
	if {[smb.smbclienterrtest "$line"]} {
	    return $servlist
	}
	if { [regexp {.*Sharename.*Type.*Comment.*} $line] } {
	    ## eat the visual seperator line
	    ## and prime the next loop
	    gets $info line
	    gets $info line
	    while {![regexp {.*This machine.*} $line]} {
		## idiotic unparseable smbclient formatting
		if {[debug]} {puts "$line"}
		set newtype [string range $line 16 [string wordend $line 22]]
		set newtype [string trim $newtype]
		if {[debug]} {puts "smb: type is $newtype"}
		if {[string compare $type $newtype] == 0} {
		    #regsub "\t(.+)($type)(.*)" $line {\2} servname
		    set servname [string range $line 0 15]
		    set servname [string trim $servname]
		    if {[debug]} {puts "smb: service = $servname; type = $type"}
		    #set servlist "$servlist \"$servname\""
		    lappend servlist $servname
		}
		if {[gets $info line] == -1} { break }
	    }
	}
    }
    catch {close $info}

    return $servlist
}

## figure out this machine's default zone
## this doesn't work so well. may need to read through ALL the
## output and look for ourself. that's lame.
proc smb.getdefzone {} {
    global smbclient smb_defzone smb_domainflag smb_localname smb_domain
    set workgroup -1
    set hostname [smb.getlocalname]

    if {[debug]} { puts "smb: hostname = $hostname" }
    #set info [open "|$smbclient -L $hostname -U %" r]
    set info [smb.smbclient $hostname "" "" "" ""]
    if {$info < 0} {
	error "smb.getdefzone" "error running smbclient"
	return $workgroup
    }

    while {[gets $info line] > -1} {
	if { [regexp {^Domain=.*} $line] } {
	    if {[debug]} {puts "smb: $line"}
	    ## set the local netbios name
	    foreach field [split $line "\] "] {
		if {[regexp {^Workgroup=\[(.*)$} $field all myworkgroup]} {
		    if {[debug]} {puts "smb: myworkgroup = $myworkgroup"}
		    set workgroup "$myworkgroup"
		} elseif {[regexp {^Domain=\[(.*)$} $field all mydomain]} {
		    if {[debug]} {puts "smb: mydomain = $mydomain"}
		    set smb_domainflag 1
		    set smb_domain $mydomain
		}
	    }
	    ## we got all we need
	    if {$workgroup < 0} {set workgroup "$smb_domain"}
	    break
	}
    }
    catch {close $info}
    if {[debug]} {puts "smb: getdefzone: $workgroup"}
    set smb_defzone $workgroup
    return $workgroup
}

## procedure to show current zonelist
proc smb.setzones {} {
    foreach name [smb.getzones] {
	.leftside.bot.zones insert end $name
    }
    update
}

## procedure to set the default zone (at startup)
proc smb.setdefzone {} {
    global smb_defzone smb_currzone
    set thezone $smb_defzone
    set size [.leftside.bot.zones size]
    set smb_currzone $smb_defzone
    for {set i 0} {$i<$size} {incr i} {
	set name [.leftside.bot.zones get $i]
	if {[string compare $name $thezone] == 0} {
	    .leftside.bot.zones selection set $i
	    update
	    return
	}
    }
    
}

## procedure to delete zone listings
proc smb.delzones {} {
    .leftside.bot.zones del 0 end
}

## looping procedure to refresh zone listings
proc smb.refresh {} {
    global smb_zonedelay smb_afterID

    if {[debug]} { puts "smb: refreshing zonelist" }
    smb.delzones
    smb.setzones
    set smb_afterID [after $smb_zonedelay {smb.refresh}]

}

############# End general utility functions ###############

## make sure we can find everything we need. if not,
## unset our global flag! we only need one of the dependancies
## in this case, so check separately
set smb_deps_ok 0
if {[info exists smbdir]} {
    set loc $smbdir/bin/$smbclient
    if {[file executable $loc]} {
	set smb_deps_ok 1
	set smbclient $loc
    } else {
	puts "smb: $loc not found. check $smbdir definition\
		in chooser.cfg or check samba installation"
    }
}
if {!$smb_deps_ok} {
    set loc [check_deps $smbclient]
    if {[string length $loc]} {
	set smb_deps_ok 1
	set smbclient $loc
    } else {
	puts "smb: $smbclient not found anywhere. Check smbdir definition\
		in chooser.cfg, samba installation, and paths"
    }
}
catch {unset loc}

if {!$smb_deps_ok} {
    puts "smb: can't find required programs: $smbclient"
    puts "smb: disabling smb"
    set smbflag 0
}
unset smb_deps_ok

if {[debug]} { puts "Finished loading samba smb module." }




## from smb.getzones
#if {[info exists env(HOSTNAME)] == 1} {;
#set hostname $env(HOSTNAME);
#} else {;
#	  catch {exec hostname -s} hostname;
# };


## from smb.setmachines
#if {[info exists env(HOSTNAME)] == 1} {;
#set hostname $env(HOSTNAME);
#} else {;
#catch {exec hostname -s} hostname;
#};