#
# <20240712.1632.23>

# The intention of this file is to collect all the routines that filerunner
# uses to navigate file systems in one location. 
# This includes deciding and action on requests for three different file
# system accesses:
# a) normal access
# b) Xftp access
# c) access to file systems that are temporary mounts on the current system
#
# The functionality provided includes:
#
# cd
# pwd
# directory read, includeing fcontrol if needed.
#
# The decision to use mode a) or c) is based on noticing if the file system
# being accessed is a temp mount or not.  This includes auto mount systems
# as well as usb and other memory sticks.
#
# frPwd should filter /tmp_mnt stuff out of the path. 
# How well does that work? Not
# Really we just want to get the true path with out the links..

# for getdirlist:
# file mtime glob & lstat
# 
# setProtectedServer takes a file/dir name and, if it is on a temp mount point
#                    checks to see if a server is already set up for that
#                    mp and that it is alive. If not one is set up.
#                    Return is either the handle for the server or null if
#                    the file/dir is not on a temp mp
proc setProtectedServer {dir} {
  if {![info exist ::testP] || $::testP != 1} {
    return {}
  }
  global mpServers
  if {[set mp [isTempMountPt $dir]] == {}} {return {}}
  if {[info exists mpServers($mp)]} {
    set serverStat [::server::Status $mpServers($mp)]
    if {$serverStat == "UP"} {
      return $mpServers($mp)
    } 
  }
  set mpServers($mp) [::server::Build ]
  if {$mpServers($mp) != 0} {
    # server is up, Now we need to provision it.
    # simple things like 'pwd' and 'cd' are direct.
    # More complex things take some code...
    foreach fun {cdAndTestR collectDirList \
		     getFileInfo collNsortFilesR LnkFile \
		     GetStringFromMode GetUidGidString} {
      ::server::FunToServer $mpServers($mp) $fun
    }
  }
  return $mpServers($mp) 
}

# This code uses procs:
# cdAndTest
#
# it uses upvar directory and produces upvar dirlist
# it also modifies lastmtime to the mtime of the given pwd (parm 2)
# This code can return an error    
proc collectDirList {lastmtime instPwd showAll} {
  upvar 1 directory directory dirlist dirlist
  upvar 1 $lastmtime mylastmtime
  #cdAndTest $directory/
  set mylastmtime [file mtime $instPwd]
  # frputs "Before glob on [pwd] "
  LogStatusOnly "Getting dir list"
  set time [clock mic]
  set r [catch {glob -nocomplain *} dirlist]
  # frputs "After glob  " r
  if {$r} {
    return -code 1 $dirlist
  }
  
  if { $showAll } {
    # for reasons unknown -type hidden does NOT return .file where .file
    # is a link.  No other option on windows...
    if {$::tcl_platform(platform) == "unix" } {
      set r [catch {glob -nocomplain .*} dirlist2]
    } else {
      set r [catch {glob -nocomplain -type hidden *} dirlist2]
    }
    #frputs "After glob hidden  " r
    if {$r} {
      return -code 1 $dirlist2
    }
    
    set dirlist [concat $dirlist2 $dirlist]
  }
  LogStatusOnly " [expr {[clock mic] - $time}]"
}
#
# getFileInfo calls the following procs:
# LnkFile
# GetStringFromMode
# GetUidGidString
# The latter two of the above use (set to linux)

# It uses upvars dirlist and directory as input
# and puts its results in upvars dl and sortlist
# parms: showDirs should be one of "dirsfirst, mixed or dirslast"
#        showSort should be one of "mtime, rmtime, atime, ratime,
#                                   ctime, rctime, size, extension or ?"
#                 (any value '?') will sort on name only
#
proc getFileInfo {showDirs showSort } {
  upvar dirlist dirlist directory directory dl dl sortlist sortlist

  LogStatusOnly "Processing Dir list"
  set time [clock mic]
  foreach k $dirlist {
    #frputs "before Stat  " k
    if {[IsVFS $k]} {
      lappend dl [list "$sortval_d " $k   "fd" 0      0   " "  " "  " "  0     0     0]
      #                  sort        name type size mtime mode uid linkn links atime ctime
      lappend sortlist  "$sortval_d [list $k]"
      continue
    }
    if {[catch { file lstat "./$k" statinfo }] && \
	    [catch {file lstat $k statinfo}]} {continue}
    set filetype n

    if {($statinfo(mode) & 0170000) == 040000} {
      set filetype d
    }
    set linkname " "
    if {($statinfo(mode) & 0170000) == 0120000} {
      set filetype l
      if {[file isdirectory "./$k"]} {
	set filetype ld
      }
      # frputs k
      if {[catch {file readlink "./$k"} linkname] != 0} {
	# This may be a WSL dir...
	frputs directory k
	if {$::MSW && [catch {getWslLink $directory $k} an] == 0} {
	  lassign $an linkname filetype
	  frputs linkname filetype
	}
	frputs an
      }
    } else {
      # check if it is a windows ".lnk" file
      if {[file extension "./$k"] == ".lnk"} {
	# For complete mount point protection we need to rewrite LnkFile...
	if {[catch {LnkFile ./$k } linkname] == 0} {
	  set filetype [expr {[file isdir $linkname ] ? {wld} : {wl}}]
	} else {
	  set linkname " "
	  # set filetype "wl"
	}
      }
    }
    foreach tim {atime ctime mtime} {
      set $tim $statinfo($tim)
    }
    set tmp [switch -exact $showSort {
      atime     {format "%011d" $atime }
      ctime     {format "%011d" $ctime }
      mtime     {format "%011d" $mtime }
      ratime    {format "%011d" [expr 2147483647 - $atime]}
      rctime    {format "%011d" [expr 2147483647 - $ctime]}
      rmtime    {format "%011d" [expr 2147483647 - $mtime]}
      size      {format "%011d" $statinfo(size) }
      extension {file extension $k}
      default   {expr { " "}}
    }]
    set sortval_d [lsearch {dirsfirst mixed dirslast} $showDirs]
    switch -exact $filetype {
      wl -
      n  -
      l  {set sortval 1$tmp}
      d   -
      wld -
      ld  {set sortval $sortval_d$tmp}
    }
    
    lappend dl [list $sortval $k $filetype $statinfo(size) \
		    $mtime [GetStringFromMode $statinfo(mode)] \
		    [GetUidGidString $directory/$k \
			 $statinfo(uid) $statinfo(gid)] \
		    $linkname $statinfo(nlink)\
		    $atime $ctime]
    # do NOT make the sortlist a list of lists!!
    # list $sortval $k Does NOT sort the same as "$sortval $k"
    # especially if $k needs to be quoted by the list command.
    lappend sortlist "$sortval [list $k]"
  }
  LogStatusOnly "[expr {[clock mic] - $time}]"
}

