#
# <20200228.1852.43>
#
# An effort to sanely find UNC ports for windows.
# First we test a couple of register values to see if
# smb is supported and if so SMBv1 or SMBv2
# set wh HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\LanmanServer\\Parameters
# registry get $wh smb1
# If we have SMBv1, there is a good chance there is a browser
# If not, we have to test each visable machine on the local network
#
# We use ipconfig, arp, and ping to try and find these with out
# spending forever doing it.

# then we need to check each machine

namespace eval findUNC {
  variable lanmanParms [join {
    HKEY_LOCAL_MACHINE
    SYSTEM
    CurrentControlSet
    Services
    LanmanServer
    Parameters
  } "\\"]
  # nonServers are devices which respond to ping but not to
  # server enumeration. They are alive but have no resources
  # for us.
  variable wsladds
  variable nonServers {}

  # proc isSMB {} {
  #   variable lanmanParms
    
  #   # First test if we have SMBv1
  #   set r [catch {registry values $lanmanParms} vals]
  #   # A problem here means we don't have lanman at all...
  #   if {$r != 0} {return 0}
  #   if {[catch {registry get $lanmanParms SMB1} vals] == 0 && $vals == 1} {
  #     # Looks like SMBv1 is alive and well...
  #     return 1
  #   }
  #   if {[catch {registry get $lanmanParms SMB2} vals] == 0 && $vals == 1} {
  #     # No 1, but we have SMB2
  #     return 2
  #   }
  #   # Neither 1 nor 2, likely not 3 as well, but we test anyway
  #   if {[catch {registry get $lanmanParms SMB3} vals] == 0 && $vals == 1} {
  #     # No 1, or 2 but we have SMB3
  #     return 3
  #   }
  #   return 0
  # }

  # This routine checks if an IPv4 'ip' is in the sub net defined by the 'mask'
  proc inSubnet {ip} {
    variable maskParts
    variable myNetParts
    
    foreach ipPart [split $ip .] maskPart $maskParts myNetPart $myNetParts {
      frputs ipPart myNetPart maskPart ip 
      if {(($ipPart ^ $myNetPart) & $maskPart) != 0} {
	frputs ipPart myNetPart maskPart 
	return 0
      }
    }
    frputs "YES " ip
    return 1
  }

  # ipToNetBios takes an ip address and translates it to the NetBios name
  # but only if there is one. Otherwise, it returns nil i.e. {}
  # We use "nbtstat" to do the translation. This, of course, polls the owner
  # so this could take a while, especially if the device is offline or not
  # a NetBios server.
  # Most of the work here is decoding the returned info.
  
  proc ipToNetBios {ip} {
    set raw [asyncExec nbtstat -A $ip]
    if {[regexp {\n([^<]*)<20>.*} $raw m name]} {
      return [string trim $name]
    }
    return {}
  }
  
