#---------------------------------------------------##  Module : ftp.tcl#  Author : MK#  Date   : 27 Oct 1997##  Description :##  This module provides FTP facilities. It is intended to run as a separate#  process so it can be stopped if it hangs or takes too long.#  Facilities provided are:##  - Listing a remote directory#  - Getting a remote file (In binary mode)##  Note:#    All operations are done in Anonymous ftp mode.##  Activation:#    ftp.tcl <response_path> <server> <action> <remote_path> [<local_path>]##        actions:  list  (1 path) #                  get   (2 paths)#---------------------------------------------------##  Change History #  --------------#  19971027 - First Version#global FTP_Gproc ftp.main {RESPONSE_PATH LOG_PATH SERVER ACTION REMOTE_PATH LOCAL_PATH\               EXPECTED_SIZE PROGRESS_PATH} {   global FTP_G   global env         if [catch {open $LOG_PATH {WRONLY CREAT TRUNC} 0777} LOG_FP] {      FTP::SetLogFile ""      set LOG_FP ""   } else {      FTP::SetLogFile $LOG_FP   }      ftp.debug_write_file "$REMOTE_PATH $EXPECTED_SIZE $PROGRESS_PATH "   if [file exists $RESPONSE_PATH] {     file delete $RESPONSE_PATH   }   set USER ftp      set PASSWORD "$env(USER)@[info hostname]"      # Our ftp server requires <user>@<host>.<domain>   # "info hostname" does not always return domain      if {[regexp ".+@.+\\..+" $PASSWORD] == 0} {      set PASSWORD "$PASSWORD.unknown_domain"   }   ftp.debug_write_file "Before open $SERVER $USER $PASSWORD"   set FTP_RESPONSE [FTP::Open $SERVER $USER $PASSWORD]   ftp.debug_write_file "After open $SERVER $USER  $PASSWORD"   if { $FTP_RESPONSE == 0 } {      ftp.write_error $RESPONSE_PATH      exit 0   }   FTP::Type binary      switch -- $ACTION {     list {       ftp.debug_write_file  "Before list"       set FTP_RESPONSE [FTP::List $REMOTE_PATH]       ftp.debug_write_file  "After list"       ftp.write_response $FTP_RESPONSE $RESPONSE_PATH     }      get {            set FTP_G(EXPECTED_SIZE) $EXPECTED_SIZE       set FTP_G(FP) ""       if { $EXPECTED_SIZE > 0 } {          ftp.debug_write_file "ftp progress path = $PROGRESS_PATH"          if [file exists $PROGRESS_PATH] {             file delete $PROGRESS_PATH          }	  if { [catch {open $PROGRESS_PATH {WRONLY CREAT} 0777 } FTP_G(FP)] } {	    ftp.debug_write_file $FTP_G(FP)	    set FTP_G(FP) ""	  } else {	    ftp.debug_write_file  "Open Success - $FTP_G(FP)"	  }       }                 ftp.debug_write_file  "Before Get - $REMOTE_PATH"       set FTP_RESPONSE \             [FTP::Get $REMOTE_PATH $LOCAL_PATH \	               read_callback $FTP_G(EXPECTED_SIZE) ]       ftp.debug_write_file  "After Get - $REMOTE_PATH"       if { $FTP_G(FP) != "" } {          close $FTP_G(FP)       }       if { $FTP_RESPONSE == 0 } {         ftp.write_error $RESPONSE_PATH       } else {	  ftp.write_response "" $RESPONSE_PATH       }     }      default {	bgerror "Switch error ftp.tcl (1)"     }    }   catch { FTP::Close }    if { $LOG_FP != "" } {      close $LOG_FP   }}proc read_callback { SIZE } {   global FTP_G      ftp.debug_write_file \      "read_callback: $FTP_G(FP) $FTP_G(EXPECTED_SIZE)"   if {$FTP_G(FP) != "" && $FTP_G(EXPECTED_SIZE) > 0} {     seek $FTP_G(FP) 0     set PERCENT [expr $SIZE*100.0/$FTP_G(EXPECTED_SIZE)]     set PERCENT [expr $PERCENT-0.05]     if { $PERCENT < 0 } {        set $PERCENT 0     }     puts -nonewline  $FTP_G(FP) [format "%6.1f%%" $PERCENT]      flush $FTP_G(FP)   }}proc ftp.write_error { RESPONSE_PATH } {   ftp.write_response "@ERROR@"  $RESPONSE_PATH}proc ftp.write_response { RESPONSE RESPONSE_PATH } {  if [ catch {open $RESPONSE_PATH {WRONLY CREAT} 0777} FP ] {     bgerror "$FP"     return  }  puts -nonewline $FP $RESPONSE  close $FP}proc ftp.debug_write_file { STRING } {   global FTP_G      #   if { $FTP_G(OS) == "nt" } {#     set TEMP_PATH "C:/TEMP"#   } else {#     set TEMP_PATH "/usr/tmp"#   }#   set PATH [file join $TEMP_PATH ftp.tcl.log]#   if { ! [catch { open $PATH {WRONLY CREAT} 0777 } FP] } {#      seek $FP 0 end#      puts $FP $STRING#      close $FP#   }}wm withdraw .set WISH [info nameofexecutable]set TCLTK [file dirname [file dirname $WISH]]set CDROM [file dirname [file dirname [file dirname $TCLTK]]]set AUTO_PATH1 [file join $CDROM tools generic tcltk library]set AUTO_PATH2 [file join $CDROM install]set auto_path [list $AUTO_PATH1 $AUTO_PATH2]# The next line bypasses the need to use pkgIndex.tcl file which is# dangerous to use on CDROM (Mixed case)package ifneeded FTP 0.8 [list source [file join $AUTO_PATH2 ftp ftp_lib.tcl]]#package require FTPset RESPONSE_PATH [lindex $argv 0]set LOG_PATH      [lindex $argv 1]set SERVER        [lindex $argv 2]set ACTION        [lindex $argv 3]set REMOTE_PATH   [lindex $argv 4]set LOCAL_PATH    [lindex $argv 5]set EXPECTED_SIZE [lindex $argv 6]set PROGRESS_PATH [lindex $argv 7]set FTP_G(OS)     [lindex $argv 8]ftp.main $RESPONSE_PATH $LOG_PATH $SERVER $ACTION $REMOTE_PATH $LOCAL_PATH \         $EXPECTED_SIZE $PROGRESS_PATHexit 0