# <20190515.1114.32>

# The rsync command makes every attempt to make the copy using direct
# requests to the target or source machine.  If both files are local
# things are real simple.
#
# We translate local file names to host:file names for the following
# connections:
#
# nsf
# cifs
# ftp
# sftp
#
# nsf works well out of the box. For the others we need to translate
# the root address from what it looks like here to what it is on the
# other machine. We also can only handle transfers where at least one 
# end is local.
#
#
#
# This procedure takes a file name and returns the components
# needed to build a rsync reference to an external file.
#
# Possible file name references:
#
# <file>                           (local file)
# [user@]host:file                 (rsync using a remote shell & scp's format)
# [user@]host::<file>              (rsync using an rsync daemon)
# rsync://[user@]host[:port]<file> (rsync using an rsync daemon)
# 
# If the file is local, a list containg an empty (i.e. {}) value
# followed by the passed in name.
#
# If the reference is to a remote file that is mounted on this
# system the return consists of a list containing the remote 
# system name (host) followed by the file name as it appears on the remote
# system.
# 
# The intent here is that the caller can use the file name thusly:
#
# rsync <options> [join [fileNameTranslate <souce file>] :]
# or, for more complex file names:
# lassign [fileNameTranslate <souce file>] host file
# if {$host == {}} {
#   set url $file
# } else {
#   set url [format "rsync://%s@%s:%s/%s" $user $host $port $file]
#


# frTranslateDir does the following:
# 1) breaks up the file/dir name into the local and remote parts
#    For remote names it scans the rsync look up table at config(rsync)
#    Each entry in this table should provide:
#    0) the share name as in /etc/fstab (first entry on the line)
#       if the share is ftp or sftp, then (s)ftp://user@host
#       (user is required as different users may have different dirs.)
#    1) for other than nfs, the dir this connection accesses on the host
#       for example, for ftp this might be /home/ftp/pub 
#    2) rsync mode to use, one of {shell daemon}
#    3) rsync options to use with this machine (if not provided the 
#       global rsync options are used.
#    4) Here is the run down on passwords:
#       nfs, remote shell or daemon if needed (user name from fstab)
#       cifs, remote shell or daemon if needed (user name from fstab)
#       ftp,  remote shell or daemon only if different from ftp connection
#       sftp, remote shell or daemon only if different from sftp connection
#
#       We assume the remote shell option will use ssh and provide code
#       to pass the password.

#  Just to make it complete, here is what a cifs/smb URL looks like in all its
#  gory detail.
#       smb://[[[authdomain;]user@]host[:port][/share[/path][/name]]][?context]

#  From the standard point of view either "smb" or "cifs" may
#  be used as the protocol id. While "authdomain;" is supposed to indicate
#  whate domain the user is from. We will treat the whole of authdomain;user@
#  as one thing, i.e. if authdomain is present or not we don't care as long
#  as such places that we need a user name, it is recognized as that.
#  In filerunners password locker we will use the following cifs ID:

#  cifs://[authdomain;]user@host[:port]/share

#  The assumption here is that, for password purposes we don't need the path
#  and we use "cifs" just because we like it.

