
# VFS sftp code for filerunner
package provide VFSsftp 1.0


namespace eval VFSsftp {
  variable commands
  variable sftp 
  variable debug 0
  variable os $::tcl_platform(platform)
  variable abortflag
  variable mfx {}
  variable sftp

  if { [catch "package require Expect" out] != 0} {
    # No Expect at all, We can not continue....
    PopInfo [_ "Expect not found.  SFTP can not continue"]
    return -code error "Corrupt Filerunner. No 'Expect' package found."
  }
  if {[set sftp [auto_execok sftp]] == {}} {
    # oooh! that is bad...
    return -code error "sftp program not found. sftp VFS requires the sftp program."
  }
  # We will likely fail to properly login.
  if {[string index $out 0] == 0} {
    # This is the all tcl Expect package.
    if {!$::MSW} {
      PopInfo [_ "Real Expect not found. Filerunner can't do VFSsftp 
            \nwithout the Expect package. You may fix this by 
            \ninstalling the 'expect' package from your system repo."]
      return -code error "'Expect' missing."
      # It seems expect for MSW is either non-existant or very old.
      # Lets just soldier on, no point in complaining if their is no solution.
    }
    Log "Full Expect not found, using pure Tcl expect"
    set myexpect 1
    # For reasons likely attributable to the fact that my expect does not use
    # a pty, sftp seems reluctant to prompt. However we need the prompt to
    # tell when a command is finished. Adding an extra '\n' to commands
    # causes this prompt. We don't want it with the real expect, so...
    # we have myfix aka mfx.
    set mfx {}
  }
  if {[set sshpass [auto_execok sshpass]]!= {}} {
    set sftp [list $sshpass -p %s {*}$sftp]
  }
  frputs "found: Expect " out
   
  array set commands [list\
			  open ::VFSsftp::sFTPopen\
			  reopen ::VFSsftp::sFTPopenLink\
			  live ::VFSsftp::sFTPpwd\
			  cd ::VFSsftp::sFTPcd\
			  delete ::VFSsftp::sFTPdelete\
			  mkdir ::VFSsftp::sFTPmkdir\
			  rmdir ::VFSsftp::sFTPrmdir\
			  rmdirEmpty 0\
			  isdir ::VFSsftp::sFTPisdir\
			  pwd ::VFSsftp::sFTPpwd\
			  chmod ::VFSsftp::sFTPchmod\
			  chown ::VFSsftp::sFTPchown\
			  list ::VFSsftp::sFTPlist\
			  get ::VFSsftp::sFTPget\
			  put ::VFSsftp::sFTPput\
			  RcopyOk 3\
			  rename ::VFSsftp::sFTPrename\
			  link ::VFSsftp::sFTPlink\
			  command ::VFSsftp::sFTPcommand\
			  close ::VFSsftp::sFTPclose\
			  search ::VFSsftp::sFTP_DoSearch\
			  debug ::VFSsftp::sFTP_debug]

  # Support routines *********************************
  # ******************* 
  proc eId {n} {return "(sftp $n): "}
  proc dproc {args} {}

  # This allows simple log calls
  proc Log {mess} {
    variable sftp
    upvar VFStok VFStok
    VFSglobal log
    frputs #2 log mess VFStok
    eval [list $log "$mess"]
  }

  proc sFTPisdir {VFStok dir} {
    # variable sftp
    set r [catch {sFTPcd $VFStok $dir}]
    frputs dir r
    # return [expr { ! $r}]
    if {$r == 0} {return [sFTPpwd $VFStok]}
    return 0
  }
  # We allow several connections at once. Still we will likely share
  # a few things, for example the abort flag may point to the same var
  # And we will use a common debug flag.
  
  proc sFTPopen {URL args} { ; #  host user password port rq_timeout args 
    variable debug
    VFSglobal mySpawn_id user port password host timeout abortflag\
				 log tmpdir pwd

    set host  [regsub -all {.*@|:.+} $VFSadd {}]
    set debug 0
    set user {}
    set password {}
    set timeout {}
    set abortflag ::[namespace current]::abtflag
    set timefmt "%d%m%y "
    set tmpdir "/tmp"
    set log ::[namespace current]::dproc
    frputs VFStok host user password port timeout args
    # The VFSadd (set by IsVFS) may contain a user name
    # and a port lets seperate them

    # regexp {(.*)@(.*)} $VFSadd ma user VFSadd
    # regexp {(.*):(.*)} $VFSadd ma VFSadd port
    lassign [VFSaddrSplit $VFSadd] user VFSadd port
    if {$port == {}} {
      set port 22
    }

    set poss {user password port timeout abortflag timefmt log debug tmpdir}
    foreach {opt value} [lindex $args 0] {
      set tar [lsearch -glob -all -inline $poss "$opt*"]
      if {$tar == {}} {continue}
      if {[llength $tar] != 1} {
	# puts "Here is tar >$tar<"
	error "[eId 1]SFTPopen option ($opt) must be one of: $poss"
      }
      set $tar $value
      frputs tar value
    }
    set password $VFSpro://$user@$VFSadd
    set pwd $VFSpath
    return [sFTPopenLink $VFStok]
  }

  proc sFTPopenLink {VFStok} {
    global config
    variable debug
    variable os
    variable commands
    variable sftp
    
    VFSglobal mySpawn_id user port host password timeout abortflag tmpdir pwd

    set r [catch {exp_log_user $debug} what]
    frputs r what port
    # get options from the sftp table
    set run [subst {*}$::stOps {-oPort=$port -p}]
    set rcopyok 3
    set rmdirempty 0
    set strength -1
    set options [VFShelpOptions "sftp" $user $host $port]
    
    # Ok what did we get...
    foreach opt $options {
      set thisOpt [join [lassign [split $opt =] name] = ]
      switch -nocase -exact $name {
	run -
	rcopyok -
	rmdirempty {
	  set [string tolower $name] [subst {*}$::stOps $thisOpt]
	  # frputs opt name "[string tolower $name] " thisOpt run rcopyok rmdirempty
	}
	default {}
      }
    }      
    set commands(rmdirEmpty) $rmdirempty
    set commands(RcopyOk) $rcopyok
    frputs rmdirempty rcopyok run 
    if {$debug} {
      if {[info exists myexpect] } {
	# only my expect can handle a Log procedure.
	exp_log_file -a -proc log
      } else {
	catch {exp_log_file}
	exp_log_file  -a $tmpdir/Log
      }
    }
    set newpw [::pwLocker::getPw $password f 1 ] 
    # while trying passwords...
    while {1} {
     frputs newpw
     if {$newpw == -1} {
	return -code error "[eId 1.5]User canceled login"
      }
      lassign $newpw passwordx idfile passphrase
      if {$idfile != "" } {
	set idfile [list -i [file join $::env(HOME)/.ssh $idfile]]
      }
      # This eliminates the command echo
      set stty_init -echo
      frputs options idfile user host port run
      if {$os == "unix" } {
	frputs "spawn -noecho [format $sftp $passwordx] {*}$run\
                 {*}$idfile $user@$host "
	set r [catch {spawn -noecho {*}[format $sftp $passwordx]\
			  {*}$run {*}$idfile $user@$host} out]
      } else {
	set r [catch {spawn -noecho psftp -pw $passwordx {*}$run\
			  {*}$idfile $user@$host} out]
      } 
      if {$r != 0} {return -code error [_ "[eId 2]Really bad error: %s" $out]}
      # We keep out spawn_id in our local data store rather than the expect
      # spawn_id which is global. This allows us to have n (greater than one)
      # expect connections open at the same time.
      set mySpawn_id $spawn_id
      #  puts "doine expect_after"
      expect_after -i $mySpawn_id\
	 timeout {
	   if {[info exists ignorto] } {
	     Log "Time out ignored"
	     exp_continue
	   } else {
	     set expect_out(1,string) "Connection timed out $VFStok"
	     set re 1
	   }
	 }\
	 eof {
	   set expect_out(1,string) "Connection closed $VFStok"
	   set re 1
	 }

      frputs "doing expect 1 "
      exp_log_user $debug
      expect -i $mySpawn_id\
	 -re "(.*assword:.*)" {
	   Log $expect_out(1,string)
	   Log "sending password1"
	   exp_send -i $mySpawn_id $passwordx\r
	   exp_continue
	 } \
	 -re "(.*sername .*)\r?\n" {
	   Log $expect_out(1,string)
	   exp_continue
	 }\
	 -re "(.*.?assphrase for key .*: )" {
	   Log $expect_out(1,string)
	   Log "sending passphrase"
	   frputs passphrase
	   exp_send -i $mySpawn_id "$passphrase\r"
	   exp_continue
	 } \
	 -re "(.* host key is not .*y/n. |.* authenticity of host .*\(yes/no\)\? )" {
	   set st [regsub -all {\r} $expect_out(1,string) {}] 
	   Log $st 
	   incr ignorto
	   if { [smart_dialog .apop . [_ "Accept new host?"] \
		     [list {} "$st" [_ "\nClick your answer."]] \
		     1 2 [list [_ "No"] [_ "Yes"]]] == 1} {
	     set an [expr {[string match "*(yes/*" $expect_out(1,string)] ? \
			       "yes" : "y" } ]
	     unset ignorto
	     frputs "back from y/n " an
	     Log "sending $an" 
	     exp_send -i $mySpawn_id "$an\r"
	     exp_continue 
	   } else {
	     Log "sending 'no'" 
	     exp_send -i $mySpawn_id "no\r"
	     Log "Aborting Login"
	     set re 10
	   }
	 } \
	 -re "(.*yes\r\n)" {
	   Log $expect_out(1,string)
	   exp_continue
	 } \
	 -re "(.*Connecting .*)" {
	   Log $expect_out(1,string)
	   Log "sending password2"
	   exp_send -i $mySpawn_id $passwordx\r
	   exp_continue
	 } \
	 -re "(.*Connected to.*)\r?\nsftp> " {
	   Log $expect_out(1,string)
	   exp_send -i $mySpawn_id \r
	   exp_continue
	    set re 0
	 } \
	 -re "(.*Connected to.*)\r?\n" {
	   Log $expect_out(1,string)
	   exp_send -i $mySpawn_id \r
	   exp_continue
	    set re 0
	 } \
	 -re ".*(Remote working directory is .*)\r?\n" {
	   Log $expect_out(1,string)
	   exp_continue
	 } \
	 -re "(.*Permanently added .*)\r*\n" {
	   Log $expect_out(1,string)
	   exp_continue
	 }\
	 -re "(.*ermission denied.*)" {set re 5}\
	 -re "(.*assword.*|.*Connection refused.*|.*No such file.*|.*unable.*|.*assphrase.*|.*onnection closed.*)" {
	   Log "exit open: Failed with $expect_out(1,string)"
	   set re 5
	 }\
	 -re "(.*Warning: .*)\r?\n" {
	   Log [regsub -all {\r} $expect_out(1,string) {}]
	   exp_continue
	 }\
	 -re "(.*.?sftp> )" {
	   Log $expect_out(1,string)
	   set re 0
	 } \
	 -re "(.*)\r*\n" {
	   Log $expect_out(1,string)
	   exp_continue
	 }

      frputs  re mySpawn_id expect_out(1,string) expect_out(buffer)
      if {$re != 0} {
	catch exp_close -i $mySpawn_id
	set mySpawn_id -1
      }
      if {$re == 5} {
	# Lets try again...
	set newpw [::pwLocker::getPw $password full 1\
		       startwith [list $passwordx $idfile $passphrase]\
		       prompt  [regsub -all \r "[eId 3]Password not accepted:\
	    	           $expect_out(1,string)" {}]]
	continue
      }
      if {$re == 10} {
	#We will not ok a host.  It is up to the user to do that,
	PopError "Host not seen before and rejected, login aborted."
	catch exp_close 
	set mySpawn_id -1
	return -code error "[eId 4]$expect_out(1,string)"
      }
      if {$mySpawn_id == -1} {
	return -code error "[eId 5]$expect_out(1,string)"     
      }
      if {$pwd != "/"} {
	sFTPcd $VFStok $pwd
      }
      break
    } ; # End of trying passwords...
    return {}
  }


  proc sFTPcd {VFStok req_wd} {
    variable debug
    variable mfx
    
    VFSglobal mySpawn_id timeout abortflag pwd new_wd

    set new_wd $req_wd
    exp_log_user $debug
    frputs sftp($VFStok,new_wd)
    sFTPlist $VFStok 1
    Log "cd to $new_wd"
    exp_send -i $mySpawn_id "pwd\r$mfx"
    exp_send  -i $mySpawn_id "cd [sftpfixfilename $new_wd]\r$mfx"
    set re 0
    expect -i $mySpawn_id \
	-re "\r?cd \[^\n]*\r?\n.?sftp> " {set re 10}\
	-re "(.*)?cd \[^\n]*\r?\n.?sftp> " {set re 10}\
	-re "(.*)?cd \[^\n]*\r?\n" {set re 10}\
	-re ".?(Directory .*)\r?\n.?sftp> " {set re 3} \
	-re "\r?(.*No such file or directory.\[^\n]*)\r\n.?sftp> " {set re 3}\
	-re ".?Remote .* (now|:) \[^\r\n]*\r?\n.?sftp> " {set re 10} \
	-re ".?Remote .* (now|:) \[^\r\n]*\r?\n" {set re 10} \
	-re "\r?(Can't change directory\[^\n]*)\r\n.?sftp> " {set re 3} \
	-re "\r?(Couldn't canonicalise\[^\n]*)\r\n.?sftp> " {set re 2}\
	-re "\r?\n" {exp_send -i $mySpawn_id "\r$mfx"; exp_continue}
    
    #  puts "cd... $x"
    frputs re expect_out(1,string)
    if {$re != 10 } { 
      return -code error "[eId 6][regsub -all {\r} $expect_out(1,string) {}]"
    }
    #  puts "cd returns $x"
    set pwd $new_wd
    return 1
  }
#	-re ".*Remote working directory is (\[^\r]*)\r?\n.?sftp> " {incr re 0} \
#	-re ".*Remote directory is (\[^\r]*)\r?\n.?sftp> " {incr re 0} \

  proc sFTPpwd { VFStok } {
    variable debug
    variable mfx
    VFSglobal mySpawn_id timeout 

    frputs mySpawn_id
    exp_log_user $debug
    #  Log "sendingfrom pwd: pwd "
    exp_send -i $mySpawn_id "pwd\r$mfx"
    set re 0
    expect -i $mySpawn_id \
	-re "(pwd ?\[^\n]*\r?\n)" {
	  frputs expect_out(1,string) expect_out(buffer)
	  exp_continue
	}\
	-re "(sftp> )?.*Remote .* directory\[^/]*(\[^\r]*)\r?\n.?sftp> " {incr re 2} \
	-re ".*Remote .* directory\[^/]*(\[^\r]*)\r?\n.?sftp> " {incr re} \
	-re "(sftp> )?.*Remote .* directory\[^/]*(\[^\r]*)\r?\n" {incr re 2} \
	-re "(.*sftp> )" {
	  frputs expect_out(1,string) expect_out(buffer)
	  exp_continue
	}\
	-re "^(\r?\n)" {
	  frputs expect_out(1,string) expect_out(buffer)
	  exp_continue
	} 
    #  Log "pwd returns $expect_out(1,string) & $re"
    frputs re expect_out(1,string) expect_out(buffer)
    switch $re {
      0 {return $expect_out(1,string)}
      2 -
      1 {return $expect_out($re,string)}
      default {return -code error "[eId 11]Unexpected return from pwd:\
                                $expect_out(1,string)"}
    } 
  }
  

  proc sFTPrename {VFStok  old new} {
    VFSglobal mySpawn_id timeout
    variable mfx
    # variable sftp
    # upvar #0 VFSsftp::sftp($VFStok,handle) mySpawn_id
    # upvar #0 VFSsftp::sftp($VFStok,timeout) timeout
    frputs old new
    # current name old change to new
    # ren for windows
    exp_send -i $mySpawn_id "rename [sftpfixfilename $old] \
                   [sftpfixfilename $new]\r$mfx"
    expect -i $mySpawn_id\
	-re "(Couldn't .*)\r?\n.?sftp> " {incr re} \
	-re "(.*: no such file .*)\r?\n.?sftp> " {incr re} \
	-re "(.*: \[^/\r\n]*)\r?\n.?sftp> " {incr re} \
	-re ".*\r?\n.?sftp> " {incr re 0}

    if {$re} {return -code error "[eId 6]$expect_out(1,string)"}
    return $re 
  }

  proc sFTPdelete {VFStok filename} {
    VFSglobal mySpawn_id timeout 
    variable mfx
    # variable sftp
    # upvar #0 VFSsftp::sftp($VFStok,handle) mySpawn_id
    # upvar #0 VFSsftp::sftp($VFStok,timeout) timeout
    # file to remove sftp($VFStok,delete,filename)
    Log "Deleting $filename"
    exp_send -i $mySpawn_id "rm [sftpfixfilename $filename]\r$mfx"
    expect -i $mySpawn_id\
	-re "(Couldn't delete file: .*)\r?\n.?sftp> " {incr re} \
	-re "(Removing .*)\r?\n.?sftp> " {incr re 0}\
	-re ".*rm .*: OK\r?\n.?sftp> " {incr re 0} \
	-re "(.*: \[^/\r\n]*)\r?\n.?sftp> " {incr re} 
    if {$re} {return -code error "[eId 7]$expect_out(1,string)"}
    return $re 
  }

  proc sFTPmkdir { VFStok dir } {
    variable debug
    variable mfx
    VFSglobal mySpawn_id timeout 
    exp_log_user $debug
    # create dir sftp($VFStok,mkdir,dir)
    #  exp_send "mkdir [regsub -all {\ } $dir {\\ }]\r"
    set target [sftpfixfilename $dir]
    frputs dir target
    exp_send -i $mySpawn_id "mkdir $target\r$mfx"
    
    expect -i $mySpawn_id\
	-re "\r?(Couldn't .*)\r?\n.?sftp> " {incr re} \
	-re ".*mkdir .*: OK\r?\n.?sftp> " {incr re 0} \
	-re "(.*: \[^/\r\n]*)\r?\n.?sftp> " {incr re} \
	-re ".*\r?\n.?sftp> " {incr re 0}
    if {$re} {return -code error "[eId 8]$expect_out(1,string)"}
    return $re 
  }

  proc sFTPrmdir { VFStok dir } {
    VFSglobal mySpawn_id timeout 
    variable mfx

    # dir to remove is sftp($VFStok,rmdir,dir)
    #  exp_send "rmdir [regsub -all {\ } $dir {\\ }]\r"
    exp_send -i $mySpawn_id "rmdir [sftpfixfilename $dir]\r$mfx"
    expect -i $mySpawn_id\
	-re "(Couldn't remove directory: .*)\r?\n.?sftp> " {incr re} \
	-re ".*rmdir .*: OK\r?\n.?sftp> " {incr re 0} \
	-re "(.*: \[^/\r\n]*)\r?\n.?sftp> " {incr re} \
	-re ".*\r?\n.?sftp> " {incr re 0}
    # It seems that sftp thinks links to dirs are simple files...
    # if {$re} {return -code error "[eId 9]$expect_out(1,string)"}
    if {$re} {
      return [sFTPdelete $VFStok $dir]
    }
    return 0
  }


  proc sFTPlist {URL all} {
    variable os
    VFSglobal mySpawn_id timeout abortflag minusFflag
    variable mfx
    
    # use -l (long list) -f (no sort) -a depends on all
    # older versions of sftp do not recognize the -f...
    # about 12.5k entries at 80 chars each (hay, just poke around on sourceforge)
    while {1} {
      set flags [expr {[info exists minusFflag] ? "-l" : "-lf"}]
      set cmd [expr {$all ? "ls -a $flags" : "ls $flags" } ]
      set cmd [expr {$os == "unix" ? $cmd : "ls" } ]
      set buff {}
      exp_send -i $mySpawn_id "$cmd\r$mfx"
      expect  -i $mySpawn_id\
	  -ex "$cmd\r\n" {exp_continue}\
	  timeout {
	    if {[set $abortflag] == 1} {
	      sFTPclose  $VFStok
	      set expect_out(1,string) "User Abort";
	      set re 1
	    } else {
	      Log "Large directory, have patience.\
                      You may abort with Stop button. [incr co]"
	      exp_continue
	    }
	  } \
	  full_buffer {
	    append buff $expect_out(buffer)
	    exp_continue
	  }\
	  -re ".*nvalid flag -f.*" {
	    if {[info exists minusFflag]} {
	      incr re
	    } else {
	      incr minusFflag
	      continue
	    }
	  }\
	  -re ".*: (Permission denied).*\r?\n.?sftp> " {set re 1} \
	  -re "Listing directory \[^\n]*\n" {exp_continue} \
	  -re "(.*)\r?\n.?sftp> \r?\nsftp> " {incr re 0} \
	  -re "(.*)\r?\n.?sftp> " {incr re 0} \
	  -re "sftp> " {incr re 0; set expect_out(1,string) {}}
      if {$re}  {return -code error "[eId 12]$expect_out(1,string)"}
      # remove the \r chars
      #  puts "$expect_out(1,string)"
      append buff $expect_out(1,string)
      set buff [regsub -all {\r} $buff "" ]
      #  puts  [split $re "\n"]
      # frputs all cmd re
      return [split $buff "\n"] 
    }
  }

  proc sFTP_DoSearch { VFStok filename } {

    return -code error "[eId 13]Search not supported ... yet"
  }

  proc sFTPreget { VFStok remoteFileName localFileName } {
    return [sFTPget $VFStok $remoteFileName $localFileName]
  }

  proc sFTPget { VFStok remoteFileName localFileName args} {
    # args here are extra stuff like expected size and restart flags
    # which we don't use.
    VFSglobal mySpawn_id timeout abortflag
    variable os
    variable debug
    variable commands
    variable mfx

    exp_log_user $debug
    # get  remoteFileName and put it localFileName
    # use -p to get full times etc.
    set recur [expr {$commands(RcopyOk) & 1 == 1 ? "-r" : ""}]
    set opt [expr {$os == "unix" ? "-P $recur" : "$recur"} ]
    set remotename [sftpfixfilename $remoteFileName]
    set localname [sftpfixfilename $localFileName]
    Log "get $opt $remoteFileName to $localname"
    exp_send -i $mySpawn_id "get $opt $remotename $localname\r$mfx"

    expect -i $mySpawn_id \
	timeout {
	  if {[set $abortflag] == 1} {
	    set expect_out(1,string) "User abort"
	    sFTPclose  $VFStok;set re 1
	  } else {
	    exp_continue
	  }
	}\
	-re "(Couldn't .*)\r\n.?sftp> " {incr re} \
	-re {Fetching [^\r]*} {exp_continue} \
	-re "\r.* *(\[^ ].*:\[0-9]\[0-9])" {
	  LogStatusOnly \
	      "Transfer [file tail $remotename] $expect_out(1,string) ETA"
	  if {[set $abortflag] == 1} {
	    set expect_out(1,string) "User abort"
	    sFTPclose  $VFStok
	    set re 1
	  } else {
	    exp_continue
	  }
	} \
	-re ".*remote:.* => local:\[^\n\r]*\r?\n.?sftp> " {incr re 0}\
	-re "(.*: failure)\r?\n.?sftp> " {incr re} \
	-re ".*\r?\n.?sftp> " {incr re 0}
    if {$re} {return -code error "[eId 14]$expect_out(1,string)"}
    return $re
  }

  proc sFTPput { VFStok localFileName remoteFileName args} {
    # args again, expected size..
    VFSglobal mySpawn_id timeout abortflag
    variable os
    variable debug
    variable commands
    variable mfx

    exp_log_user $debug
    set localname [sftpfixfilename $localFileName]
    set remotename   [sftpfixfilename $remoteFileName]
    set recur [expr {$commands(RcopyOk) & 2 == 2 ? "-r" : ""}]
    set opt [expr {$os == "unix" ? "-P $recur" : "$recur"} ]
    frputs opt localname localFileName remotename remoteFileName
    # We carefully work around a sftp bug... if the source is a dir
    if {[file isdir $localname]} {
      # make sure the destination exists...
      catch {sFTPmkdir $VFStok $remotename}
      exp_send -i $mySpawn_id "cd $remotename\rlcd $localname\rput $opt .\r"
      # This is an (ugly) workaround for an sftp bug/problem)
      # None of the below work
      #exp_send "cd $remotename\rput $opt $localname\r"
      #exp_send "lcd $localname\rput $opt . $remotename\r"
      #exp_send "put $opt  $localname $remotename\r"
    } else {
      exp_send -i $mySpawn_id "put $opt $localname $remotename\r$mfx"
    }
    expect -i $mySpawn_id \
	timeout {
	  if {[set $abortflag] == 1} {
	    set expect_out(1,string) "User abort" 
	    sFTPclose  $VFStok; set re 1
	  } else {
	    exp_continue
	  }
	}\
	-re "(.*anonicalize .*)\r\n.?sftp> " {set re 3}\
	-re "(Couldn't .*)\r\n.?sftp> " {incr re} \
	-re "\r*(.*Permission denied).*\r\n.?sftp> " {incr re} \
	-re {Uploading [^\r]*} {exp_continue} \
	-re "\r.*$localname *(\[^ ].*:\[0-9]\[0-9])" {
	  LogStatusOnly "Transfer [file tail $localname]\
	  		 $expect_out(1,string) ETA"
	  if {[set $abortflag] == 1} {
	    set expect_out(1,string) "User abort" 
	    sFTPclose  $VFStok; set re 1
	  } else {
	    exp_continue
	  }
	} \
	-re ".*local:.* => remote:\[^\n]\r?\n.?sftp> " {incr re 0}\
	-re "(.*: failure)\r?\n.?sftp> " {incr re} \
	-re "(.*not a directory)\r?\n.?sftp> " {incr re} \
	-re ".*\r?\n.?sftp> " {incr re 0}

    # if {$re == 3} {
    #   # This is the dir must exist issue
    #   # take advantage of the wonders of recursion.
    #   frputs remotename remoteFileName localFileName expect_out(1,string)
    #   sFTPmkdir $VFStok $remotename
    #   return [sFTPput $VFStok [string range $localFileName 0 end-1] $remoteFileName]
    # }
    if {$re && ![string match {*Couldn't fs*} $expect_out(1,string)]} {
      return -code error "[eId 15]$expect_out(1,string)"
    }
    return $re
  }

  proc sFTPlink { VFStok exist new ar} {
    VFSglobal mySpawn_id timeout

    variable debug
    variable mfx

    exp_log_user $debug
    frputs exist new
    # point to this: sftp($VFStok,exist_fname) with this name sftp($VFStok,ln_fname)
    set opt [expr {[string match *r* $ar] ? "-sr" : "-s"}]
    exp_send -i $mySpawn_id "symlink [sftpfixfilename $exist] \
               [sftpfixfilename $new]\r$mfx"

    expect -i $mySpawn_id \
	-re "Permission denied\r\n.?sftp> " {incr re} \
	-re "(.*psftp: unknown .*)\r?\n.?sftp> " {incr re} \
	-re "Couldn't .*\r\n.?sftp> " {incr re} \
	-re "(.*)\r\n.?sftp> " {incr re 0}
    if {$re} {return -code error "[eId 16]$expect_out(buffer)"}
    return $re
  }

  proc sFTPchmod {VFStok mode file} {
    VFSglobal mySpawn_id timeout
    variable debug
    variable mfx

    exp_log_user $debug
    frputs VFStok mode file
    exp_send -i $mySpawn_id "chmod $mode [sftpfixfilename $file]\r$mfx"
    expect -i $mySpawn_id \
	-re "(Changing mode \[^\n]*)\r\n.?sftp> " {incr re 0} \
	-re "((.ouldn't .*)|(.*denied.*))\r*\n.?sftp> " {incr re} \
	-re "(.*chmod: .*)\r*\n.?sftp> " {incr re} \
	-re "(.*: no such file .*)\r*\n.?sftp> " {incr re} \
	-re "(.*)\r*\n.?sftp> " {incr re 0 }

    frputs re expect_out(1,string)
    if {! $re} return ""
    return [regsub -all {\r} $expect_out(1,string) {}]
  }
  proc sFTPchown {VFStok mode file} {
    VFSglobal mySpawn_id timeout
    variable debug
    variable mfx

    exp_log_user $debug
    frputs VFStok mode file
    exp_send -i $mySpawn_id "chown $mode [sftpfixfilename $file]\r$mfx"
    expect -i $mySpawn_id \
	-re "(Changing .*\[^\n]*)\r\n.?sftp> " {incr re 0} \
	-re "((.ouldn't .*)|(.*denied.*))\r*\n.?sftp> " {incr re} \
	-re "(.*chown: .*)\r*\n.?sftp> " {incr re} \
	-re "(.*: no such file .*)\r*\n.?sftp> " {incr re} \
	-re "(.*)\r*\n.?sftp> " {incr re 0 }
    
    frputs re expect_out(1,string)
    if {! $re} return ""
    return [regsub -all {\r} $expect_out(1,string) {}]
  }

  proc sFTPclose { VFStok} {
    VFSglobal mySpawn_id
    variable os
    variable mfx

    if {$mySpawn_id == 0} {return}
    exp_send -i $mySpawn_id [expr {$os == "unix" ? "quit\r" : "exit\r"} ]$mfx
    exp_log_file
    exp_close -i $mySpawn_id
    set mySpawn_id 
  }
  proc sftpfixfilename { n } {
    # if there are already escaped spaces, do nothing.
    if {[string match {*\\ *} $n]} {return $n}
    set n [FixFileName $n]
    if {[string first "'" $n] > 0} {
      set n \"$n\"
    }
    return $n
  }

  proc sFTPcommand {VFStok command} {
    VFSglobal mySpawn_id timeout 
    variable debug
    variable mfx

    frputs mySpawn_id 
    exp_log_user $debug
    #  expect -re ".*"
    #  Log "sendingfrom pwd: pwd "
    set stty_init -echo
    set buff {}
    exp_send -i $mySpawn_id -- "$command\r$mfx"
    set re 0
    expect -i $mySpawn_id\
	-ex "$command\r\n" {exp_continue}\
	full_buffer {
	  append $expect_out(buffer)
	  exp_continue
	}\
	-re "(.*)\r?\n.?sftp> " {incr re 2}

    return [regsub -all {\r} [append buff $expect_out(1,string)] {}]
  }
  proc sFTPdebug {VFStok bool} {
    variable debug
    if {[set debug $bool]} {
      if {[info procs [namespace current]::frputs] != {}} {
	rename [namespace current]::frputs [namespace current]::dum
      }
    } elseif {[info procs [namespace current]::frputs] == {}} {
      rename [namespace current]::dum  [namespace current]::frputs
    }
    
  }
}
