#
# This package provides access for lists of Windows network resources.
# This preliminary version has no error checking and is Windows-only
# Unix version is to be written
#
#
# Toplevel wrapper. Use 
#    net domains
#    net computers domain
#    net shares computer ?print?
#    net glob //computer/share/subdir/wildcard
#        note - slashes are _forward_
proc net {args} {
    set subcommand [lindex $args 0]
    set args [lrange $args 1 end]
    if {[lsearch -exact {glob domains computers shares} $subcommand]==-1} {
         error  "Usage: net option ?args? where option is one of domains\
                computers shares"
     }		
     uplevel ::smbnet::$subcommand $args 
}
namespace eval smbnet {
switch -exact $tcl_platform(platform)  {
"unix" {  
          #get netbios name of localhost 
          proc localname {} { 
	    set line [exec nmblookup -A localhost]
	    if {![regexp "\n\t\(\[^ \]+) +<00>" $line match name]} {
	       return -code error "Cannot determine local NETBIOS name"
	    }
	    return $name
	  }  
	  variable my_name [localname]
          proc domains {} {
            # get netbios name of localhost
	    variable my_name
	    set line [exec smbclient -N -L  $my_name]
	    if {![regexp "\n\tWorkgroup +Master\n\t-+ +-+\n(.*)$" \
		    $line match line]} {
		return -code error "Cannot get workgroups list"
	    }
	    set result {}
	    foreach elem [split $line \n] {
		if [regexp "^\t(\[^ \]+) " $elem match domain] {
		    lappend result $domain
	        }
		
	    }
	    return $result
	 }
	 proc computers {domain} {
	    variable my_name
	    set line [exec smbclient -N -L  $my_name]
	    if {![regexp "\n\tWorkgroup +Master\n\t-+ +-+\n(.*)$" \
		    $line match line]} {
		return -code error "Cannot get workgroups list"
	    }
	    foreach elem [split $line \n ] {
		if [regexp "^\t(\[^ \]+) +(\[^ \]+)" $elem match dom master] {
		   if {![string compare $dom $domain]} {
                       break
		   }
		   unset master
	        }
		
	    }
	    if {![info exists master]} {
	  	return -code error "Couldn't get master browser for domain $domain"
            }   
	    set line [exec smbclient -N -L $master]
	    if {![regexp "\n\tServer +Comment\n\t-+ +-+\n(.*)\n\n" \
		    $line match line]} {
		return -code error "Cannot get server list from $master"
	    }
	    set result {}
	    foreach elem [split $line \n] {
	        if {! [string length $elem]} break
		if [regexp "^\t(\[^ \]+) +(\[^ \]+)" $elem match\
			machine comment] {
		    lappend result $machine
	        } 	
            }		   
	    return $result
	 }
	 proc shares {computer {sharetype disk}} {
	    set line [exec smbclient -N -L $computer]
	    if {![regexp "\n\tSharename +Type +Comment\n\t-+ +-+ +-+\n(.*)\n\n" \
		    $line match line]} {
		return -code error "Cannot get shares list from $computer"
		
	    }
	    set result {}
	    foreach elem [split $line \n] {
		if {![string length $elem]} break
		if {[regexp "^\t(.*) +(Disk|Print|IPC  )" $elem match name type]
			&& ![string compare [string trim [string tolower $type]] $sharetype]} {
		    lappend result [string trim $name]
		}
	    }
	    return $result
	 }
	 proc glob {path} {
	   set list [split $path /]
	   set share [join [lrange $list 0 3] "\\"]
	   set realpath [join [lrange $list 4 end] "/"]
	   set responce [exec smbclient $share << "ls $realpath"]
	   set result {}
	   regexp "\nsmb: .>(.*)\n\n" $responce match responce
	   foreach line [split $responce \n] {
	      lappend result [string trim [string range $line 0 \
			[expr [string length $line] - 36]]]
	   }
	   return $result
	 }

}
"windows" {
    # List SMB domains on current network
    proc domains {} {
	set domlist [lrange [split [exec net view /domain] "\n"] 4 end]
	set final {}
	foreach i $domlist {
	    if {[string match "The command completed*" $i]} break
	    lappend final [string trim $i]
	}
	return $final
    }
    # list computers in the given domain
    proc computers domain {
	set lines [lrange [split [exec net view /domain:$domain] "\n"] 4 end]
	set final {}
	foreach i $lines {
	    if [string match "The command completed*" $i] break
	    regexp {^\\\\([^ ]+) } $i match name
	    lappend final $name
	}
	return $final
    }
    # list shares of given computer. optionally, sharetype - disk or
    # print may be specified
    proc shares {computer {sharetype disk}} {
	if {$sharetype == "printer"} {
	    set sharetype print
	}
	set lines [lrange [split [exec net view "\\\\$computer"] "\n"] 4 end]
	foreach l $lines {
	    if [string match "The command completed*" $l] break
	    set name ""; set type "";regexp {^(.*) (Print|Disk)} $l\
		    match name type
	    if {[string length $name]&&"$sharetype" == [string tolower $type]} {
		lappend final [string trim $name]
	    }
	} 
	return $final
    }
    # list files on the network disk. Note - slashes are forward
    proc glob path {
        global env
	set list [split $path /]
	if {[llength $list]>4} {
	    set globexp [lindex $list end]
	    if {[regexp {\*\?\[} $globexp]} {
		set list [lreplace $list end end]
	    } else {
		set globexp *
	    }
	} else {
	    set globexp *
	}	
	set realpath [join $list "\\"]
	set files [split [exec $env(COMSPEC) /c dir /b $realpath] "\n"]
	foreach i $files {
	    if [string match $globexp $i] {
		lappend final $i
	    }
	}
	return $final
    }	   
   
}  
default { error "Smbnet is not implemented for $tcl_platform(platform)" }
}
}
package provide Smbnet 0.2