proc frTranslateDir {dir} {
  global glob config
  # if the 'dir' is ftp or sftp we can translate. At this time we don't 
  # do ?ftp for ? != "" or "s".
  #
  if {[IsVFS $dir]} {
    if {$VFSpro ni {"ftp" "sftp" "rsync"}} {
     error "rsync command can't handle $VFSpro files."
    }
    # it is a legal  path.  IsVFS set 'VFStok' and 'VFSadd' for us
    #########################################################################
    # This code is dependent on knowing the namespace items for ftp & sftp  #
    #########################################################################
    # As of.. NOW .. we no longer keep the password in the global namespace
    # for security reasons. This means we will need to fetch it when needed
    # The namespace variable called "password" is actually the ID of the
    # VFS with the user name embedded, just what is needed for the password
    # locker.
    #
    lassign [split $VFSadd :] host port
    set host [regsub {^[^@]*@} $host {}]
    # Not sure of the above as host should now be <protocol>://host
    set username [set ::VFS${VFSpro}::${VFSpro}($VFStok,user)]
    set pwdID $VFSpro://$username@$host
    if {$port != {}} {
      set pwdID $pwdID:$port
    }
    set parts [list scheme $VFSpro \
		   path $VFSpath\
		   user $username\
		   host $host\
		   port $port \
		   pwd $pwdID]
  } else {
    set parts [fileNameTranslate $dir]
  }
  # at this point we have all we need for nfs and local files
  # for others we need to use a table (hopefully) set up in the
  # config area to translate the share or (s)ftp path to the root on 
  # the remote machine.
  frputs "parts of the target  " parts
  array set urlA $parts

  # Set the default options and password values
  upvar rsyncOps  rsyncOps
  upvar rsyncPwd  rsyncPwd
  upvar rsyncHost rsyncHost
  upvar rsyncMode rsyncMode
  set searchOps [list -index 0 -inline]
  # this while is just so the switch default can 'break'
  # it should NEVER loop.
  while {1} {
    # If local file, don't set the Pwd Host and Ops
    if {$urlA(scheme) == "file"} {return $urlA(path)}
    # Time to set option defaults
    # set rsyncHost {}
    #lassign [lindex $config(rsync,table) 0] d d rsyncMode rsyncOps rsyncPwd
    switch -exact $urlA(scheme) {
      ftp   -
      rsync -
      sftp  {
	set qPort [expr {$urlA(port) != {} ? ":$urlA(port)" : {}}]
	set pattern $urlA(scheme)://$urlA(user)@$urlA(host)*
      }
      nfs -
      cifs {set pattern $urlA(share);lappend searchOps -nocase}
      default {error "rsync unknown file type: $urlA(schemd)"}
    }
    # At this point we know the file is remote
    set info [lsearch {*}$searchOps $config(rsync,table) $pattern]

    # don't require a table entry for 'nfs' files.
    if {$info == {}} {
      if {$urlA(scheme) == "nfs"} {break}
      error "rsync info for remote $pattern not in rsync table."
    }
    # set rsyncPwd [decrypt $::env(USER) $rsyncPwd]
    lassign $info key rPath Mode Ops
    # set Pwd      [decrypt $::env(USER) $Pwd]##########################################
    set rsyncMode [expr {$Mode == {} ? $rsyncMode : $Mode}]
    set rsyncOps [expr {$Ops == {} ? $rsyncOps : $Ops}]
    frputs "pwd  " Pwd urlA(pwd) rsyncPwd
    # set rsyncPwd [expr {$Pwd != {} ? $Pwd : \
    # 			    [expr {$urlA(pwd) != {} ? $urlA(pwd) : $rsyncPwd}]}]
    #set rsyncPwd [decrypt $::env(USER) $rsyncPwd]1
    # set rsyncPwd $urlA(pwd)
    # frputs "decrypt  " rsyncPwd urlA(path)
    if {$urlA(scheme) != {nfs}} {
      set urlA(path) [lindex $info 1]/$urlA(path)
    }
    break
  }
  # Here we take care of the password stuff. We need a 3 part password if
  # ssh is involved which is true if either "scp" or "ssh" "putty" "pscp"
  # Oh, and there are others...
  # here we look for the key "$disc" which we will fill with part 2
  # of the address. Oh, darn, lets just use 3 part password all the time...
  set rsyncPwd [::pwLocker::getPw $urlA(pwd) full 1]
  if {$rsyncPwd == -1} {
    return -code error [_ "User abort on asking for password for %s." $urlA(pwd)]
  }
  set disc [lindex $rsyncPwd 1]
  lappend rsyncPwd $urlA(pwd)
  set rsyncOps [subst -nob $rsyncOps]
  # Modules (see rsync man page) are indicated by mode "daemon=modname"
  lassign [split $rsyncMode =] dae module
  # All that is left is to build the rsync dir string. Note we do not 
  # put the port here. If needed it should be part of rsyncOps
  set rsyncHost $urlA(host)
  frputs "build name  " urlA(user) urlA(host) urlA(path) rsyncHost rsyncPwd
  return "$urlA(user)[expr {$urlA(user) != {} ? "@" : ""}]$urlA(host)[expr \
                           {$dae == {daemon} ? {::$module} : {:}}]$urlA(path)"
}

proc myLog {w mess {close {}}} {
  # all these messages go to the window...
  # this code tries to make the window act as a terminal would
  # this means we need to interpret \r so as to replace lines
  # to do this we need to have some notion of the fact that a line
  # ended with a "\r". So as not to require global storage we
  # do this by moving 'insert' to the required location for
  # the delete, but we don't do that until we get the next line.
  if {$close != {}} {
    # fix the undo so we don't prompt to save if s/he does nothing.
    $w.text edit reset
    $w.text edit modified 0
    return
  }
  # Here we finish set up of the window by adding the stop
  # button
  if {![info exists ::fileNameTranslate::progress($w,sid)]} {
    return
  }
  # skip is already done...
  if {![info exist  ::fileNameTranslate::progress($w,buildStop)]} {
    incr ::fileNameTranslate::progress($w,buildStop)
    lassign $::fileNameTranslate::progress($w) prog rsyncOps fileList
    set geo [buildStop $w [_ "Rsync: Running \
      	               \n%s %s %s" $prog $rsyncOps $fileList]\
		 "expectAbort $w" 1]
    if {[winfo exists $w]} {wm geo $w $geo}
  }
  # Here we add progress info to the window.
  set mess [regsub -all \r\n $mess "\n"]
  set mes [split $mess "\r"]
  #set mes lassign $mes ms
  set first 0
  lassign [$w.text yview] start end
  # puts "$start $end"
  foreach ms $mes {
    incr first
    lassign [split [$w.text index insert] .] insertL insertC
    if {$ms == {} || $first != 1} {
      $w.text mark set insert $insertL.0
      if {$ms == {}} {continue}
    }
    # do we have a pending delete?
    if {$insertC == 0} {
      $w.text delete $insertL.0 end-1c
    }
    $w.text insert insert $ms
  }
  if {$end == 1.0} {
    $w.text see insert
  }
  $w.text edit reset
  $w.text edit modified 0
}