proc frPwd { } {
  global glob
  if { $::tcl_platform(platform) == "windows" } {
    return [pwd]
  }
  return [file dirname [file normalize [pwd]/x]]
}
proc NonLocalDir { dir } {
  # return 1 if not a local file system, else 0
  return  [catch {exec df -l $dir} ]
}
proc TryMakeNewDir { newdir } {
  if {[IsVFS $newdir]} {
    Try { VFSmkdir $newdir } "" 1
  } else {
    Try { file mkdir $newdir } "" 1
  }
}
# This code plants "cdAndTout" in the callers space!
# This is the first place we will see a temp mount point
# we provide an result that may be used by newpwd if the
# location is to become one of the panes.
proc cdAndTest {newpwd} {
  upvar cdAndTout cdAndTout mp mp
  set mp [setProtectedServer $newpwd]
  # frputs "cdAndTest  " mp
  if {$mp != {}} {
    lassign [::server::Call $mp cdAndTestR $newpwd] val cdAndTout
    frputs "cdAndTest rtn  " val cdAndTout
    if {$val == 0} {cd $newpwd}
    return $val
  }
  set cdAndTout "Not readable"
  # if {![file readable $newpwd]} {
  #   # For some unknow reason the '//wsl$/<foo>' returns as unreadable
  #   # but will allow cd and glob....
  #   if {![string match {//wsl$/*} $newpwd]} {return 1}
  # }
  set r [catch {cd $newpwd} cdAndTout]
  return $r
}
# Here is the server version of cdAndTest
proc cdAndTestR {newpwd} {
  set cdAndTout "Not readable"
  # if {![file readable $newpwd]} {frputs;return 1} ; # include remote tests
  set r [catch {cd $newpwd} cdAndTout]
  # puts "[list $r $cdAndTout]"
  return
}


# I don't see how, short of doing all this locally to prevent 
# wandering into a temp mount space.
#
proc GetNewDir {inst } {
  global glob ignor_error_flag
  set info  [_ "File runner choose directory"]
  set r 1
  while {$r != 0} {
    set ignor_error_flag [_ "Can not go there (permission?)"]
    set r [catch {tk_chooseDirectory -title $info \
		      -initialdir [DNtoDir [$glob(win,$inst).entry_dir get]] \
		      -mustexist 0\
		      -parent .} newdir]
    unset ignor_error_flag
  }
  if {[file isdirectory $newdir]} {
    return $newdir
  }
  return {}
}
# NewPwd, take us to a new working dir for pane inst
#         if "newpwd" is nil ("") go to volume dir
#         if "newpwd" is current/.. and the result is the same, go to volume dir
#

