# This is the VFSftp file to interface the library ftp interface
#
package require ftp
package provide VFSftp 1.21.03.02

namespace eval VFSftp {
  variable commands
  variable ftp

  array set commands [list\
			  open ::VFSftp::FTPopen\
			  reopen ::VFSftp::FTP_openLink\
			  live ::VFSftp::FTPlive\
			  cd ::VFSftp::FTPcd\
			  delete ::VFSftp::FTPdelete\
			  mkdir ::VFSftp::FTPmkdir\
			  rmdir ::VFSftp::FTPrmdir\
			  rmdirEmpty 0\
			  isdir ::VFSftp::FTPisdir\
			  pwd ::VFSftp::FTPpwd\
			  chmod ::VFSftp::FTPchmod\
			  chown ::VFSftp::FTPnosupport\
			  list ::VFSftp::FTPlist\
			  get ::VFSftp::FTPget\
			  put ::VFSftp::FTPput\
			  RcopyOk 0\
			  rename ::VFSftp::FTPrename\
			  link ::VFSftp::FTPlink\
			  command ::VFSftp::FTPcommand\
			  close ::VFSftp::FTPclose\
			  search ::VFSftp::FTP_DoSearch]

  # Support routines *********************************
  # ******************* all with names "FTP_..."
  proc eId {n} {return "(ftp $n): "}
  
  proc FTP_Package_Error {VFStok id mess istate} {
    VFSglobal state openFail handle error ignorError
    
    frputs id mess istate state
    if {$istate == "error" && ($mess == "Not connected!" ||\
				  [string match {* 530 *} $mess])} {
      set openFail $mess
      if {![info exists handle] || $handle in {{} -1} } return
      # set mess "Link is closed $VFStok"
      if { $state == "LinkCheck" } {
	FTP_log $VFStok "Link Check failed, reopening link to $VFStok"
	FTP_openLink $VFStok
	return
      }
      FTP_Error $VFStok $mess
    }
    if {$mess == "Error opening connection!" && \
	    $state in {"get" "put"}} { 
      return
    }
    if {$istate == "error"} {
      FTP_CheckError $VFStok $mess
    }
    if {[string match "*ermission denied*" $mess] || \
	    [string match {* 5[0-9][0-9] *} $mess] || \
	    [string match {* 4[0-9][0-9] *} $mess]} {
      if { $error == {} } {
	set error $mess
	frputs mess
      }
      return
    }
    
    if {($istate == "error" && !$ignorError) } {
      frputs mess
      FTP_CheckError $VFStok $mess
      return
    }
  } 
  proc FTP_CheckError {VFStok {message ""}} {
    VFSglobal error state
    if {$message == ""} {
      set message $error
    }
    frputs message
    if {$message == "" } {
      FTP_StopClock $VFStok
      return
    }
    FTP_StopClock $VFStok abort
    error "[eId 1]$message\n\nHost: $VFStok Command: $state"
  }
  
  proc FTP_Error { VFStok message } {
    
    FTP_ShutDown $VFStok
    frputs message
    error  "[eId 2]$message\n\nHost: $VFStok"
  }
  
  proc FTP_recover {VFStok} {
    
    Vwait
    # we don't want to use FTPpwd as it calls the link is up code
    # which is US!
    set r [catch "::ftp::Pwd $handle" result]
    set ftpVwait [list $r $result]
    frputs r result
    return
  }

  
  proc FTP_TrimDir { dir } {
    FTP_fixFileName dir

    set dir [string trimright $dir /]
    if { $dir == "" } { set dir / }
    if { [string index $dir 0] == "/" } {
      while { 1 } {
	set len [string length $dir]
	if { [string range $dir [expr $len - 3] end] == "/.." } {
	  set dir [file dirname [file dirname $dir]]
	} else {
	  break
	}
      }
    }
    return $dir
  }

  proc FTP_log {VFStok mess} {
    VFSglobal progressOps
    
    frputs mess
    eval [list {*}[lindex $progressOps 0] $mess]
  }
  