proc CmdRsync {} {
  global glob config
  lassign [lindex $config(rsync,table) 0] d d rsyncMode rsyncOps
  set rsyncHost {}
  foreach pane {left right} {
    set sel [$glob(listbox,$pane).file curselection]
    if {$sel != {}} {
      # first translate the from and to directories.
      foreach way {from to} pan "$pane [Opposite $pane]" {
	set ${way}Dir [frTranslateDir $glob($pan,pwd)]
	set ${way}Remote [string match $glob($pan,pwd) {*:*}]
      }
      if { $glob(left,pwd) == $glob(right,pwd) } {
	SandDsame 
	return {}
      }
      foreach file $sel {
	lappend fileList $fromDir/[lindex $glob($pane,filelist) $file 1]
      }
      lappend fileList $toDir
      set toPwd $glob($pan,pwd)
      # An alternate program can be indicated by rsyncMode "use=alt"
      lassign [split $rsyncMode =] op alt
      set prog [expr {$op == {use} ? "$alt" : "rsync -s"}]
      frputs "prog  " op alt prog
      set nill {}
      set w [ViewString [_ "%s progress window" $prog] nill ""] 
      # puts "window $w"
      # using expect package to help with password...
      catch {unset spawn_id}
      if {![info exists glob(expect)]} {
	# not defined => not loaded, 1 => full expect, 0 => Tcl expect
	set glob(expect) 1
	# There does not seem to be an "Expect" package for windows,
	# so don't ask for the impossible.
	if { [catch "package require Expect" out] != 0 || \
		 $out == "0.0.0"} {
	  if {!$::MSW} {
	    Log "Full Expect not found, using pure Tcl expect"
	    PopInfo [_ "Expect not found. Rsync will likely fail to properly\
                          login.\nPlease down load and install the 'expect'\
                      	    package from your\nsystem repo."]
	  }
	  set glob(expect) 0
	}
      }
      exp_log_user $glob(debug)
      if {$glob(debug)} {
	if {$glob(expect) == 0} {
	  # only my expect can handle a Log procedure.
	  exp_log_file -a -proc Log
	} else {
	  exp_log_file  -a -noappend $glob(tmpdir)/Log
	}
      }
      if {![info exists ::fileNameTranslate::progress]} {
	namespace eval ::fileNameTranslate {
	  variable progress
	}
      }
      set ::fileNameTranslate::progress($w) [list $prog $rsyncOps $fileList]
      # ready to rock...
      # Note to me: This call formats but does not make the spawn call...
      set cmd [frECF [list spawn -noecho {*}$prog {*}$rsyncOps ]\
		   $fileList\
		   [list -f 1]]

      # This should allow local to local
      if {![info exists rsyncPwd]} {set rsyncPwd {}}
      # at this point we turn the rest over to a handler...
      frputs "sending:  " w cmd rsyncPwd rsyncHost

      Try [list rsyncExpectHandler $w $cmd $rsyncPwd $toPwd $rsyncHost] "" 0 1
      return
    }
  }
}

proc expectAbort {w args} {
  # get here if user clicks the stop button
  set spawn_id $::fileNameTranslate::progress($w,sid)
  incr ::fileNameTranslate::progress($w,userStop) 
  if {[catch {exp_pid -i $spawn_id} pid] != 0} {
    frputs "expectAbort  " pid
    return
  }
  set sig [expr {$args == 1 ? "SIGINT" : "SIGKILL"}]
  catch {exec [auto_execok kill] -s $sig $pid} s
  frputs "kill  " sig pid s
}

