ftp.tcl

genesis 2000 v9.1软件下载

#---------------------------------------------------
#
#  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_G

proc 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 FTP
set 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_PATH
exit 0