  proc FTP_Progress {VFStok sofar} {
    
    VFSglobal progressOps blksize blkcount t_one expected_size to_fname
    lassign $progressOps log timefmt abtflag
    set chunksize 4096
    set t_two [ClockMilliSeconds]
    # for speed we use up to the last ten calls to figure the elapsed time
    # the amount of data will be blksize per call, up to the ten we keep track of
    # StartClock sets t_one to [ClockMilliSeconds]
    incr blkcount
    if {$t_two - $t_one < 1000} {return}

    set timeInc [expr {($t_two -  $t_one) /1000.0}]
    if {$timeInc <= 0.0} { set timeInc 1.0 }
    set speed_Bps [expr { $blkcount * $blksize / $timeInc}]
    set t_one $t_two
    set blkcount 0
    set speed [format "%.2f" [expr {$speed_Bps / 1024.0}]]
    set eta "?"
    set eta_abs "?"
    
    if {$speed_Bps > 0} {
      # figure how much time we will need to finish at this rate...
      set tmp [format "%.0f" [expr ($expected_size) - $sofar / \
				  $speed_Bps]]
      if { $tmp >= 0 } { 
	set eta [format "%02d:%02d" [expr $tmp / 60] [expr $tmp % 60]] 
	if {$timefmt  == "yymmdd" } {
	  set tmp_date "%y%m%d "
	} else {
	  set tmp_date "%d%m%y "
	} 
	set tmp_s [clock seconds]
	if { [clock format [expr $tmp_s + $tmp] -format "%y%m%d"] ==\
		 [clock format $tmp_s -format "%y%m%d"] } {
	  set tmp_date ""
	}
	set eta_abs [clock format [expr $tmp_s + $tmp] -format "$tmp_date%R"]
      }
    }
    if {$expected_size > 0} {
      FTP_log $VFStok "Transfer [file tail $to_fname] :\
                    $sofar / $expected_size bytes\
                    ($speed kB/s, ETA $eta $eta_abs)"
    } else {
      FTP_log $VFStok "Transfer [file tail $to_fname] :\
                     $sofar bytes ($speed kB/s)"
    }
    # wm iconname . "$eta $eta_abs [file tail $to_fname]"
    update idletasks
    if {[set $abtflag] } {
      FTP_Abort $VFStok
    }
    return
  }

  proc FTP_StartClock {VFStok} {
    VFSglobal t_one start_time blkcount oldicon error
    
    set t_one [ClockMilliSeconds]
    set start_time [clock seconds]
    set blkcount 0
    set oldicon [wm iconname .]
    set error {}
    # wm iconname . "? ? [file tail $to_fname]"
  }

  proc FTP_StopClock {VFStok {get 0}} {
    VFSglobal start_time from_fname to_fname expected_size
    
    if {![info exists start_time] || $start_time == {}} return

    set end_time [clock seconds]
    # This assumes success !! ?
    set size $expected_size
    if {$end_time == $start_time} {
      set total_speed "? kB/s"
    } else {
      set total_speed "[format "%.2f"\
          [expr {$size / 1024.0 / ($end_time - $start_time)}]] kB/s"
    }
    set start_time {}
    FTP_log $VFStok "Transfer [file tail $to_fname] :\
                 $size bytes -- done ($total_speed)"
    if {$get == "abort" } return
    if {! $get} {
      FTP_log $VFStok "Transfer $from_fname\
               -> $to_fname): $size bytes -- done ($total_speed"
    } else {
      FTP_log $VFStok "Transfer $from_fname\
               -> $to_fname:\
               $size bytes -- done ($total_speed)"
    }
    if {$get && [Try {set s [file size $to_fname] } "" 1] == 0 } {
      if {$expected_size > 0 && ($s != $expected_size ||\
				     $s != $size) } {
	PopWarn "Warning: Files $to_fname,\
               $from_fname are not the same size"
      }
    }
  }

  proc FTP_openLink {VFStok} {
    VFSglobal user openOps openFail handle openId fullId start_time pwd new_wd state
    
    upvar #0 VFSftp::user user

    frputs handle user openOps state openId
    if { $state != "LinkCheck"} {
      FTPclose $VFStok
    }
    set state "open"

    set pwParms [list abort 1]
    while {1} {
      set handle [::ftp::Open {*}$openId\
		      [expr {$user == "anonymous" ? \
				 $::config(ftp,password) :\
				 [set pw [::pwLocker::getPw\
					      $fullId\
					      {*}$pwParms]]}]\
		      {*}$openOps]
      if {$handle ni {-1 {}}} {
	unset -nocomplain pw
	break
      }
      set pwParms [list prompt $openFail abort 1 startwith $pw]
    }
    set start_time {}
    if {$state == "cd"} {
      set target $new_wd
    } else {
      set target $pwd
    } 
    if {$target != {}} {	
      FTPcd $VFStok $target
    }
    frputs handle 
    return $handle
  }
  
  proc FTP_ShutDown { VFStok } {
    VFSglobal handle
    
    if {$handle != -1} {
      catch "FTPclose $VFStok"
    }
    array unset ftp $VFStok,
  }