proc rsyncExitCleanUp {w {err {}}} {
  if {[info exists ::fileNameTranslate::progress($w,userStop)]} {
    set err "User async abort vi Stop button"
  }
  array unset ::fileNameTranslate::progress $w,*
  if {$err != {}} {
    error $err
  }
}
proc rsyncExpectHandler {w cmd rsyncPwd toPwd {rsyncHost {}}} {
  frputs "received:  " w cmd rsyncPwd rsyncHost
  global glob
  lassign $rsyncPwd Pword none passphrase pwId
  set sentPw 0
  while {1} {
    set r [catch {{*}$cmd} out]
    if {$r != 0} {
      destroy $w
      rsyncExitCleanUp $w "Really bad error: $out" 
      return
    }
    set  ::fileNameTranslate::progress($w,sid) $spawn_id

    
    expect_after timeout \
	{set expect_out(1,string) "Connection timed out $rsyncHost";\
	     set re 1}\
	eof {set expect_out(1,string) "Connection closed $rsyncHost" ;\
		 set re 0}
    expect -re "(.*assword:.*)" \
	{myLog $w "$expect_out(1,string)"
	  Log "sending password"
	  # frputs "open password  " rsyncPwd
	  myLog $w "sending password\n"
	  exp_send $Pword\r
	  incr sentPw
	  exp_continue} \
	-re "(.*.?assphrase for key .*: )" {
	  myLog $w "$expect_out(1,string)"
	  myLog $w "sending passphrase\n"
	  exp_send "$passphrase\r"
	  incr sentPw
	  exp_continue} \
	-re "(.* host key is not .*y/n. |.* authenticity of host .*\(yes/no\)\? )"\
	{
	  # clean the out string for the smart_dialog call
	  set st [regsub -all {\r} $expect_out(1,string) {}] 
	  myLog $w $expect_out(1,string) 
	  incr ignorto
	  if { [smart_dialog .apop[incr ::uni] . [_ "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
	    myLog $w "sending $an\n" 
	    exp_send "$an\r"
	    incr sentPw
	    exp_continue 
	  } else {
	    myLog $w "sending 'no'\n" 
	    exp_send "no\r"
	    Log "Aborting Login"
	    set re 10
	  }
	} \
	-re {(^[^\n]{0,10}yes\r\n)} {
	  # The above pattern requires beginning of line, no \n's fewer
	  # than 11 chars before the yes.
	  myLog $w $expect_out(1,string)
	  exp_continue} \
	-re "(.*Warning: .*)\r?\n" {
	  myLog $w "$expect_out(1,string)"
	  exp_continue}\
	-re "(.*Connecting .*)" {
	  myLog $w "$expect_out(1,string)"
	  myLog $w "sending password2\n"
	  exp_send $rsyncPwd\r
	  incr sentPw
	  exp_continue} \
	-re "(.*Permanently added .*)\r*\n" {
	  myLog $w "$expect_out(0,string)"
	  exp_continue}\
	-re "(.*ermission denied.*)" {
	  set re 5}\
	-re "(.*assword .*|.*unable .*|.*assphrase .*|.*onnection closed.*)" {
	  myLog $w "exit open: Failed with $expect_out(1,string)\n"
	  set re 5}\
	-re "(.*)\r*\n" {
	  #frputs expect_out(1,string) expect_out(0,string)
	  myLog $w "$expect_out(0,string)"
	  exp_log_user $glob(debug)
	  exp_continue}\
	-re "(.*)\r" {
	  #frputs expect_out(1,string) expect_out(0,string)
	  myLog $w "$expect_out(0,string)"
	  exp_log_user $glob(debug)
	  exp_continue}
    # password failure (re = 5)
    # here we try to recover from a bad password...however,
    # if the password was not passed (sentPw == 0), forget about it
    if {$re == 5 && $sentPw != 0} {
      # Lets try again...
      set newpw [::pwLocker::getPw $pwId full 1\
		     startwith [lrange $rsyncPwd 0 2]\
		     prompt  [regsub -all \r "Password not accepted:\
	    	                     $expect_out(1,string)" {}]]
      continue
    }
    break
  }
  # We get here on:
  # close            (re = 0)
  # timeout          (re = 1)
  # reject new host  (re = 10)
  #
  # After a close/timeout we need to do a wait to get the 
  # status of the completion...m
  StopButRemove $w
  UpdateIf $toPwd/x
  # On the way out, resize the window...
  intelWinSize $::config(geometry,textviewer) $w.text increase 1 location bound
  catch "exp_close -i $spawn_id"
  #ForceUpdate $inst
  set rtn [exp_wait -i $spawn_id]
  lassign $rtn r1 r2 r3 r4
  if {$r3 != 0 || $r4 != 0} {

    # some sort of error...
    myLog $w "rsync [expr {$r3 == 0 ? {threw system error} :\
                                        {returned completion code}}]: $r4\n"
    myLog $w {} close

    if {![info exists ::fileNameTranslate::progress($w,userStop)]} {
      # pull the last N lines from the log and send them to 
      # PopError
      set N 7
      set last [string length $::glob(log)]
      while {[incr N -1] >= 0 && \
		 [set last [string last "\n" $::glob(log) ${last}-1]] > 0} {}
      PopError "[string range $::glob(log) ${last}+1 end]\
                  \nLast few output lines above. See Log for more."
    }
  }
  rsyncExitCleanUp $w
}