  proc UNCpoll {all} {
    variable nonServers
    variable maskParts {}
    variable myNetParts {}

    # first we find the local subnet addresses for all
    # active ip addresses
    if {[catch {asyncExec ipconfig /all} data] != 0} {
      return -code error $data
    }
    frputs data
    # There could be 0 to n adapters. Find each and set up
    # the search.
    set data [split $data \n]
    set lengthData [llength $data]
    set ln 0
    while {1} {
      frputs ln lengthData
      while {$ln < $lengthData &&\
		 ![string match -nocase "* adapter *" [lindex $data $ln]]} {
	incr ln
      }
      incr ln
      # this break stops the while {1}
      if {$ln >= $lengthData} {break}
      # we have found an addapter, find the first two iv4 addresses
      set cuAdds {}
      while {$ln < $lengthData &&\
		 ![string match -nocase "* adapter *"\
		       [set line [lindex $data $ln]]]} {
	incr ln
	if {[regexp {.*[^0-9](([0-9]{1,3}\.){3}[0-9]{1,3})([^0-9]|$).*} $line -> ip1 ip2]} {
	  lappend cuAdds $ip1
	  frputs ent adds
	  # If we have 2, move on to the next addapter
	  if {[llength $cuAdds] == 2} {
	    lappend adapterList $cuAdds
	    # This break should take us back to searching for addapters
	    break
	  }
	}
      }
    }
    # If any adapters were found we should have the first two iv4
    # address for each. This should be our IP and Mask

    # So here we compute the broadcast address...
    # and set up the *Parts variables
    #
    # use twapi  to get the arp table
    set arpList [lindex [twapi::get_arp_table] 1]
    frputs adapterList
    foreach adds $adapterList {
      frputs adds
      lassign $adds myIp mask
      set bcP [set myNetParts [set maskParts {}]]
      foreach myP [split $myIp .] maskP [split $mask .] {
	lappend myNetParts [expr {$myP & $maskP}]
	lappend maskParts $maskP
	lappend bcP [expr {$myP | (~$maskP & 255)}]
      }
      set bc [join $bcP .]
      # ping the broadcast address. One time is enough
      catch {asyncExec ping -n 1 -i 1 -4 $bc}
      # each subList is: interfaceIndex MAC IP type
    
      #
      # For each of these that are in the subnet see if
      # they have any shares to contribute
      set serverList {}
      foreach line $arpList {
	lassign $line du mac tad type
	# it appears that type==invalid means it is stale...
	if {$type == "invalid"} {continue}
	frputs tad bc myIp
	if {$tad in "$bc $myIp" || ![inSubnet $tad]} {continue}
	if {$tad in $nonServers} {continue}
	set r [catch {asyncExec ping -a -n 1 -w 1 -4 $tad} pingResult]
	frputs r
	if {$r != 0} {continue}
	# now the time consuming part
	set r [catch {ipToNetBios $tad} nbiosName]
	frputs tad  nbiosName r
	if {$r != 0 || $nbiosName == {}} {
	  lappend nonServers $tad
	  continue
	}
	# OK we have netBIOS name, now get the shares...
	frputs nbiosName
	set raw [asyncExec net view $nbiosName]
	foreach line [split $raw \n] {
	  if {[regexp {(.*)Disk(.*)} $line n share driveletter]} {
	    if {[string index [set trdr [string trim $driveletter]] 1] == ":"} {
	      set driveletter [string index $trdr 0]:
	    } else {
	      set driveletter {}
	    }
	    set share [string trim $share]
	    frputs share driveletter
	    lappend serverList [list //$nbiosName/$share $driveletter]
	  }
	}
      }
    }
    return $serverList
  }

  # we return a DIC (i.e. share  driveletter)  driveletter may be {} if none
  proc getShares {args} {
    variable nonServers
    # if {[isSMB] == 0} {
    #   # No SMB, nothing here...
    #   return {}
    # }
    if {[string match *r* $args]} {
      set nonServers {}
    }
    frputs args
    set shares [UNCpoll [string match *a* $args]]
    foreach shar $shares {
      lassign $shar share drive
      set sarry($share) $drive
    }
    # set con [regsub -all {\\} [twapi::wnet_connected_resources] /]
    # foreach sh $con {
    #   lassign $sh letter sha
    #   set sarry($sha) $letter
    # }
    return [array get sarry]
  }

  # the enumCIFS checks current connections to CIFS shares and,
  # if not in the passwordLocker, adds them. We check for presents
  # without regard to user as it appears that twapi may supply
  # local names rather than the remote name. This code finds only
  # connected resources so it should be quick.
  
  proc enumCIFS {} {
    global config
    if {[catch {twapi::wnet_connected_resources -type file} shares] != 0} {
      return 0
    }
    foreach shEnt $shares {
      lassign $shEnt drive share
      if {[string index $drive end] == "/"} {
	set drive [string range $drive 0 end-1]
      }
      set recShare [lindex [regsub -all {\\} $share {/}] 0]
      lassign [twapi::get_client_share_info $share -user] duh user
      frputs recShare share drive shares
      set entN -1
      set found 0
      foreach pwlEnt $config(passwordLocker) {
	incr entN
	set extra [lassign $pwlEnt id pw dr]
	if {![IsVFS $id] || $VFSpro != "cifs"} {continue}
	frputs pwlEnt id VFSadd recShare
	# Do this test without case...
	set foundShare "//[regsub {^[^@]*@} $VFSadd {}]$VFSpath"
	if {![string equal -nocase $recShare $foundShare] || $dr != $drive} {continue}
	# found an entry that matches
	incr found
	if {$drive == $dr && [string match *@* $VFSadd]} {break}
	# We have more or better info. update the record
	if {![string match *@* $VFSadd] && $user != {}} {
	  set VFSadd ${user}@$VFSadd
	}
	set config(passwordLocker) [lreplace $config(passwordLocker)\
					$entN $entN\
					[list cifs://$VFSadd$VFSpath $pw $drive {*}$extra]]
	break
      }
      if {!$found} {
	set mshare "cifs://$user@[string range $recShare 2 end]"
	set config(passwordLocker) [lreplace $config(passwordLocker)\
					-1 -1\
					[list $mshare {} $drive]]
      }
    }
    return 0
  }
  proc setDN {drive share server target} {
    global config
    set cv {format "%s(%s)(%s)" $share $server $drive}
    if {$config(DisplayNameShare) != {}} {
      set cv $config(DisplayNameShare)
    }
    set displayName  [eval $cv]
    delDN $displayName
    set r [catch {addDN  [list $target $displayName]} er]
    frputs er
    if {$r != 0 && [string index $er 0] != "-"} {
      PopWarn $er
    }
  }
  # Here we find the WSL shares and set them up to appear in the <volume> listing
  # where to look for local WSL files
  #
  proc findWSLshares {} {
    variable wsladds
    
    if {[set WSLconfig [auto_execok wslconfig]] == {}} {
      # We use wslconfig because wsl wants its own console
      # If the path is does not include wslconfig, lets try directly
      if {![file exists [set WSLconfig "C:/Windows/System32/wslconfig.exe"]]} {return}
    }
    # Still here?? Ok, get the info
    if {[catch {exec $WSLconfig /l} lns] == 0} {
      # The unicode convert routines seem to mess things up.
      # The regsub method works, even if it is not unicode.
      set lns [split [regsub -all {\x00} $lns {}] \n]
      set share {}
      foreach line [lrange $lns 1 end] {
	if {$line == {}} {continue}
	set fullName [lindex $line 0]
	setDN {} [lindex $line 0] "wsl$" "//wsl$/$fullName"
	# lappend share //wsl$/[lindex $line 0]
	set wsladds($fullName) \
	    [glob -nocomplain [file norm ~/AppData/Local/Packages/*$fullName*]]
      }
      return
    }
  }
}

# This code gets called on reading of the config file so it
# must not redo things it has already done

# It is called with the 'share' which looks like "cifs://sys/item"
#                   the drive letter (if one is desired)
#                   and a flag that helps us figure out what to do
#
# We take the 'drive' as a suggestion.
# If null or is not a letter followed by :, we just set it up as a unc
# Otherwise, if possible we assign that letter to the share unless
# it is already in use. In which case we allow the system to assign a letter
# and return it.

# A word on case. This is MSW, there is NO case. That said, one may want
# a particular case. The UNC find code seems to return uppercase for the
# server and lower for the path (the part after the server: //server/path
# (Likely because 'nbtstat' returns upper case for the server.)
# So here is how we allow the user to do what they want.
# When we check if this is a new share (in the passwordLocker) we use '-ncase'
# This allows the user to change it to what ever case s/he wants.
# (by modifying the passwordLocker).


proc setUpShare {unc reqDrive flag} {
  global config
  set cv {format "%s(%s)(%s)" $share $server $drive}
  if {$config(DisplayNameShare) != {}} {
    set cv $config(DisplayNameShare)
  }
  if {![IsVFS $unc]} {return {}}
  # build a clean share name
  regexp {/([^/]*).*} $VFSpath -> path
  lassign [split $VFSadd @] user VFSadd
  if {$VFSadd == {}} {
    # no user...
    set VFSadd $user
    set user {}
  }
  frputs VFSadd path VFSpath user unc reqDrive
  set share //$VFSadd/$path
  if {[string length $reqDrive] != 2 || [string index $reqDrive 1] != ":"} {
    set reqDrive {}
  }
  set reqDrive [string toupper $reqDrive]
  set connected [regsub -all {\\} [::twapi::wnet_connected_resources -type file] {/}]
  # A share can be connected with n drives (drive letters)  where n can be 0 or more
  # we do this search to return all connection drive letters, if any.
  set foundDrives {}
  foreach con $connected {
    lassign $con drive conShare
    if {[string equal -nocase $share $conShare]} {
      lappend foundDrives $drive
    }
  }
  if {$reqDrive ni $foundDrives && $foundDrives != {}} {
    # We found the requested share with another drive letter
    # If we can not use the requested, use the first found
    if {$reqDrive != {} && "$reqDrive/" in [file vol]} {
      # requeste drive is not available, lets use what is already set up
      # but only if we can find a real letter.
      foreach dr $foundDrives {
	if {$dr != {}} {
	  set reqDrive $dr
	}
      }
    }
  }
  if {$reqDrive ni $foundDrives} {
    # Looks like we need to set up the share
    # drive letter available?
    if {"$reqDrive/" in [file vol]} {
      set reqDrive "*"
    }
    # set up to make a connection...
    set pw {}
    set out {}
    array set pwA [list password {} user $user]
    while {[incr failsafe] < 10} {
      # get the password
      # first build a url for the share
      set nUrl cifs://[expr {$user == {} ? "$VFSadd" : "$user@$VFSadd"}]/$path
      frputs nUrl user pwA(user)
      set pwA(password) {}
      set pw [::pwLocker::getPw $nUrl \
		  user $pwA(user) \
		  nocase 1\
		  newuser 1 \
		  startwith $pwA(password) \
		  prompt $out \
		  returnall 1]
      frputs pw
      if {$pw == -1} {return}
      # a single return means we have a password...
      if {[llength $pw] < 2} {
	incr foundPw
	set pw [list password $pw keep 1]
      }
      array set pwA $pw
      set r [catch {::twapi::connect_share [regsub -all {/} $share {\\}] \
			-localdevice $reqDrive \
			-user $pwA(user) \
			-password [::twapi::conceal $pwA(password)]} out]
      frputs r out share
      if {$r != 0} {
	set out [list {} $out]
	continue
      }
      if {$pwA(keep)} {
	if {![string length $out] != 2} {
	  set out {}
	}
	::pwLocker::putPw cifs://$pwA(user)@$VFSadd/$path\
	    $pwA(password) $out $flag
      }
      break
    }
    set reqDrive $out
    frputs failsafe
  }
  # Ok, the system is set, lets set up display names as needed
  # drive will be the $drive letter, and the share is $share
  if {[string index $flag 0] in {N n}} {return}
  # reformat share for the format statement
  set target $share
  lassign [split $share /] > > server share
  set drive $reqDrive
  if {$reqDrive != {}} {
    set target $reqDrive
  }
  ::findUNC::setDN $drive $share $server $target
  # frputs drive share server target
  # set displayName  [eval $cv]
  # delDN $displayName
  # set r [catch {addDN  [list $target $displayName]} er]
  # frputs er
  # if {$r != 0 && [string index $er 0] != "-"} {
  #   PopWarn $er
  # }
  
}