  proc FTP_fixFileName {hfile} {
    upvar $hfile file
    while {[string range $file 0 1] == "//" } {
      set file [string range $file 1 end]
    }
    return
  }
  
  # a dummy log proc, in case we don't get one on open
  proc dproc {args} {}

  # END of SUPPORT routines *****************************
  
  # We just get the call and pass it on after supplying the handle

  proc FTPnosupport {args} {
    error "[eId 3]Command not supported."
  }

  proc FTPopen {URL args} {
    VFSglobal user blksize fullId openId openOps\
	progressOps error pwd state handle new_wd openFail

    variable abortflag 0
    
    frputs URL args
    upvar #0 VFSftp::user user
    #upvar #0 VFSftp::password password
    set openFail {}
    set user {}
    # set password {}
    set port 21
    set timeout {}
    set abortflag ::[namespace current]::abtflag
    set timefmt "%d%m%y "
    set log ::[namespace current]::dproc
    # 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
    # allow override by args...
    frputs user args
    set poss {user port timeout abortflag timefmt log debug}
    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 4]FTPopen: option ($opt) must be one of: $poss"
      }
      set $tar $value
    }
    set blksize [expr {1024 * 16}]
    set fullId  $VFSpro://$user@$VFSadd:$port
    set mode [list -mode passive]
    set exOpts  [VFShelpOptions "ftp" $user $VFSadd $port]
    foreach opt $exOpts {
      set thisOpt [join [lassign [split $opt =] name] = ]
      if {$name in {mode -mode}} {
	set mode [list -mode $thisOpt]
	frputs mode
      }
    }
    
    set openId  [list $VFSadd $user]
    set openOps [list \
		     -port $port \
		     {*}$mode\
		     -blocksize $blksize \
		     -progress "[namespace current]::FTP_Progress $VFStok" \
		     -timeout $timeout \
		     -output "[namespace current]::FTP_Package_Error $VFStok"\
		    ]
    set progressOps [list $log $timefmt $abortflag]
    set error {}
    set pwd $VFSpath
    set state {}
    frputs VFStok openOps
    if {[FTP_openLink $VFStok] == -1} {
      FTP_Error $VFStok $openFail
    }
    return  
  }
  
  # We use cd to verify the link is up...
  # so we get a bit messy here
  proc FTPcd {VFStok req_wd} {
    
    VFSglobal handle state pwd error new_wd
    if {$req_wd == "" } { set req_wd "/" }
    if {[string index $req_wd 0] != "/"} {
      FTP_Error $VFStok "Internal error: FTPcd can only\
                 be called with an absolute path.($req_wd)"
    }
    frputs req_wd pwd
    # FTP_MakeSureLinkIsUp $VFStok
    set req_wd [FTP_TrimDir $req_wd]
    if { $req_wd == $pwd } {
      return 1
    }
    set state "cd"
    set new_wd $req_wd
    frputs CD new_wd pwd
    set r [catch [list ::ftp::Cd $handle $req_wd] result]
    if {$r != 0 && [string match -nocase "*closed*" $result]} {
      FTP_openLink $VFStok
      # set result [::ftp::Cd $handle $req_wd]
    }
    set error {}
    if {$result == 1} {
      set pwd $req_wd
      return 1
    }
    return $result
  }
  
  proc FTPrename { VFStok old new} {
    VFSglobal handle state 
    
    # FTP_MakeSureLinkIsUp $VFStok
    set state "rename"
    frputs old new
    ::ftp::Rename $handle  $old $new
  }

  proc FTPdelete { VFStok filename} {
    VFSglobal handle state 
    
    # FTP_MakeSureLinkIsUp $VFStok
    set state "delete"
    ::ftp::Delete $handle $filename
  }

  proc FTPmkdir {VFStok dir } {
    VFSglobal handle state 
    
    # FTP_MakeSureLinkIsUp $VFStok
    set state "mkdir"
    ::ftp::MkDir  $handle $dir
  }

  proc FTPrmdir {VFStok dir} {
    VFSglobal handle state 
    
    # FTP_MakeSureLinkIsUp $VFStok
    set state "rmdir"
    ::ftp::RmDir $handle $dir
  }
  proc FTPisdir { VFStok req_wd } {
    VFSglobal handle state pwd new_wd ignorError
    
    # FTP_MakeSureLinkIsUp $VFStok
    set req_wd  [FTP_TrimDir $req_wd]
    set new_wd $req_wd
    set ignorError 1
    set state "cd"
    if { [catch "::ftp::Cd $handle $req_wd" out] || $out == 0} {
      if {[string match {*timed out*} $out] } {
	return -code error [eId 5]$out
      }
      return 0
    }
    set pwd $req_wd
    return [FTPpwd $VFStok]
  }

  proc FTPlive {VFStok } {
    VFSglobal handle state
    
    # we come here to set the linkCheck flag
    set state "LinkCheck"
    set r [::ftp::Pwd $handle]
    set state {}
    return $r
  }
  
  proc FTPpwd { VFStok } {
    VFSglobal handle state
    
    # FTP_MakeSureLinkIsUp $VFStok
    set state "pwd"
    return [::ftp::Pwd $handle]
  }

  proc FTPlist { URL showall } {
    
    VFSglobal handle state
    # all is either "" or "-a"
    set state "list"
    set all [expr {$showall ? "-a" : ""}]
    # FTP_MakeSureLinkIsUp $VFStok
    frputs VFStok all
    return [::ftp::List $handle $all ]
  }

  proc FTPget {VFStok remoteFileName localFileName expectedSize {resume 0}} {
    VFSglobal handle state to_fname from_fname expected_size resumeLoc
    
    # FTP_MakeSureLinkIsUp $VFStok
    FTP_fixFileName remoteFileName
    FTP_fixFileName localFileName
    # These are used in the progress report code
    set expected_size $expectedSize
    set from_fname ${VFStok}$remoteFileName
    set to_fname $localFileName
    set state "get"
    # resume logic...
    # We always use Reget, but if not resuming, set the resume loc to 0
    set r 1
    if { $resume && [file writable "$localFileName"] } {
      set r [catch {set resumeLoc [file size "$localFileName"]}]
    }
    if {$r} {
      # not resuming...
      set resumeLoc 0
    }
    set expected_size \
 	  [expr {$expectedSize - $resumeLoc}]

    FTP_StartClock $VFStok
    frputs remoteFileName localFileName resumeLoc
    set rtn [::ftp::Reget $handle \
		 $remoteFileName $localFileName {*}$resumeLoc]
    FTP_CheckError $VFStok
    return $rtn
  }

  # proc FTPreget {VFStok remoteFileName localFileName} {
  #   
  #   # FTP_MakeSureLinkIsUp $VFStok
  #   return [::ftp::$Reget $handle $remoteFileName $localFileName]
  # }

  proc FTPput {VFStok localFileName remoteFileName size} {
    VFSglobal handle state to_fname from_fname expected_size
    
    FTP_fixFileName remoteFileName
    FTP_fixFileName localFileName
    # set up the progress stuff
    set expected_size $size
    set to_fname ${VFStok}$remoteFileName
    set from_fname $localFileName 

    # FTP_MakeSureLinkIsUp $VFStok
    # FTP_InvalidateCache $VFStok $remoteFileName
    FTP_StartClock $VFStok
    set state "put"
    set rtn [::ftp::Put $handle $localFileName $remoteFileName]
    FTP_CheckError  $VFStok
    return $rtn
  }

  proc FTPlink {VFStok exist new ra} {
    variable config
    VFSglobal handle state
    
    # FTP_MakeSureLinkIsUp $VFStok
    set state "ln"
    set opt [expr {[string match *r* $ra] ? "-sr" : "-s"}]
    # Let try to cobble a command together
    return [::ftp::Quote $handle ln $opt $exist $new ]
  }

  proc FTPsite2 {VFStok cmd one two} {
    VFSglobal handle
    
    frputs cmd VFStok one two
    set r [::ftp::Quote $handle SITE $cmd $one $two]
    frputs cmd one two r
    if {[string match  "200 *" $r]} {
      frputs "Returning success "
      return ""
    }
    return $r
  }

  proc FTPchmod {VFStok mode file} {
    # FTP_MakeSureLinkIsUp $VFStok
    # FTP_InvalidateCache $VFStok[file directory $file]
    return [FTPsite2 $VFStok chmod $mode $file]
  }

  proc FTPclose {VFStok} {
    VFSglobal handle
    
    if {[info exist handle] && $handle != -1} {
      ::ftp::Close $handle
    }
  }

  proc FTP_DoSearch {VFStok filename} {
    VFSglobal handle state
    
    set state "LOCATE"
    set re [::ftp::Quote $handle site locate $filename]
    if {[string match {500*} $re] } {
      return -code error [eId 6]$re
    }
    return $re
  }

  proc FTPcommand {VFStok command} {
    VFSglobal handle
    
    set r [catch {::ftp::Quote $handle {*}$command} result]
    if {$r != 0} {
      frputs VFStok command result
      set result "Sorry, the command \"$command\" returned error: $result"
    }
    return $result
  }
}			 