# A wrinkle, if ask is "goUp" and the newpwd fails, we knock of a dir and try again
proc NewPwd {inst newpwd {ask 0} } { 
  global glob config
  frputs #2 #1 newpwd
  set curdir $glob($inst,pwd)
  set info ""
  # ???? what is this ???
  # set tmp2 $glob(${inst},newpwd_oldpwd)
  
  while { 1 } {
    set rqpwd $newpwd
    if {[IsVFS $newpwd]} {
      # Only munge the backslashes for VFS 
      set newpwd [regsub -all {\\} $newpwd {/}]
      set newpwd [URL normalize $newpwd]
      set mode ftp
      # The following returns continue or break as needed
      # It uses 'upvar' to set 'newpwd' with the desired value

      set newpwd [VFScheckSyntax $inst $newpwd $ask ]

      # End of ftp tests

    } else {
      # for reasons unknown file normalize will not remove the 
      # extra '/' in //foo, unless we add the '//.' at the end.
      set newpwd [file dir [file normalize  $newpwd//x]]
      #frputs rqpwd newpwd
      if {$::MSW} {
	switch -regexp -nocase $rqpwd {
	  {^$} -
	  {^([a-z]:/|//[^/]+/[^/]+/)\.\.$} {
	    # request is for nil or up (..) from <?>:/ e.g. c:/..
	    set newpwd ""
	    break
	  }
	  {^/\.\.} {
	    # this is up (..) from nil (/..)
	    set ask 1
	  }
	  {^/.*} {
	    set newpwd $rqpwd
	  }
	}
      }
      if {$rqpwd == "//.." || $rqpwd == {}} {
	# Nill is the Volume place...
	set newpwd ""
	break

      }
      if {$rqpwd == "/.." || $ask == 1} {
	# Here s/he wants to go before volume, we send the system
	# get dir request...
	set newpwd [GetNewDir $inst]
      }
    }
    #puts $newpwd
    # if newpwd is ?:/.. or /.. or //*/.. set the ask flag and go round again
    if {$newpwd == {} ||\
	    [regexp -nocase -lineanchor \
		 {^[a-z]:/\.\.$|^/\.\.$|^//[^/]+/[^/]+/\.\.$} $newpwd]} {
      set newpwd ""
      break
    }
    frputs #2 newpwd
    if {[cdAndTest $newpwd] != 0} {
      frputs  newpwd cdAndTout
      set r [catch {file link $newpwd} tryL]
      if {$r == 0 && [file readable $tryL]} {
	frputs  tryL
	set newpwd $tryL
	continue
      }
      if {$ask == "goUp"} {
	set newpwd [file dir $newpwd]
	continue
      }
      
      #	     puts "failed read test"
      # Failed to be readable or cd able (or both). trying to get
      # up the tree from the top??
      # Otherwise, we have a problem...
      # If he cancels here we go to "/"
      set newpwd [simple_smart_dialog "."  \
		      [_ "Error in path (not readable)"]\
		      [_ "Error: %s\nPlease edit new path or cancel.\
                          OK or Return will create it." $cdAndTout] \
		      $newpwd "/"]
      # If s/he returned cancel or abort or nil, if there 
      # is an old path just return, else ... well insist...
      frputs newpwd
      if {$newpwd in {"" "/"}} {break}
      if {[file isdirectory $newpwd]} {continue}
      
      TryMakeNewDir $newpwd
      continue
    }
    # The following code does the pwd to a newly cd'ed dir except for
    # well darn, must be some file names that don't pass, but I forget.
    # We DO check <char>:*, /*, //<char><char>/* What is left?
    if {$config(cd_pwd)  &&
	[regexp -nocase -lineanchor \
	     {^[a-z]:/.*$|^/.*$|^//[^/]+/[^/]+/.*$} $newpwd] == 1} {
      set r [catch {frPwd} out]
      if {$r} { 
	PopError [_ "Trying to get directory info: %s" $out]
	# if { $curdir != "" } {return ""}
	continue
      }
      set newpwd $out
    } else {
      # Evaluate xxx/yyy/zzz/../.. to xxx
      set newpwd [file normalize $newpwd]
    }
    # Here is where we set the new dir in glob(inst,pwd)
    # We also want to use ?: rather than ?:/ so we do that here
    regsub -nocase {(^[a-z]:)/$} $newpwd {\1} glob($inst,pwd)
    set glob($inst,isTempFS) $mp
    break
  } ;  # End of while
  
  set glob($inst,pwdTail) [file tail $glob($inst,pwd)]
  if {$glob($inst,pwdTail) == {} } {
    set glob($inst,pwdTail) "/"
  }
  if {[IsVFS $glob($inst,pwd)]} {
    set glob($inst,pwdTail) $VFStok/..[expr {$VFSpath != "/" ? $glob($inst,pwd) : "/"}]
  }
  if {$newpwd == $curdir && $rqpwd == "$curdir/.."} {
    set newpwd {}
  }
  if {$newpwd == {}} {
    set glob($inst,pwd) ""
    set glob($inst,pwdTail) ""
  }
  
  AppendToDirHistory $glob($inst,pwd)
  # Moving to a new dir, clear watch on old if needed
  ClearWatch $inst $glob($inst,pwd)
  set oldy 0
  catch {set oldy [$glob(listbox,$inst).file index active]}
  set glob($inst,dirstack) \
      [linsert $glob($inst,dirstack) 0 [list $curdir $oldy]]
  if { [llength $glob($inst,dirstack)] > 110 } {
    set glob($inst,dirstack) [lrange $glob($inst,dirstack) 0 100]
  }
}

proc formatDF {free {deflate 0}} {
  regsub -all {[^0-9]} $free "" free
  # should now be a pure number.  If nil, use zero...
  # better than failing in the following code...
  if { $free == "" } {
    set free 0
  }
  set indx $deflate
  while { $free > 1024. } {
    incr indx
    set free [expr {$free / 1024.}]
  }
  #  puts "$indx $free"
  set suf { " " K M G T}
  return [format {%.3f%s} $free [lindex $suf $indx]]
}

# Here we get the same as GetDirList but without destrubing any of the
# info in the panes
#
proc adHockGetDirList {dir} {
  global glob
  set glob(h,pwd) $dir
  set glob(h,isTempFS) {}
  set glob(notify,h) {}
  return [GetDirList h]
}

# This routine (GetDirList) returns a sorted list of files in the current
# working dir

proc GetDirList { inst } {
  global config glob
  global ftp
  set directory $glob($inst,pwd)
  set result {}
  set sortlist {}
  set dl {}
  set type ""
  set start [clock mill]

  if { [IsVFS $directory] } {
    getVFSdirList $directory sortlist

  } else { ; # not VFS
    # It is NOT ftp, following is normal local file processing.
    # need the '/' below to prevent misbehavior with 'c:' which, for some
    # reason is not the same as 'c:'.  
    # The '/' is ignored in other cases (we hope).
    set glob($inst,lasttime) [clock seconds]
    
    # inst "h" is the adhoc pane which is never displayed...
    if {$inst != "h"} {
      ClearCherryPicker $inst
    }
    if {$directory == ""} {
      # This is the volume thing.
      # The list is to contain all volumes, UNCs we know of, and Display Name
      # entries.
      
      # for windows pick up shares without display names or drive letters
      set dirlist [volEntShares]
      frputs dirlist
      foreach dir [file vol] {
	if {[file exists $dir]} {
	  if {[string length $dir] > 1 && [string index $dir end] == "/"} {
	    set dir [string range $dir 0 end-1]
	  }
	  lappend dirlist $dir
	}
      }
      frputs dir
      # Here we add the display names... skip self reference here (i.e. {})
      foreach {dir name} $::DNlist {
	# frputs dirlist dir
	if {$dir == {} || $dir in $dirlist} {continue}
	lappend dirlist $dir
      }
      # Take care of dups and case stuff
      set dirlist [lsort -unique {*}$::CASEops $dirlist]
      frputs dirlist
      getFileInfo $config(fileshow,dirs) $config(fileshow,sort)
    } else {

      # This is the normal directory stuff...
      #frputs "Before dir  " directory
      
      if {$glob($inst,isTempFS) != {}} {
	lassign [::server::Call $glob($inst,isTempFS) \
		     collNsortFilesR $glob($inst,pwd) \
		     $config(fileshow,all) \
		     $config(fileshow,dirs) \
		     $config(fileshow,sort) ] val mtime dl sortlist
	if {$val != 0} {return -code 1 $mtime}
	frputs "Mtime update from to  " glob($inst,lastmtime) mtime
	set glob($inst,lastmtime) $mtime
      }
       
      # *nix and tcl/windows
      cdAndTest $directory/
      if {$::MSW} {
	getMSWdirList $glob($inst,pwd)
      } else {
	collectDirList glob($inst,lastmtime) $glob($inst,pwd) \
	    $config(fileshow,all) 
	getFileInfo $config(fileshow,dirs) $config(fileshow,sort)
      }
      set glob($inst,df) [GetDF $glob($inst,pwd)]

      set dirTime [expr {[clock mill] - $start}]
    }
    # common to most all
  }
  # Here we replace the file names if there is a DisplayName
  # The sort is later so we will get the desired sort.
  # On the other hand we have two lists we need to fix.
  # But the order is the same in each.
  set newSl [set newDl {}]
  foreach entSl $sortlist  entDl $dl {
    set cuName [lindex $entDl 1]
    switch -exact $glob($inst,pwd) {
      {}      {set dn [dirToDNexact $cuName]}
      {/}     {set dn [dirToDNexact /$cuName]}
      default {set dn [dirToDNexact $glob($inst,pwd)/$cuName]
      }
    }
    # frputs glob($inst,pwd) cuName dn
    if {$dn == {}} {
      set dn [dirToDN $cuName]
    }
    #	lappend newSl [lreplace $entSl 1 1 $dn]
    lappend newSl "[lindex $entSl 0] $dn"
    lappend newDl [lreplace $entDl 1 1 $dn]
  }
  #frputs newSl sortlist newDl dl
  # frputs sortlist newSl
  # frputs dl newDl
  set sortlist $newSl
  set dl       $newDl
  LogStatusOnly "Sorting Dir list"

  # set start [clock mic]
  foreach el [lsort $config(sortoption) -indices $sortlist] {
    lappend result [lindex $dl $el]
  }
  LogStatusOnly "Total dir time: [expr {[clock mill] - $start}]"
  # frputs dirTime directory
  # frputs sorTime
  return $result
}

# The following is the remote function to collect a dir list along
# with the file info. This code will run on the server and takes
# the current pwd and several config values. It returns sortlist and dl
# and lastmtime info
#
proc collNsortFilesR {instPwd showAll showDirs showSort} {
  set directory $instPwd
  cd $directory/
  # puts stderr "Entered collNsortFilesR $instPwd $showAll $showDirs "
  set r [catch "collectDirList mtime $instPwd $showAll" err]
  if {$r != 0} {
    frputs r err instPwd showAll ::errorInfo
    return
  }
  getFileInfo $showDirs $showSort
 # puts "[list 0 $mtime $dl $sortlist]"
}

#
# All pure VFS stuff below here
#############################################################

proc getVFSdirList {URL where} {
  global config glob ftp
  upvar $where sortlist inst inst dl dl
  #   regexp {[a-z]?ftp://([^/]*)(.*)} $directory match ftpI directory
  # cancel notify if to this pane
  set glob($inst,df) "?"
  if {$glob(notify,$inst) != "" } {
    if {$glob(notify,left) != $glob(notify,right) } {
      catch {$glob(notify,watchname) remove $glob(notify,$inst)}
    }
    set  glob(notify,$inst) ""
  }
  # This gets us the protocol (among other things)
  IsVFS $URL
  set dummy {{0 {Can't get file list, try again?} n 0 0 0 0 0}}
  # frputs "Get dir  " URL
  # VFScd $URL
  set r [catch {VFScd $URL} outp]
  if {$r != 0} {
    PopError $outp
    return $dummy
  }
  if {$VFSpath == {}} {
    if {[catch {VFSvolumes $URL} ans] == 0} {
      # We have a volume list...
      set dirlist [lsort -unique {*}$::CASEops $ans]
      getFileInfo $config(fileshow,dirs) $config(fileshow,sort)
      return
    }
    # if attempt to do volumes fails we go back to the home dir
    set $glob($inst,pwd) $::VFSvars::defaultPwd($VFStok)
  }
  # frputs "Get VFSlist  " URL
  # The full URL is important here as it is used as a handle to
  # cache the list.
  if {[VFSsupports $URL list]} {
    set r [catch {VFSlist $URL $config(fileshow,all)} dirlist]
    if {$r != 0} {
      PopError $dirlist
      return $dummy
    }
    set dirT "n"
  } else {
    set r [catch {VFSlistF $URL showall $config(fileshow,all)} dirlist]
    if {$r != 0} {
      PopError $dirlist
      return $dummy
    }
    set dirT "a"
  }
  # Example of output (now placed in dirlist)
  #total 3333 (optional)
  #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 .
  #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 ..
  #lrwxrwxrwx   1 root     root           11 Mar 16 14:28 apa -> welcome.msg
  #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 bin
  #drwxrwxr-x   2 root     wheel        1024 Aug 30  1993 etc
  #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 incoming
  #drwxrwxr-x   2 root     wheel        1024 Nov 17  1993 lib
  #drwxrwxr-x   3 root     wheel        1024 Mar 10 16:08 pub
  #drwxrwxr-x   3 root     wheel        1024 Aug 30  1993 usr
  #-rw-r--r--   1 root     root          312 Aug  1  1994 welcome.msg

  # from ls -Fla
  #total 3333 (optional)
  #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 ./
  #drwxrwxr-x   8 root     wheel        1024 Mar 16 14:28 ../
  #lrwxrwxrwx   1 root     root           11 Mar 16 14:28 apa -> welcome.msg
  #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 bin/
  #drwxrwxr-x   2 root     wheel        1024 Aug 30  1993 etc/
  #drwxrwxr-x   2 root     wheel        1024 Dec  3  1993 'in coming'/
  #drwxrwxr-x   2 root     wheel        1024 Nov 17  1993 lib/
  #drwxrwxr-x   3 root     wheel        1024 Mar 10 16:08 pub/
  #drwxrwxr-x   3 root     wheel        1024 Aug 30  1993 usr/
  #lrwxrwxrwx   3 root     root         2012 Aug 22  2021 "ve'ndor" -> /system/vendor/
  #-rw-r--r--   1 root     root          312 Aug  1  1994 welcome.msg

  # note the quotes (either ' ' or " ") and links have indicators at end of link
  # also supported by busybox ls

  # from android... ls -l  (nasty nil size on l & d also messy dev entries)
  #lrwxrwxrwx root     root              2012-02-14 10:23 vendor -> /system/vendor
  #lrwxrwxrwx root     root              2012-02-14 10:23 d -> /sys/kernel/debug
  #lrwxrwxrwx root     root              2012-02-14 10:23 etc -> /system/etc
  #-rw-r--r-- root     root         3882 1969-12-31 17:00 ueventd.rc
  #-rw-r--r-- root     root          890 1969-12-31 17:00 ueventd.omap4430.rc
  #-rw-r--r-- root     root            0 1969-12-31 17:00 ueventd.goldfish.rc
  #drwxr-xr-x root     root              2012-02-10 20:38 system
  #drwxr-xr-x root     root              2012-02-14 10:23 sys
  #crw------- root     root       4,  67 2012-02-14 10:23 ttyS3
  #crw------- root     root       4,  66 2012-02-14 10:23 ttyS2

  #wuarchive.wustl.edu:
  #-rw-r--r--   1 0                      605 Sep 27 14:45 README.NFS
  #-rw-r--r--   1 0                      474 Sep 27 14:45 README.SIMTEL
  #lrwxrwxrwx   1 0                        9 Sep 26 12:56 bin -> ./usr/bin

  #ftp://reactor.actlab.com (Yucky WinNT output)
  #12-02-97  02:17AM       <DIR>          !Incoming
  #06-03-97  09:38PM       <DIR>          !support
  #06-03-97  09:38PM       <DIR>          7thlevel
  #06-03-97  09:38PM       <DIR>          access
  #06-03-97  09:38PM       <DIR>          accolade
  #06-03-97  09:39PM       <DIR>          Activision
  #09-11-96  07:10PM                 3592 ACTlogo.gif
  #06-03-97  09:40PM       <DIR>          Apogee
  #06-03-97  09:40PM       <DIR>          avalon
  #06-03-97  09:40PM       <DIR>          beam

  # This is what rsync puts out
  # drwxr-xr-x          4,096 2015/10/18 19:13:16 .
  # lrwxrwxrwx             11 2015/04/11 18:31:59 run
  # drwxr-xr-x          4,096 2016/09/29 18:42:28 bin
  # drwxr-xr-x         16,384 1969/12/31 17:00:00 boot
  # drwxrwxrwx          4,096 2015/04/15 13:16:03 data
  # drwxr-xr-x          3,420 2017/05/03 00:17:25 dev
  # drwxr-xr-x         12,288 2016/12/13 12:41:46 etc
  # drwxrwxrwx          4,096 2015/10/13 13:27:41 fa
  

  set sortval_d [switch -exact $config(fileshow,dirs) {
    dirsfirst {expr {0}}
    mixed     {expr {1}}
    dirslast  {expr {2}}
  }]
  set indicators {*/=@|}
  set indicatorsPresent 0
  set linkfound 0
  set kLast {}
  set discount {}
  foreach k $dirlist {
    # frputs k
    switch -glob $k {
      {}             -
      {total *}     {continue}
      {indicators *} {
	set indicatorsPresent [lindex $k 1]
	continue
      }
      {df *}         {
	set glob($inst,df) [lindex $k 1]
	continue
      }
      {listF *}      {
	set dirT [lindex $k 1]
	continue
      }
      {DISCOUNT=*}   {
	lappend discount "[string range $k [string first "=" $k]+1 end]"
	continue
      }	
    }
    # frputs discount
    if {$k in $discount} {continue}
    # Here is a way to interpret a 'list' return as a 'listF' return and vice versa
    if {$dirT == "a"} {
      # special return from listF
      array set thisF [list size 0 sec 0 og {} link {} nlinks 1 flags {}]
      array set thisF $k
      foreach val {file size sec link nlinks flags } {
	set $val $thisF($val)
      }
      set ownerGroup $thisF(og)
      set filetype f$thisF(type)
    } else {
      set filetype fn
      set link {}
      set nlinks {}
      set r 0
      # Try regular parsing
      # First lets separate out an error we might get on android...
      if {[string match "*failed:*" $k]} {
	# Ok, all we know is the file name...
	set r [regexp {^.*'\./(.*)' failed: (.*)$} $k match i1 link]
	# frputs r file why
	# Heres a fast simple set to {}
	lassign {} flags nlinks size date i2 i3 i4
	set type "n"
      }
      if {$VFSpro == "rsync"} {
	# Ok, if this is from rsync, lets treat it as lists...
	# Oops! that does NOT work, as file names can have special chars
	frputs RSYNC k
	set start 0
	foreach var {flags size date time} {
	  set et [stringGetToken $k start]
	  set $var [string range $k $start $et]
	  set start [incr et]
	}
	# Note that this allows spaces in the file name as well.
	set i1 [string trim [string range $k $start end]]
	set type [string index $flags 0]
	set flags [string replace $flags 0 0]
	# allow blanks (but not more than one at a time) in the file name
	lassign [split $date /] yr mo da
	if {$yr > 12} {
	  set date $mo/$da/$yr
	}
	set ownerGroup {}
	append date " $time"
	regexp {((.+) -> (.+))|(.+)} $i1 i1 i2 i3 i4
 	set r 1
      }
      # frputs k r
      if {!$r} {
	# my android uses this also the Mac osx system
	#                type  flags    nlinks    owner    group    wh note "," size
	set r [regexp {^([^ ])([^ ]+) *([0-9]+) +([^ ]+) +([^ ]+) +([0-9]+, +)?([0-9]+)\
			   +(............) (((.+) -> (.+))|(.+))} \
		   $k match type flags nlinks owner group wh size date i1 i2 i3 i4]
	#                    ---date-----   
	#  set r [regexp {^([^ ])([^ ]+) (*[0-9]+) +([^ ]+) +([^ ]+) +([0-9]+) \
	    #	  +(............) (((.+) -> (.+))|(.+))} 
	# $k match type flags nlinks owner group size date i1 i2 i3 i4]
	# file name will be i1 if not a link, else i3 and link is i4
	# frputs r k type flags nlinks owner group size wh date i1 i2 i3 i4
	set nlinks [string trim $nlinks]
	set ownerGroup $owner/$group
	# frputs r
      }
      # if {$ftp($VFStok,debug) } {
      #   #	puts "back from try regular dir"
      # }
      if {!$r} {
	#	puts "failed regular, trying andriod"
	#frputs k
	set r [regexp {^([^ ])([^ ]+) ([^ ]+) +([^ ]+) (.*)\
			   ([0-9]{4}-[0-9]{2}-[0-9]{2}\
				[0-9]{2}:[0-9]{2}) (((.+) -> (.+))|(.+))} \
		   $k match type flags owner group size date i1 i2 i3 i4]
	#                type  flags   owner group size date file link|file
	# if that worked, fix up the size...
	frputs r
	if {$r} {
	  set ownerGroup $owner/$group
	  if {$type != "-" } {
	    set size 0
	  } else {
	    set size [string trim $size]
	  }
	}
      }
      # frputs r date i1 i2 i3 i4 
      if {!$r} {
	#	puts "android failed..."
	# Try wuarchive.wustl.edu parsing
	# if {$ftp($ftpI,debug) } {
	# 	#	  puts "try wuarchive.wustl.edu dir"
	# }
	set r [regexp {^([^ ])([^ ]+) (.*[0-9]+) +([^ ]+) +([0-9]+)\
			   +(............) (((.+) -> (.+))|(.+))} \
		   $k match type flags nlinks owner group   size date i1 i2 i3 i4]
	frputs r
	if {!$r} {
	  
	  # Try WinNT parsing
	  if {$glob(debug)} {
	    Log "try WinNT dir  "
	  }
	  
	  set r [regexp {(.................)(......................)(.+)} \
		     $k match date type i1]
	  if {!$r} {
	    PopError [_ "Error parsing VFS List output: %s\
                        \nLast: %s" $k $kLast]
	    frputs k dirlist'
	    # return $dummy
	  }
	  set i3 {}
	  set type [string trim $type]
	  set flags rwxrwxrwx
	  set nlinks 1
	  set ownerGroup {}
	  if {$type == "<DIR>"} {
	    set size 0
	    set type d
	  } else {
	    set size $type
	    set type n
	  }
	} else {
	  set ownerGroup $owner/$group
	}
      }
      set kLast $k

      if {"$i3" != ""} {
	set file [string trimright $i3 $indicators\n ]
	set link [string trimright $i4 "\n"]
      } else {
	set file [string trimright $i1 $indicators\n ]
      }
      # set file [string trimleft $file]

      #	    if {"$file" == "." || "$file" == ".."} continue
      # known file types: - regular, b block special, c character special,
      #                   C high performance, d directory, D door (Solaris)
      #                   l link, n network special (HP_UX) p fifo,
      #                   p port (Solaris), s socket M off-line (Cray),
      #                   ? none of the above
      # Of these, we want to NOT try to read any but "-" (normal file) and
      # "l" if it points at a normal file. Also 'file readable' returns true
      # on "s" sockets.

      # # Fix quoted files..
      # set first [string index $file 0]
      # set last  [string index $file end]
      # if {($first == {'} && $last == {'}) || ($first == {"} && $last == {"})} {
      # 	set file [string range $file 1 end-1]
      # }
      if {$type == "-"} { set type n}
      switch -exact $type {
	d  { set filetype fd }
	l  {
	  frputs i3 i4 file
	  if {$indicatorsPresent && [string index $i3 end] != "@"} {
	    # We now depend on the ls -F option to tag the directory links.
	    # So much faster...
	    # But, darn the OSX ls tags the link and not the file...
	    if {[string index $link end] == "/"} {
	      set filetype "fld"
	    } else {
	      set filetype "fl"
	    }
	  } elseif {$config(ftp,fastlink) == 1 } {
	    set linkfound 1
	    if {[set flink [VFSisDir [URL join $URL $link]]] == {}} {
	      # frputs "VFS dir test  " file r outp
	      set filetype fl
	    } else {
	      set filetype fld
	      # some VFS's don't do pwd's correctly, trust ls first
	      if {$link == {}} {
		set link $flink
	      }
	    }
	  } else {
	    set filetype fld
	  }
	  set link [string trimright $link $indicators]
	}
	b  -
	c  -
	s  -
	p  -
	n  { set filetype fn }
	default {
	  PopError [_ "Error parsing VFS LIST output: %s\
                              \nLast: %s" $k $kLast]
	  # return $dummy
	  frputs k dirlist'
	}
      }
      set sec [FTPDateStringToSeconds $date]
    }
    set tmp [switch -exact $config(fileshow,sort) {
      time      {format "%011d" $sec }
      rtime     {format "%011d" [expr 2147483647 - $sec]}
      size      {format "%011d" $size }
      extension {file extension $file }
      default   {expr { " "}}
    }]
    #     puts ">$tmp<"
    switch -exact $filetype {
      fn -
      fl  {set sortval 1$tmp}
      fd -
      fld {set sortval $sortval_d$tmp}
    }
    lappend dl [list $sortval $file $filetype $size \
		    $sec $flags \
		    $ownerGroup \
		    $link $nlinks\
		    {} {}]
    lappend sortlist "$sortval [list $file]"
    set kLast $k
  }
  # if {$linkfound} {
  #   # make sure we leave the working dir in the right place
  #   catch {VFScd $URL}
  # }
}

proc VFScheckSyntax { inst newpwd ask} {
  global glob config
  upvar newpwd newdir
  upvar curdir curdir
  set newdir $newpwd
  set beenhere 0
  set curTok {}
#  puts "$newdir"
  while { 1 } {
    if {[IsVFS $curdir]} {
      set curTok $VFStok
      # save curPath $VFSpath
    }
    set r [IsVFS $newdir]
    #    puts "yet? match $match sftp $sftp VFStok $VFStok new $newpwd2 <"
    # By setting the cancel return to "/" we end up in a safe place.
    if {$r == 0 || $VFStok == ""} { 
      set newdir [simple_smart_dialog "." \
		      [_ "Error in path"] \
		      [_ "Malformed URL: %s\nFormat:\
                         <protocol>://<user@site>/<path>\n\
                          Please edit new path or cancel." $newdir] \
		      $newpwd "/"]
      if { $newpwd == "" || ! [IsVFS $newpwd]  } {
	# OK, the path was malformed and we got back nil, or a non-VFS path.
	# Go round again..
	return  -code continue $newdir
      }
      # This should be a VFS path. If the target is possibly a windows registry
      # lets fix any backslashes that may have been used.
      set newdir [regsub -all {\\} $newdir {/}]
      # Something that 'may' be a decent path, back up to test again...
      continue
    }
    if {[VFSisOpen $VFStok] == 0} {
      # open using the a nil path, then use the supplied path or if none
      # the newly opened VFS to get a path
      set r [catch {OpenVFS $VFStok} out]
      if {$r} { 
	frputs "OpenVFS error " out ::errorInfo
	if {$out == "ABORT_LOGIN" } {
	  LogStatusOnly [_ "$newdir login aborted"]
	  # Go back to the current pwd if the open failed on
	  # user abort
	  set newdir $glob($inst,pwd)
	  return -code continue ""
	}
      }
      # If the open code passed back a corrected URL use that
      IsVFS $out
      # set up the default pwd
      if {[catch {VFSpwd $VFStok} pwdresult] != 0} {
	  return -code error "pwd failed with $pwdresult on new open."
	}
      set ::VFSvars::defaultPwd($VFStok) $pwdresult
      # We have an open. If he supplied a path try cd'ing to it
      if {$VFSpath == {}} {
	set newdir $pwdresult
      }
      # cd to the requested path or the default is non requested
      if {[catch {VFScd $newdir} out] != 0} {
	if {$newdir != $pwdresult} {
	  catch {VFSclose $VFStok}
	  return -code error "VFS opened but could not find default directory."
	}
	# So the failure was on the specified dir, not the default...
	set newdir $pwdresult
	if {[catch {VFScd $pwdresult} out] != 0} {
	  # Can not seem to cd any where ????????
	  catch {VFSclose $VFStok}
	  return -code error "VFS opened but could not cd to default directory."
	}
      }
      # At this point we have successfuly cd'd to somewhere after a new connection
    } else {
      # If here, we have an already open connection
      # and s/he wants to cd somewhere in it.
      # If the requested location is nil:
      # If the target is an MSW system, get the volume list
      # nil on *nix systems stays at "/"
      # If the cd works, all well and good.

      # If the cd fails and 'ask' is "goUp" we try the parent dir
      # (the "goUp" comes from 'update' and it a cd fails usually means
      # that the process that forced the update has caused the dir to disappear.
      # if 'ask' is not "goUp" ask for a new address and try that.

      set posUp [URL norm $newdir/..]
    
      if {$VFSpath == ""} {
	# Lets look at the default path to see if it is MSW
	IsVFS $::VFSvars::defaultPwd($VFStok)
	if {[string match "\[A-Za-z]:*" $VFSpath]} {
	  # Looks like an MSW path
	  # We are going to a nil path which is not really possible or cd able.
	  # We assume the 'getdir' code will do something useful.
	  frputs VFSpath newdir
	  return -code break
	}
	#Looks like an *nix
	
	set newdir $newdir/
	
      }
      # all set, try the cd
      set r [catch {VFScd $newdir} out]
      if {$r != 0} {
        if {$ask == "goUp"} {
	  set newdir $posUp
	  return -code continue $newdir
	}
	# Here we failed to cd to the new dir
	
	if {$glob(debug)} {
	  global errorInfo
	  set info "\n errorInfo: $errorInfo"
	} else {
	  set info ""
	}
      
	# again cancel get us to '/'
	set aNewdir [simple_smart_dialog "."\
			 [_ "Error Connecting"] \
			 [_ "Error: %s\n\nPlease edit new path or cancel.
                         \nOK or Return will attempt to create it." \
			      $out$info] \
			 $newdir "/"]
	if {$aNewdir == {}} {
	  # This is the cancel return. 
	  set newdir  $glob(${inst},pwd)
	  return -code continue
	}
	frputs aNewdir newdir
	if {! [IsVFS $aNewdir] || $VFStok != $curTok } {
	  # if the newdir is not a VFS or a different VFS
	  # the continue return will check that.
	  set newdir $aNewdir
	  return  -code continue
	}
	# Still same VFS but a new path, have another look here...
	if {$newdir == $beenhere} {
	  # We already tried this, lets retreat to solid ground
	  set newdir  $glob(${inst},pwd)
	  return -code continue
	}
	  
	if {$newdir == $aNewdir} {
	  # s/he returned the same dir, try to create it
	  TryMakeNewDir $aNewdir
	  set beenhere $newdir
	} else {
	  set newdir [regsub -all {\\} $aNewdir {/}]
	}
	continue
      }
      #Successful cd, do the common set up
    }
    break
  }
  ###########################################################################
  # If we always want the true path, get that
  if { $config(ftp,cd_pwd) } {
    set r [catch {VFSpwd $VFStok} out]
    if {!$r} {
      set glob(${inst},pwd) $out
    } else {
      # not sure here.  we cd'd to the dir but failed the PWD???
      PopError "$out"
      set newdir $glob($inst,pwd)
      return -code continue 
    }
  } else {
    # Evaluate xxx/yyy/zzz/../.. to xxx
    set glob(${inst},pwd) [URL norm $newpwd]
  }
  set newdir  $glob(${inst},pwd)
  return -code break
}



# Make sure link is open, don't open it if it is already open
# Usually this is called when we are trying to switch to something
# that looks like a VFS URL. If we already have it open, just return
# Otherwise try to open it.

# This codes main job is to get names and passwords and such
proc OpenVFS {URL} {
  global glob config env
  IsVFS $URL
  if {[VFSisOpen $URL] != 0} {
    return {}
  }

  Log [_ "Opening VFS connection to %s" $URL]

  set openFixedOps [list\
			log       ::LogStatusOnly\
			timeout   $config(ftp,timeout)\
			timefmt   $config(dateformat)\
			abortflag ::glob(abortcmd)\
			tmpdir    [makeTmp]\
			debug     $glob(debug)
		   ]
  # We now push all this off to the VFS handler...
  # lassign [split $VFSadd @] user add
  # This way allows '@' in the user name
  frputs URL
  lassign {} user add
  regexp {(.*)@(.*)} $VFSadd -> user add
  if {$add == {}} {
    set user $env(USER)
  }
  
  # We really don't know how to handle prox
  set openOps [list \
		   user     $user\
		   {*}$openFixedOps\
		  ]
  set r [catch "VFSopen $URL $openOps" out]

  # frputs "back from first open " r out
  if { $r == 0 } {
    Log [_ "VFS connection to %s open" $VFStok]
    return $out
    
  } else {
    PopWarn [_ "VFS open of %s failed with error: %s" $URL $out]
    return -code error [_ "ABORT_LOGIN"]
  }
}

