home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 5 / hacker05 / 05_HACK_05.ISO / programacao / freewrap / TCLLIBsampleApp.exe / sample / tcllib / tcllib1.0 / ftp / ftp.tcl next >
Encoding:
Text File  |  2001-08-17  |  72.1 KB  |  2,792 lines
  1. # ftp.tcl --
  2. #
  3. #    FTP library package for Tcl 8.2+.  Originally written by Steffen
  4. #    Traeger (Steffen.Traeger@t-online.de); modified by Peter MacDonald
  5. #    (peter@pdqi.com) to support multiple simultaneous FTP sessions;
  6. #    Modified by Steve Ball (Steve.Ball@zveno.com) to support
  7. #    asynchronous operation.
  8. #
  9. # Copyright (c) 1996-1999 by Steffen Traeger <Steffen.Traeger@t-online.de>
  10. # Copyright (c) 2000 by Ajuba Solutions
  11. # Copyright (c) 2000 by Zveno Pty Ltd
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. # 
  16. # RCS: @(#) $Id: ftp.tcl,v 1.14 2001/08/02 16:38:06 andreas_kupries Exp $
  17. #
  18. #   core ftp support:     ftp::Open <server> <user> <passwd> <?options?>
  19. #            ftp::Close <s>
  20. #            ftp::Cd <s> <directory>
  21. #            ftp::Pwd <s>
  22. #            ftp::Type <s> <?ascii|binary|tenex?>    
  23. #            ftp::List <s> <?directory?>
  24. #            ftp::NList <s> <?directory?>
  25. #            ftp::FileSize <s> <file>
  26. #            ftp::ModTime <s> <from> <to>
  27. #            ftp::Delete <s> <file>
  28. #            ftp::Rename <s> <from> <to>
  29. #            ftp::Put <s> <(local | -data "data"> <?remote?>
  30. #            ftp::Append <s> <(local | -data "data"> <?remote?>
  31. #            ftp::Get <s> <remote> <?(local | -variable varname)?>
  32. #            ftp::Reget <s> <remote> <?local?>
  33. #            ftp::Newer <s> <remote> <?local?>
  34. #            ftp::MkDir <s> <directory>
  35. #            ftp::RmDir <s> <directory>
  36. #            ftp::Quote <s> <arg1> <arg2> ...
  37. #
  38.  
  39. package require Tcl 8.2
  40. package provide ftp [lindex {Revision: 2.2 } 1]
  41.  
  42. namespace eval ftp {
  43.  
  44. namespace export DisplayMsg Open Close Cd Pwd Type List NList FileSize ModTime\
  45.          Delete Rename Put Append Get Reget Newer Quote MkDir RmDir 
  46.     
  47. set serial 0
  48. set VERBOSE 0
  49. set DEBUG 0
  50. }
  51.  
  52. #############################################################################
  53. #
  54. # DisplayMsg --
  55. #
  56. # This is a simple procedure to display any messages on screen.
  57. # Can be intercepted by the -output option to Open
  58. #
  59. #    namespace ftp {
  60. #        proc DisplayMsg {msg} {
  61. #            ......
  62. #        }
  63. #    }
  64. #
  65. # Arguments:
  66. # msg -         message string
  67. # state -        different states {normal, data, control, error}
  68. #
  69. proc ftp::DisplayMsg {s msg {state ""}} {
  70.  
  71.     upvar ::ftp::ftp$s ftp
  72.     variable VERBOSE 
  73.     
  74.     if { ([info exists ftp(Output)]) && ($ftp(Output) != "") } {
  75.         eval [concat $ftp(Output) {$s $msg $state}]
  76.         return
  77.     }
  78.         
  79.     switch -exact -- $state {
  80.         data {
  81.             if { $VERBOSE } {
  82.                 puts $msg
  83.             }
  84.         }
  85.         control    {
  86.             if { $VERBOSE } {
  87.                 puts $msg
  88.             }
  89.         }
  90.         error {
  91.             error "ERROR: $msg"
  92.         }
  93.         default    {
  94.             if { $VERBOSE } {
  95.                 puts $msg
  96.             }
  97.         }
  98.     }
  99.     return
  100. }
  101.  
  102. #############################################################################
  103. #
  104. # Timeout --
  105. #
  106. # Handle timeouts
  107. # 
  108. # Arguments:
  109. #  -
  110. #
  111. proc ftp::Timeout {s} {
  112.     upvar ::ftp::ftp$s ftp
  113.  
  114.     after cancel $ftp(Wait)
  115.     set ftp(state.control) 1
  116.  
  117.     DisplayMsg "" "Timeout of control connection after $ftp(Timeout) sec.!" error
  118.     Command $ftp(Command) timeout
  119.     return
  120. }
  121.  
  122. #############################################################################
  123. #
  124. # WaitOrTimeout --
  125. #
  126. # Blocks the running procedure and waits for a variable of the transaction 
  127. # to complete. It continues processing procedure until a procedure or 
  128. # StateHandler sets the value of variable "finished". 
  129. # If a connection hangs the variable is setting instead of by this procedure after 
  130. # specified seconds in $ftp(Timeout).
  131. #  
  132. # 
  133. # Arguments:
  134. #  -        
  135. #
  136.  
  137. proc ftp::WaitOrTimeout {s} {
  138.     upvar ::ftp::ftp$s ftp
  139.  
  140.     set retvar 1
  141.  
  142.     if { ![string length $ftp(Command)] && [info exists ftp(state.control)] } {
  143.  
  144.         set ftp(Wait) [after [expr {$ftp(Timeout) * 1000}] [list [namespace current]::Timeout $s]]
  145.  
  146.         vwait ::ftp::ftp${s}(state.control)
  147.         set retvar $ftp(state.control)
  148.     }
  149.  
  150.     if {$ftp(Error) != ""} {
  151.         set errmsg $ftp(Error)
  152.         set ftp(Error) ""
  153.         DisplayMsg $s $errmsg error
  154.     }
  155.  
  156.     return $retvar
  157. }
  158.  
  159. #############################################################################
  160. #
  161. # WaitComplete --
  162. #
  163. # Transaction completed.
  164. # Cancel execution of the delayed command declared in procedure WaitOrTimeout.
  165. # 
  166. # Arguments:
  167. # value -    result of the transaction
  168. #            0 ... Error
  169. #            1 ... OK
  170. #
  171.  
  172. proc ftp::WaitComplete {s value} {
  173.     upvar ::ftp::ftp$s ftp
  174.  
  175.     if {![info exists ftp(Command)]} {
  176.     set ftp(state.control) $value
  177.     return $value
  178.     }
  179.     if { ![string length $ftp(Command)] && [info exists ftp(state.data)] } {
  180.         vwait ::ftp::ftp${s}(state.data)
  181.     }
  182.  
  183.     catch {after cancel $ftp(Wait)}
  184.     set ftp(state.control) $value
  185.     return $ftp(state.control)
  186. }
  187.  
  188. #############################################################################
  189. #
  190. # PutsCtrlSocket --
  191. #
  192. # Puts then specified command to control socket,
  193. # if DEBUG is set than it logs via DisplayMsg
  194. # 
  195. # Arguments:
  196. # command -         ftp command
  197. #
  198.  
  199. proc ftp::PutsCtrlSock {s {command ""}} {
  200.     upvar ::ftp::ftp$s ftp
  201.     variable DEBUG
  202.     
  203.     if { $DEBUG } {
  204.         DisplayMsg $s "---> $command"
  205.     }
  206.  
  207.     puts $ftp(CtrlSock) $command
  208.     flush $ftp(CtrlSock)
  209.     return
  210. }
  211.  
  212. #############################################################################
  213. #
  214. # StateHandler --
  215. #
  216. # Implements a finite state handler and a fileevent handler
  217. # for the control channel
  218. # 
  219. # Arguments:
  220. # sock -         socket name
  221. #            If called from a procedure than this argument is empty.
  222. #             If called from a fileevent than this argument contains
  223. #            the socket channel identifier.
  224.  
  225. proc ftp::StateHandler {s {sock ""}} {
  226.     upvar ::ftp::ftp$s ftp
  227.     variable DEBUG 
  228.     variable VERBOSE
  229.  
  230.     # disable fileevent on control socket, enable it at the and of the state machine
  231.     # fileevent $ftp(CtrlSock) readable {}
  232.         
  233.     # there is no socket (and no channel to get) if called from a procedure
  234.  
  235.     set rc "   "
  236.     set msgtext {}
  237.  
  238.     if { $sock != "" } {
  239.  
  240.         set number [gets $sock bufline]
  241.  
  242.         if { $number > 0 } {
  243.  
  244.             # get return code, check for multi-line text
  245.             
  246.             regexp -- "(^\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line msgtext
  247.             set buffer $bufline
  248.             
  249.             # multi-line format detected ("-"), get all the lines
  250.             # until the real return code
  251.  
  252.             while { [string equal $multi_line "-"] } {
  253.                 set number [gets $sock bufline]    
  254.                 if { $number > 0 } {
  255.                     append buffer \n "$bufline"
  256.                     regexp -- "(^\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line
  257.                 }
  258.             }
  259.         } elseif { [eof $ftp(CtrlSock)] } {
  260.             # remote server has closed control connection
  261.             # kill control socket, unset State to disable all following command
  262.             
  263.             set rc 421
  264.             if { $VERBOSE } {
  265.                 DisplayMsg $s "C: 421 Service not available, closing control connection." control
  266.             }
  267.             set ftp(Error) "Service not available!"
  268.             CloseDataConn $s
  269.             WaitComplete $s 0
  270.         Command $ftp(Command) terminated
  271.             catch {unset ftp(State)}
  272.             catch {close $ftp(CtrlSock); unset ftp(CtrlSock)}
  273.             return
  274.         }
  275.     
  276.     } 
  277.     
  278.     if { $DEBUG } {
  279.         DisplayMsg $s "-> rc=\"$rc\"\n-> msgtext=\"$msgtext\"\n-> state=\"$ftp(State)\""
  280.     }
  281.  
  282.     # In asynchronous mode, should we move on to the next state?
  283.     set nextState 0
  284.     
  285.     # system status replay
  286.     if { [string equal $rc "211"] } {
  287.         return
  288.     }
  289.  
  290.     # use only the first digit 
  291.     regexp -- "^\[0-9\]?" $rc rc
  292.     
  293.     switch -exact -- $ftp(State) {
  294.         user { 
  295.             switch -exact -- $rc {
  296.                 2 {
  297.                     PutsCtrlSock $s "USER $ftp(User)"
  298.                     set ftp(State) passwd
  299.             Command $ftp(Command) user
  300.                 }
  301.                 default {
  302.                     set errmsg "Error connecting! $msgtext"
  303.                     set complete_with 0
  304.             Command $ftp(Command) error $errmsg
  305.                 }
  306.             }
  307.         }
  308.         passwd {
  309.             switch -exact -- $rc {
  310.                 2 {
  311.                     set complete_with 1
  312.             Command $ftp(Command) password
  313.                 }
  314.                 3 {
  315.                     PutsCtrlSock $s "PASS $ftp(Passwd)"
  316.                     set ftp(State) connect
  317.             Command $ftp(Command) password
  318.                 }
  319.                 default {
  320.                     set errmsg "Error connecting! $msgtext"
  321.                     set complete_with 0
  322.             Command $ftp(Command) error $msgtext
  323.                 }
  324.             }
  325.         }
  326.         connect {
  327.             switch -exact -- $rc {
  328.                 2 {
  329.             # The type is set after this, and we want to report
  330.             # that the connection is complete once the type is done
  331.             set nextState 1
  332.             if {[info exists ftp(NextState)] && ![llength $ftp(NextState)]} {
  333.             Command $ftp(Command) connect $s
  334.             } else {
  335.             set complete_with 1
  336.             }
  337.                 }
  338.                 default {
  339.                     set errmsg "Error connecting! $msgtext"
  340.                     set complete_with 0
  341.             Command $ftp(Command) error $msgtext
  342.                 }
  343.             }
  344.         }   
  345.     connect_last {
  346.         Command $ftp(Command) connect $s
  347.         set complete_with 1
  348.     }
  349.         quit {
  350.             PutsCtrlSock $s "QUIT"
  351.             set ftp(State) quit_sent
  352.         }
  353.         quit_sent {
  354.             switch -exact -- $rc {
  355.                 2 {
  356.                     set complete_with 1
  357.             set nextState 1
  358.             Command $ftp(Command) quit
  359.                 }
  360.                 default {
  361.                     set errmsg "Error disconnecting! $msgtext"
  362.                     set complete_with 0
  363.             Command $ftp(Command) error $msgtext
  364.                 }
  365.             }
  366.         }
  367.         quote {
  368.             PutsCtrlSock $s $ftp(Cmd)
  369.             set ftp(State) quote_sent
  370.         }
  371.         quote_sent {
  372.             set complete_with 1
  373.             set ftp(Quote) $buffer
  374.         set nextState 1
  375.         Command $ftp(Command) quote $buffer
  376.         }
  377.         type {
  378.             if { [string equal $ftp(Type) "ascii"] } {
  379.                 PutsCtrlSock $s "TYPE A"
  380.             } elseif { [string equal $ftp(Type) "binary"] } {
  381.                 PutsCtrlSock $s "TYPE I"
  382.             } else {
  383.                 PutsCtrlSock $s "TYPE L"
  384.             }
  385.             set ftp(State) type_sent
  386.         }
  387.         type_sent {
  388.             switch -exact -- $rc {
  389.                 2 {
  390.                     set complete_with 1
  391.             set nextState 1
  392.             Command $ftp(Command) type $ftp(Type)
  393.                 }
  394.                 default {
  395.                     set errmsg "Error setting type \"$ftp(Type)\"!"
  396.                     set complete_with 0
  397.             Command $ftp(Command) error "error setting type \"$ftp(Type)\""
  398.                 }
  399.             }
  400.         }
  401.     type_change {
  402.         set ftp(Type) $ftp(type:changeto)
  403.         set ftp(State) type
  404.         StateHandler $s
  405.     }
  406.         nlist_active {
  407.             if { [OpenActiveConn $s] } {
  408.                 PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)"
  409.                 set ftp(State) nlist_open
  410.             } else {
  411.                 set errmsg "Error setting port!"
  412.             }
  413.         }
  414.         nlist_passive {
  415.             PutsCtrlSock $s "PASV"
  416.             set ftp(State) nlist_open
  417.         }
  418.         nlist_open {
  419.             switch -exact -- $rc {
  420.                 1 {}
  421.         2 {
  422.                     if { [string equal $ftp(Mode) "passive"] } {
  423.                         if { ![OpenPassiveConn $s $buffer] } {
  424.                             set errmsg "Error setting PASSIVE mode!"
  425.                             set complete_with 0
  426.                 Command $ftp(Command) error "error setting passive mode"
  427.                         }
  428.                     }   
  429.                     PutsCtrlSock $s "NLST$ftp(Dir)"
  430.                     set ftp(State) list_sent
  431.                 }
  432.                 default {
  433.                     if { [string equal $ftp(Mode) "passive"] } {
  434.                         set errmsg "Error setting PASSIVE mode!"
  435.                     } else {
  436.                         set errmsg "Error setting port!"
  437.                     }  
  438.                     set complete_with 0
  439.             Command $ftp(Command) error $errmsg
  440.                 }
  441.             }
  442.         }
  443.         list_active {
  444.             if { [OpenActiveConn $s] } {
  445.                 PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)"
  446.                 set ftp(State) list_open
  447.             } else {
  448.                 set errmsg "Error setting port!"
  449.         Command $ftp(Command) error $errmsg
  450.             }
  451.         }
  452.         list_passive {
  453.             PutsCtrlSock $s "PASV"
  454.             set ftp(State) list_open
  455.         }
  456.         list_open {
  457.             switch -exact -- $rc {
  458.                 1 {}
  459.         2 {
  460.                     if { [string equal $ftp(Mode) "passive"] } {
  461.                         if { ![OpenPassiveConn $s $buffer] } {
  462.                             set errmsg "Error setting PASSIVE mode!"
  463.                             set complete_with 0
  464.                 Command $ftp(Command) error $errmsg
  465.                         }
  466.                     }   
  467.                     PutsCtrlSock $s "LIST$ftp(Dir)"
  468.                     set ftp(State) list_sent
  469.                 }
  470.                 default {
  471.                     if { [string equal $ftp(Mode) "passive"] } {
  472.                         set errmsg "Error setting PASSIVE mode!"
  473.                     } else {
  474.                         set errmsg "Error setting port!"
  475.                     }  
  476.                     set complete_with 0
  477.             Command $ftp(Command) error $errmsg
  478.                 }
  479.             }
  480.         }
  481.         list_sent {
  482.             switch -exact -- $rc {
  483.                 1 -
  484.         2 {
  485.                     set ftp(State) list_close
  486.                 }
  487.                 default {  
  488.                     if { [string equal $ftp(Mode) "passive"] } {
  489.                         unset ftp(state.data)
  490.                     }    
  491.                     set errmsg "Error getting directory listing!"
  492.                     set complete_with 0
  493.             Command $ftp(Command) error $errmsg
  494.                 }
  495.             }
  496.         }
  497.         list_close {
  498.             switch -exact -- $rc {
  499.                 1 {}
  500.         2 {
  501.             set nextState 1
  502.             if {[info exists ftp(NextState)] && ![llength $ftp(NextState)]} {
  503.             Command $ftp(Command) list [ListPostProcess $ftp(List)]
  504.             } else {
  505.             set complete_with 1
  506.             }
  507.                 }
  508.                 default {
  509.                     set errmsg "Error receiving list!"
  510.                     set complete_with 0
  511.             Command $ftp(Command) error $errmsg
  512.                 }
  513.             }
  514.         }
  515.     list_last {
  516.         Command $ftp(Command) list [ListPostProcess $ftp(List)]
  517.         set complete_with 1
  518.     }
  519.         size {
  520.             PutsCtrlSock $s "SIZE $ftp(File)"
  521.             set ftp(State) size_sent
  522.         }
  523.         size_sent {
  524.             switch -exact -- $rc {
  525.                 2 {
  526.                     regexp -- "^\[0-9\]+ (.*)$" $buffer all ftp(FileSize)
  527.                     set complete_with 1
  528.             set nextState 1
  529.             Command $ftp(Command) size $ftp(File) $ftp(FileSize)
  530.                 }
  531.                 default {
  532.                     set errmsg "Error getting file size!"
  533.                     set complete_with 0
  534.             Command $ftp(Command) error $errmsg
  535.                 }
  536.             }
  537.         } 
  538.         modtime {
  539.             PutsCtrlSock $s "MDTM $ftp(File)"
  540.             set ftp(State) modtime_sent
  541.         }  
  542.         modtime_sent {
  543.             switch -exact -- $rc {
  544.                 2 {
  545.                     regexp -- "^\[0-9\]+ (.*)$" $buffer all ftp(DateTime)
  546.                     set complete_with 1
  547.             set nextState 1
  548.             Command $ftp(Command) modtime $ftp(File) [ModTimePostProcess $ftp(DateTime)]
  549.                 }
  550.                 default {
  551.                     set errmsg "Error getting modification time!"
  552.                     set complete_with 0
  553.             Command $ftp(Command) error $errmsg
  554.                 }
  555.             }
  556.         } 
  557.         pwd {
  558.             PutsCtrlSock $s "PWD"
  559.             set ftp(State) pwd_sent
  560.         }
  561.         pwd_sent {
  562.             switch -exact -- $rc {
  563.                 2 {
  564.                     regexp -- "^.*\"(.*)\"" $buffer temp ftp(Dir)
  565.                     set complete_with 1
  566.             set nextState 1
  567.             Command $ftp(Command) pwd $ftp(Dir)
  568.                 }
  569.                 default {
  570.                     set errmsg "Error getting working dir!"
  571.                     set complete_with 0
  572.             Command $ftp(Command) error $errmsg
  573.                 }
  574.             }
  575.         }
  576.         cd {
  577.             PutsCtrlSock $s "CWD$ftp(Dir)"
  578.             set ftp(State) cd_sent
  579.         }
  580.         cd_sent {
  581.             switch -exact -- $rc {
  582.                 1 {}
  583.         2 {
  584.                     set complete_with 1
  585.             set nextState 1
  586.             Command $ftp(Command) cd $ftp(Dir)
  587.                 }
  588.                 default {
  589.                     set errmsg "Error changing directory to \"$ftp(Dir)\""
  590.                     set complete_with 0
  591.             Command $ftp(Command) error $errmsg
  592.                 }
  593.             }
  594.         }
  595.         mkdir {
  596.             PutsCtrlSock $s "MKD $ftp(Dir)"
  597.             set ftp(State) mkdir_sent
  598.         }
  599.         mkdir_sent {
  600.             switch -exact -- $rc {
  601.                 2 {
  602.                     set complete_with 1
  603.             set nextState 1
  604.             Command $ftp(Command) mkdir $ftp(Dir)
  605.                 }
  606.                 default {
  607.                     set errmsg "Error making dir \"$ftp(Dir)\"!"
  608.                     set complete_with 0
  609.             Command $ftp(Command) error $errmsg
  610.                 }
  611.             }
  612.         }
  613.         rmdir {
  614.             PutsCtrlSock $s "RMD $ftp(Dir)"
  615.             set ftp(State) rmdir_sent
  616.         }
  617.         rmdir_sent {
  618.             switch -exact -- $rc {
  619.                 2 {
  620.                     set complete_with 1
  621.             set nextState 1
  622.             Command $ftp(Command) rmdir $ftp(Dir)
  623.                 }
  624.                 default {
  625.                     set errmsg "Error removing directory!"
  626.                     set complete_with 0
  627.             Command $ftp(Command) error $errmsg
  628.                 }
  629.             }
  630.         }
  631.         delete {
  632.             PutsCtrlSock $s "DELE $ftp(File)"
  633.             set ftp(State) delete_sent
  634.         }
  635.         delete_sent {
  636.             switch -exact -- $rc {
  637.                 2 {
  638.                     set complete_with 1
  639.             set nextState 1
  640.             Command $ftp(Command) delete $ftp(File)
  641.                 }
  642.                 default {
  643.                     set errmsg "Error deleting file \"$ftp(File)\"!"
  644.                     set complete_with 0
  645.             Command $ftp(Command) error $errmsg
  646.                 }
  647.             }
  648.         }
  649.         rename {
  650.             PutsCtrlSock $s "RNFR $ftp(RenameFrom)"
  651.             set ftp(State) rename_to
  652.         }
  653.         rename_to {
  654.             switch -exact -- $rc {
  655.                 3 {
  656.                     PutsCtrlSock $s "RNTO $ftp(RenameTo)"
  657.                     set ftp(State) rename_sent
  658.                 }
  659.                 default {
  660.                     set errmsg "Error renaming file \"$ftp(RenameFrom)\"!"
  661.                     set complete_with 0
  662.             Command $ftp(Command) error $errmsg
  663.                 }
  664.             }
  665.         }
  666.         rename_sent {
  667.             switch -exact -- $rc {
  668.                 2 {
  669.                     set complete_with 1
  670.             set nextState 1
  671.             Command $ftp(Command) rename $ftp(RenameFrom) $ftp(RenameTo)
  672.                 }
  673.                 default {
  674.                     set errmsg "Error renaming file \"$ftp(RenameFrom)\"!"
  675.                     set complete_with 0
  676.             Command $ftp(Command) error $errmsg
  677.                 }
  678.             }
  679.         }
  680.         put_active {
  681.             if { [OpenActiveConn $s] } {
  682.                 PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)"
  683.                 set ftp(State) put_open
  684.             } else {
  685.                 set errmsg "Error setting port!"
  686.         Command $ftp(Command) error $errmsg
  687.             }
  688.         }
  689.         put_passive {
  690.             PutsCtrlSock $s "PASV"
  691.             set ftp(State) put_open
  692.         }
  693.         put_open {
  694.             switch -exact -- $rc {
  695.                 1 -
  696.         2 {
  697.                     if { [string equal $ftp(Mode) "passive"] } {
  698.                         if { ![OpenPassiveConn $s $buffer] } {
  699.                             set errmsg "Error setting PASSIVE mode!"
  700.                             set complete_with 0
  701.                 Command $ftp(Command) error $errmsg
  702.                         }
  703.                     } 
  704.                     PutsCtrlSock $s "STOR $ftp(RemoteFilename)"
  705.                     set ftp(State) put_sent
  706.                 }
  707.                 default {
  708.                     if { [string equal $ftp(Mode) "passive"] } {
  709.                         set errmsg "Error setting PASSIVE mode!"
  710.                     } else {
  711.                         set errmsg "Error setting port!"
  712.                     }  
  713.                     set complete_with 0
  714.             Command $ftp(Command) error $errmsg
  715.                 }
  716.             }
  717.         }
  718.         put_sent {
  719.             switch -exact -- $rc {
  720.                 1 -
  721.         2 {
  722.                     set ftp(State) put_close
  723.                 }
  724.                 default {
  725.                     if { [string equal $ftp(Mode) "passive"] } {
  726.                         # close already opened DataConnection
  727.                         unset ftp(state.data)
  728.                     }  
  729.                     set errmsg "Error opening connection!"
  730.                     set complete_with 0
  731.             Command $ftp(Command) error $errmsg
  732.                 }
  733.             }
  734.         }
  735.         put_close {
  736.             switch -exact -- $rc {
  737.         1 {
  738.             # Keep going
  739.             return
  740.         }
  741.                 2 {
  742.                     set complete_with 1
  743.             set nextState 1
  744.             Command $ftp(Command) put $ftp(RemoteFilename)
  745.                 }
  746.                 default {
  747.             DisplayMsg $s "rc = $rc msgtext = \"$msgtext\""
  748.                     set errmsg "Error storing file \"$ftp(RemoteFilename)\" due to \"$msgtext\""
  749.                     set complete_with 0
  750.             Command $ftp(Command) error $errmsg
  751.                 }
  752.             }
  753.         }
  754.         append_active {
  755.             if { [OpenActiveConn $s] } {
  756.                 PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)"
  757.                 set ftp(State) append_open
  758.             } else {
  759.                 set errmsg "Error setting port!"
  760.         Command $ftp(Command) error $errmsg
  761.             }
  762.         }
  763.         append_passive {
  764.             PutsCtrlSock $s "PASV"
  765.             set ftp(State) append_open
  766.         }
  767.         append_open {
  768.             switch -exact -- $rc {
  769.         1 -
  770.                 2 {
  771.                     if { [string equal $ftp(Mode) "passive"] } {
  772.                         if { ![OpenPassiveConn $s $buffer] } {
  773.                             set errmsg "Error setting PASSIVE mode!"
  774.                             set complete_with 0
  775.                 Command $ftp(Command) error $errmsg
  776.                         }
  777.                     }   
  778.                     PutsCtrlSock $s "APPE $ftp(RemoteFilename)"
  779.                     set ftp(State) append_sent
  780.                 }
  781.                 default {
  782.                     if { [string equal $ftp(Mode) "passive"] } {
  783.                         set errmsg "Error setting PASSIVE mode!"
  784.                     } else {
  785.                         set errmsg "Error setting port!"
  786.                     }  
  787.                     set complete_with 0
  788.             Command $ftp(Command) error $errmsg
  789.                 }
  790.             }
  791.         }
  792.         append_sent {
  793.             switch -exact -- $rc {
  794.                 1 {
  795.                     set ftp(State) append_close
  796.                 }
  797.                 default {
  798.                     if { [string equal $ftp(Mode) "passive"] } {
  799.                         # close already opened DataConnection
  800.                         unset ftp(state.data)
  801.                     }  
  802.                     set errmsg "Error opening connection!"
  803.                     set complete_with 0
  804.             Command $ftp(Command) error $errmsg
  805.                 }
  806.             }
  807.         }
  808.         append_close {
  809.             switch -exact -- $rc {
  810.                 2 {
  811.                     set complete_with 1
  812.             set nextState 1
  813.             Command $ftp(Command) append $ftp(RemoteFilename)
  814.                 }
  815.                 default {
  816.                     set errmsg "Error storing file \"$ftp(RemoteFilename)\"!"
  817.                     set complete_with 0
  818.             Command $ftp(Command) error $errmsg
  819.                 }
  820.             }
  821.         }
  822.         reget_active {
  823.             if { [OpenActiveConn $s] } {
  824.                 PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)"
  825.                 set ftp(State) reget_restart
  826.             } else {
  827.                 set errmsg "Error setting port!"
  828.         Command $ftp(Command) error $errmsg
  829.             }
  830.         }
  831.         reget_passive {
  832.             PutsCtrlSock $s "PASV"
  833.             set ftp(State) reget_restart
  834.         }
  835.         reget_restart {
  836.             switch -exact -- $rc {
  837.                 2 { 
  838.                     if { [string equal $ftp(Mode) "passive"] } {
  839.                         if { ![OpenPassiveConn $s $buffer] } {
  840.                             set errmsg "Error setting PASSIVE mode!"
  841.                             set complete_with 0
  842.                 Command $ftp(Command) error $errmsg
  843.                         }
  844.                     }   
  845.                     if { $ftp(FileSize) != 0 } {
  846.                         PutsCtrlSock $s "REST $ftp(FileSize)"
  847.                         set ftp(State) reget_open
  848.                     } else {
  849.                         PutsCtrlSock $s "RETR $ftp(RemoteFilename)"
  850.                         set ftp(State) reget_sent
  851.                     } 
  852.                 }
  853.                 default {
  854.                     set errmsg "Error restarting filetransfer of \"$ftp(RemoteFilename)\"!"
  855.                     set complete_with 0
  856.             Command $ftp(Command) error $errmsg
  857.                 }
  858.             }
  859.         }
  860.         reget_open {
  861.             switch -exact -- $rc {
  862.                 2 -
  863.                 3 {
  864.                     PutsCtrlSock $s "RETR $ftp(RemoteFilename)"
  865.                     set ftp(State) reget_sent
  866.                 }
  867.                 default {
  868.                     if { [string equal $ftp(Mode) "passive"] } {
  869.                         set errmsg "Error setting PASSIVE mode!"
  870.                     } else {
  871.                         set errmsg "Error setting port!"
  872.                     }  
  873.                     set complete_with 0
  874.             Command $ftp(Command) error $errmsg
  875.                 }
  876.             }
  877.         }
  878.         reget_sent {
  879.             switch -exact -- $rc {
  880.                 1 {
  881.                     set ftp(State) reget_close
  882.                 }
  883.                 default {
  884.                     if { [string equal $ftp(Mode) "passive"] } {
  885.                         # close already opened DataConnection
  886.                         unset ftp(state.data)
  887.                     }  
  888.                     set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!"
  889.                     set complete_with 0
  890.             Command $ftp(Command) error $errmsg
  891.                 }
  892.             }
  893.         }
  894.         reget_close {
  895.             switch -exact -- $rc {
  896.                 2 {
  897.                     set complete_with 1
  898.             set nextState 1
  899.             Command $ftp(Command) get $ftp(RemoteFilename)
  900.                 }
  901.                 default {
  902.                     set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!"
  903.                     set complete_with 0
  904.             Command $ftp(Command) error $errmsg
  905.                 }
  906.             }
  907.         }
  908.         get_active {
  909.             if { [OpenActiveConn $s] } {
  910.                 PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)"
  911.                 set ftp(State) get_open
  912.             } else {
  913.                 set errmsg "Error setting port!"
  914.         Command $ftp(Command) error $errmsg
  915.             }
  916.         } 
  917.         get_passive {
  918.             PutsCtrlSock $s "PASV"
  919.             set ftp(State) get_open
  920.         }
  921.         get_open {
  922.             switch -exact -- $rc {
  923.                 1 -
  924.         2 -
  925.                 3 {
  926.                     if { [string equal $ftp(Mode) "passive"] } {
  927.                         if { ![OpenPassiveConn $s $buffer] } {
  928.                             set errmsg "Error setting PASSIVE mode!"
  929.                             set complete_with 0
  930.                 Command $ftp(Command) error $errmsg
  931.                         }
  932.                     }   
  933.                     PutsCtrlSock $s "RETR $ftp(RemoteFilename)"
  934.                     set ftp(State) get_sent
  935.                 }
  936.                 default {
  937.                     if { [string equal $ftp(Mode) "passive"] } {
  938.                         set errmsg "Error setting PASSIVE mode!"
  939.                     } else {
  940.                         set errmsg "Error setting port!"
  941.                     }  
  942.                     set complete_with 0
  943.             Command $ftp(Command) error $errmsg
  944.                 }
  945.             }
  946.         }
  947.         get_sent {
  948.             switch -exact -- $rc {
  949.                 1 {
  950.                     set ftp(State) get_close
  951.                 }
  952.                 default {
  953.                     if { [string equal $ftp(Mode) "passive"] } {
  954.                         # close already opened DataConnection
  955.                         unset ftp(state.data)
  956.                     }  
  957.                     set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!"
  958.                     set complete_with 0
  959.             Command $ftp(Command) error $errmsg
  960.                 }
  961.             }
  962.         }
  963.         get_close {
  964.             switch -exact -- $rc {
  965.                 2 {
  966.                     set complete_with 1
  967.             set nextState 1
  968.             if {$ftp(inline)} {
  969.             upvar #0 $ftp(get:varname) returnData
  970.             set returnData $ftp(GetData)
  971.             Command $ftp(Command) get $ftp(GetData)
  972.             } else {
  973.             Command $ftp(Command) get $ftp(RemoteFilename)
  974.             }
  975.                 }
  976.                 default {
  977.                     set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!"
  978.                     set complete_with 0
  979.             Command $ftp(Command) error $errmsg
  980.                 }
  981.             }
  982.         }
  983.     default {
  984.         error "Unknown state \"$ftp(State)\""
  985.     }
  986.     }
  987.  
  988.     # finish waiting 
  989.     if { [info exists complete_with] } {
  990.         WaitComplete $s $complete_with
  991.     }
  992.  
  993.     # display control channel message
  994.     if { [info exists buffer] } {
  995.         if { $VERBOSE } {
  996.             foreach line [split $buffer \n] {
  997.                 DisplayMsg $s "C: $line" control
  998.             }
  999.         }
  1000.     }
  1001.     
  1002.     # Rather than throwing an error in the event loop, set the ftp(Error)
  1003.     # variable to hold the message so that it can later be thrown after the
  1004.     # the StateHandler has completed.
  1005.  
  1006.     if { [info exists errmsg] } {
  1007.         set ftp(Error) $errmsg
  1008.     }
  1009.  
  1010.     # If operating asynchronously, commence next state
  1011.     if {$nextState && [info exists ftp(NextState)] && [llength $ftp(NextState)]} {
  1012.     # Pop the head of the NextState queue
  1013.     set ftp(State) [lindex $ftp(NextState) 0]
  1014.     set ftp(NextState) [lreplace $ftp(NextState) 0 0]
  1015.     StateHandler $s
  1016.     }
  1017.  
  1018.     # enable fileevent on control socket again
  1019.     #fileevent $ftp(CtrlSock) readable [list ::ftp::StateHandler $ftp(CtrlSock)]
  1020.  
  1021. }
  1022.  
  1023. #############################################################################
  1024. #
  1025. # Type --
  1026. #
  1027. # REPRESENTATION TYPE - Sets the file transfer type to ascii or binary.
  1028. # (exported)
  1029. #
  1030. # Arguments:
  1031. # type -         specifies the representation type (ascii|binary)
  1032. # 
  1033. # Returns:
  1034. # type    -        returns the current type or {} if an error occurs
  1035.  
  1036. proc ftp::Type {s {type ""}} {
  1037.     upvar ::ftp::ftp$s ftp
  1038.  
  1039.     if { ![info exists ftp(State)] } {
  1040.         if { ![string is digit -strict $s] } {
  1041.             DisplayMsg $s "Bad connection name \"$s\"" error
  1042.         } else {
  1043.             DisplayMsg $s "Not connected!" error
  1044.         }
  1045.         return {}
  1046.     }
  1047.  
  1048.     # return current type
  1049.     if { $type == "" } {
  1050.         return $ftp(Type)
  1051.     }
  1052.  
  1053.     # save current type
  1054.     set old_type $ftp(Type) 
  1055.     
  1056.     set ftp(Type) $type
  1057.     set ftp(State) type
  1058.     StateHandler $s
  1059.     
  1060.     # wait for synchronization
  1061.     set rc [WaitOrTimeout $s]
  1062.     if { $rc } {
  1063.         return $ftp(Type)
  1064.     } else {
  1065.         # restore old type
  1066.         set ftp(Type) $old_type
  1067.         return {}
  1068.     }
  1069. }
  1070.  
  1071. #############################################################################
  1072. #
  1073. # NList --
  1074. #
  1075. # NAME LIST - This command causes a directory listing to be sent from
  1076. # server to user site.
  1077. # (exported)
  1078. # 
  1079. # Arguments:
  1080. # dir -         The $dir should specify a directory or other system 
  1081. #            specific file group descriptor; a null argument 
  1082. #            implies the current directory. 
  1083. #
  1084. # Arguments:
  1085. # dir -         directory to list 
  1086. # 
  1087. # Returns:
  1088. # sorted list of files or {} if listing fails
  1089.  
  1090. proc ftp::NList {s { dir ""}} {
  1091.     upvar ::ftp::ftp$s ftp
  1092.  
  1093.     if { ![info exists ftp(State)] } {
  1094.         if { ![string is digit -strict $s] } {
  1095.             DisplayMsg $s "Bad connection name \"$s\"" error
  1096.         } else {
  1097.             DisplayMsg $s "Not connected!" error
  1098.         }
  1099.         return {}
  1100.     }
  1101.  
  1102.     set ftp(List) {}
  1103.     if { $dir == "" } {
  1104.         set ftp(Dir) ""
  1105.     } else {
  1106.         set ftp(Dir) " $dir"
  1107.     }
  1108.  
  1109.     # save current type and force ascii mode
  1110.     set old_type $ftp(Type)
  1111.     if { $ftp(Type) != "ascii" } {
  1112.     if {[string length $ftp(Command)]} {
  1113.         set ftp(NextState) [list nlist_$ftp(Mode) type_change list_last]
  1114.         set ftp(type:changeto) $old_type
  1115.         Type $s ascii
  1116.         return {}
  1117.     }
  1118.         Type $s ascii
  1119.     }
  1120.  
  1121.     set ftp(State) nlist_$ftp(Mode)
  1122.     StateHandler $s
  1123.  
  1124.     # wait for synchronization
  1125.     set rc [WaitOrTimeout $s]
  1126.  
  1127.     # restore old type
  1128.     if { [Type $s] != $old_type } {
  1129.         Type $s $old_type
  1130.     }
  1131.  
  1132.     unset ftp(Dir)
  1133.     if { $rc } { 
  1134.         return [lsort $ftp(List)]
  1135.     } else {
  1136.         CloseDataConn $s
  1137.         return {}
  1138.     }
  1139. }
  1140.  
  1141. #############################################################################
  1142. #
  1143. # List --
  1144. #
  1145. # LIST - This command causes a list to be sent from the server
  1146. # to user site.
  1147. # (exported)
  1148. # 
  1149. # Arguments:
  1150. # dir -         If the $dir specifies a directory or other group of 
  1151. #            files, the server should transfer a list of files in 
  1152. #            the specified directory. If the $dir specifies a file
  1153. #            then the server should send current information on the
  1154. #             file.  A null argument implies the user's current 
  1155. #            working or default directory.  
  1156. # 
  1157. # Returns:
  1158. # list of files or {} if listing fails
  1159.  
  1160. proc ftp::List {s {dir ""}} {
  1161.  
  1162.     upvar ::ftp::ftp$s ftp
  1163.  
  1164.     if { ![info exists ftp(State)] } {
  1165.         if { ![string is digit -strict $s] } {
  1166.             DisplayMsg $s "Bad connection name \"$s\"" error
  1167.         } else {
  1168.             DisplayMsg $s "Not connected!" error
  1169.         }
  1170.         return {}
  1171.     }
  1172.  
  1173.     set ftp(List) {}
  1174.     if { $dir == "" } {
  1175.         set ftp(Dir) ""
  1176.     } else {
  1177.         set ftp(Dir) " $dir"
  1178.     }
  1179.  
  1180.     # save current type and force ascii mode
  1181.  
  1182.     set old_type $ftp(Type)
  1183.     if { ![string equal "$ftp(Type)" "ascii"] } {
  1184.     if {[string length $ftp(Command)]} {
  1185.         set ftp(NextState) [list list_$ftp(Mode) type_change list_last]
  1186.         set ftp(type:changeto) $old_type
  1187.         Type $s ascii
  1188.         return {}
  1189.     }
  1190.         Type $s ascii
  1191.     }
  1192.  
  1193.     set ftp(State) list_$ftp(Mode)
  1194.     StateHandler $s
  1195.  
  1196.     # wait for synchronization
  1197.  
  1198.     set rc [WaitOrTimeout $s]
  1199.  
  1200.     # restore old type
  1201.  
  1202.     if { ![string equal "[Type $s]" "$old_type"] } {
  1203.         Type $s $old_type
  1204.     }
  1205.  
  1206.     unset ftp(Dir)
  1207.     if { $rc } { 
  1208.     return [ListPostProcess $ftp(List)]
  1209.     } else {
  1210.         CloseDataConn $s
  1211.         return {}
  1212.     }
  1213. }
  1214.  
  1215. proc ftp::ListPostProcess l {
  1216.  
  1217.     # clear "total"-line
  1218.  
  1219.     set l [split $l "\n"]
  1220.     set index [lsearch -regexp $l "^total"]
  1221.     if { $index != "-1" } { 
  1222.     set l [lreplace $l $index $index]
  1223.     }
  1224.  
  1225.     # clear blank line
  1226.  
  1227.     set index [lsearch -regexp $l "^$"]
  1228.     if { $index != "-1" } { 
  1229.     set l [lreplace $l $index $index]
  1230.     }
  1231.  
  1232.     return $l
  1233. }
  1234.  
  1235. #############################################################################
  1236. #
  1237. # FileSize --
  1238. #
  1239. # REMOTE FILE SIZE - This command gets the file size of the
  1240. # file on the remote machine. 
  1241. # ATTENTION! Doesn't work properly in ascii mode!
  1242. # (exported)
  1243. # 
  1244. # Arguments:
  1245. # filename -         specifies the remote file name
  1246. # 
  1247. # Returns:
  1248. # size -        files size in bytes or {} in error cases
  1249.  
  1250. proc ftp::FileSize {s {filename ""}} {
  1251.     upvar ::ftp::ftp$s ftp
  1252.  
  1253.     if { ![info exists ftp(State)] } {
  1254.         if { ![string is digit -strict $s] } {
  1255.             DisplayMsg $s "Bad connection name \"$s\"" error
  1256.         } else {
  1257.             DisplayMsg $s "Not connected!" error
  1258.         }
  1259.         return {}
  1260.     }
  1261.     
  1262.     if { $filename == "" } {
  1263.         return {}
  1264.     } 
  1265.  
  1266.     set ftp(File) $filename
  1267.     set ftp(FileSize) 0
  1268.     
  1269.     set ftp(State) size
  1270.     StateHandler $s
  1271.  
  1272.     # wait for synchronization
  1273.     set rc [WaitOrTimeout $s]
  1274.     
  1275.     if {![string length $ftp(Command)]} {
  1276.     unset ftp(File)
  1277.     }
  1278.         
  1279.     if { $rc } {
  1280.         return $ftp(FileSize)
  1281.     } else {
  1282.         return {}
  1283.     }
  1284. }
  1285.  
  1286.  
  1287. #############################################################################
  1288. #
  1289. # ModTime --
  1290. #
  1291. # MODIFICATION TIME - This command gets the last modification time of the
  1292. # file on the remote machine.
  1293. # (exported)
  1294. # 
  1295. # Arguments:
  1296. # filename -         specifies the remote file name
  1297. # 
  1298. # Returns:
  1299. # clock -        files date and time as a system-depentend integer
  1300. #            value in seconds (see tcls clock command) or {} in 
  1301. #            error cases
  1302.  
  1303. proc ftp::ModTime {s {filename ""}} {
  1304.     upvar ::ftp::ftp$s ftp
  1305.  
  1306.     if { ![info exists ftp(State)] } {
  1307.         if { ![string is digit -strict $s] } {
  1308.             DisplayMsg $s "Bad connection name \"$s\"" error
  1309.         } else {
  1310.             DisplayMsg $s "Not connected!" error
  1311.         } 
  1312.         return {}
  1313.     }
  1314.     
  1315.     if { $filename == "" } {
  1316.         return {}
  1317.     } 
  1318.  
  1319.     set ftp(File) $filename
  1320.     set ftp(DateTime) ""
  1321.     
  1322.     set ftp(State) modtime
  1323.     StateHandler $s
  1324.  
  1325.     # wait for synchronization
  1326.     set rc [WaitOrTimeout $s]
  1327.     
  1328.     if {![string length $ftp(Command)]} {
  1329.     unset ftp(File)
  1330.     }
  1331.         
  1332.     if { ![string length $ftp(Command)] && $rc } {
  1333.         return [ModTimePostProcess $ftp(DateTime)]
  1334.     } else {
  1335.         return {}
  1336.     }
  1337. }
  1338.  
  1339. proc ftp::ModTimePostProcess clock {
  1340.     foreach {year month day hour min sec} {1 1 1 1 1 1} break
  1341.     scan $clock "%4s%2s%2s%2s%2s%2s" year month day hour min sec
  1342.     set clock [clock scan "$month/$day/$year $hour:$min:$sec" -gmt 1]
  1343.     return $clock
  1344. }
  1345.  
  1346. #############################################################################
  1347. #
  1348. # Pwd --
  1349. #
  1350. # PRINT WORKING DIRECTORY - Causes the name of the current working directory.
  1351. # (exported)
  1352. # 
  1353. # Arguments:
  1354. # None.
  1355. # 
  1356. # Returns:
  1357. # current directory name
  1358.  
  1359. proc ftp::Pwd {s } {
  1360.     upvar ::ftp::ftp$s ftp
  1361.  
  1362.     if { ![info exists ftp(State)] } {
  1363.         if { ![string is digit -strict $s] } {
  1364.             DisplayMsg $s "Bad connection name \"$s\"" error
  1365.         } else {
  1366.             DisplayMsg $s "Not connected!" error
  1367.         }
  1368.         return {}
  1369.     }
  1370.  
  1371.     set ftp(Dir) {}
  1372.  
  1373.     set ftp(State) pwd
  1374.     StateHandler $s
  1375.  
  1376.     # wait for synchronization
  1377.     set rc [WaitOrTimeout $s]
  1378.     
  1379.     if { $rc } {
  1380.         return $ftp(Dir)
  1381.     } else {
  1382.         return {}
  1383.     }
  1384. }
  1385.  
  1386. #############################################################################
  1387. #
  1388. # Cd --
  1389. #   
  1390. # CHANGE DIRECTORY - Sets the working directory on the server host.
  1391. # (exported)
  1392. # 
  1393. # Arguments:
  1394. # dir -            pathname specifying a directory
  1395. #
  1396. # Returns:
  1397. # 0 -            ERROR
  1398. # 1 -             OK
  1399.  
  1400. proc ftp::Cd {s {dir ""}} {
  1401.     upvar ::ftp::ftp$s ftp
  1402.  
  1403.     if { ![info exists ftp(State)] } {
  1404.         if { ![string is digit -strict $s] } {
  1405.             DisplayMsg $s "Bad connection name \"$s\"" error
  1406.         } else {
  1407.             DisplayMsg $s "Not connected!" error
  1408.         }
  1409.         return 0
  1410.     }
  1411.  
  1412.     if { $dir == "" } {
  1413.         set ftp(Dir) ""
  1414.     } else {
  1415.         set ftp(Dir) " $dir"
  1416.     }
  1417.  
  1418.     set ftp(State) cd
  1419.     StateHandler $s
  1420.  
  1421.     # wait for synchronization
  1422.     set rc [WaitOrTimeout $s] 
  1423.  
  1424.     if {![string length $ftp(Command)]} {
  1425.     unset ftp(Dir)
  1426.     }
  1427.     
  1428.     if { $rc } {
  1429.         return 1
  1430.     } else {
  1431.         return 0
  1432.     }
  1433. }
  1434.  
  1435. #############################################################################
  1436. #
  1437. # MkDir --
  1438. #
  1439. # MAKE DIRECTORY - This command causes the directory specified in the $dir
  1440. # to be created as a directory (if the $dir is absolute) or as a subdirectory
  1441. # of the current working directory (if the $dir is relative).
  1442. # (exported)
  1443. # 
  1444. # Arguments:
  1445. # dir -            new directory name
  1446. #
  1447. # Returns:
  1448. # 0 -            ERROR
  1449. # 1 -             OK
  1450.  
  1451. proc ftp::MkDir {s dir} {
  1452.     upvar ::ftp::ftp$s ftp
  1453.  
  1454.     if { ![info exists ftp(State)] } {
  1455.         DisplayMsg $s "Not connected!" error
  1456.         return 0
  1457.     }
  1458.  
  1459.     set ftp(Dir) $dir
  1460.  
  1461.     set ftp(State) mkdir
  1462.     StateHandler $s
  1463.  
  1464.     # wait for synchronization
  1465.     set rc [WaitOrTimeout $s] 
  1466.  
  1467.     if {![string length $ftp(Command)]} {
  1468.     unset ftp(Dir)
  1469.     }
  1470.     
  1471.     if { $rc } {
  1472.         return 1
  1473.     } else {
  1474.         return 0
  1475.     }
  1476. }
  1477.  
  1478. #############################################################################
  1479. #
  1480. # RmDir --
  1481. #
  1482. # REMOVE DIRECTORY - This command causes the directory specified in $dir to 
  1483. # be removed as a directory (if the $dir is absolute) or as a 
  1484. # subdirectory of the current working directory (if the $dir is relative).
  1485. # (exported)
  1486. #
  1487. # Arguments:
  1488. # dir -            directory name
  1489. #
  1490. # Returns:
  1491. # 0 -            ERROR
  1492. # 1 -             OK
  1493.  
  1494. proc ftp::RmDir {s dir} {
  1495.     upvar ::ftp::ftp$s ftp
  1496.  
  1497.     if { ![info exists ftp(State)] } {
  1498.         DisplayMsg $s "Not connected!" error
  1499.         return 0
  1500.     }
  1501.  
  1502.     set ftp(Dir) $dir
  1503.  
  1504.     set ftp(State) rmdir
  1505.     StateHandler $s
  1506.  
  1507.     # wait for synchronization
  1508.     set rc [WaitOrTimeout $s] 
  1509.  
  1510.     if {![string length $ftp(Command)]} {
  1511.     unset ftp(Dir)
  1512.     }
  1513.     
  1514.     if { $rc } {
  1515.         return 1
  1516.     } else {
  1517.         return 0
  1518.     }
  1519. }
  1520.  
  1521. #############################################################################
  1522. #
  1523. # Delete --
  1524. #
  1525. # DELETE - This command causes the file specified in $file to be deleted at 
  1526. # the server site.
  1527. # (exported)
  1528. # 
  1529. # Arguments:
  1530. # file -            file name
  1531. #
  1532. # Returns:
  1533. # 0 -            ERROR
  1534. # 1 -             OK
  1535.  
  1536. proc ftp::Delete {s file} {
  1537.     upvar ::ftp::ftp$s ftp
  1538.  
  1539.     if { ![info exists ftp(State)] } {
  1540.         DisplayMsg $s "Not connected!" error
  1541.         return 0
  1542.     }
  1543.  
  1544.     set ftp(File) $file
  1545.  
  1546.     set ftp(State) delete
  1547.     StateHandler $s
  1548.  
  1549.     # wait for synchronization
  1550.     set rc [WaitOrTimeout $s] 
  1551.  
  1552.     if {![string length $ftp(Command)]} {
  1553.     unset ftp(File)
  1554.     }
  1555.     
  1556.     if { $rc } {
  1557.         return 1
  1558.     } else {
  1559.         return 0
  1560.     }
  1561. }
  1562.  
  1563. #############################################################################
  1564. #
  1565. # Rename --
  1566. #
  1567. # RENAME FROM TO - This command causes the file specified in $from to be 
  1568. # renamed at the server site.
  1569. # (exported)
  1570. # 
  1571. # Arguments:
  1572. # from -            specifies the old file name of the file which 
  1573. #                is to be renamed
  1574. # to -                specifies the new file name of the file 
  1575. #                specified in the $from agument
  1576. # Returns:
  1577. # 0 -            ERROR
  1578. # 1 -             OK
  1579.  
  1580. proc ftp::Rename {s from to} {
  1581.     upvar ::ftp::ftp$s ftp
  1582.  
  1583.     if { ![info exists ftp(State)] } {
  1584.         DisplayMsg $s "Not connected!" error
  1585.         return 0
  1586.     }
  1587.  
  1588.     set ftp(RenameFrom) $from
  1589.     set ftp(RenameTo) $to
  1590.  
  1591.     set ftp(State) rename
  1592.  
  1593.     StateHandler $s
  1594.  
  1595.     # wait for synchronization
  1596.     set rc [WaitOrTimeout $s] 
  1597.  
  1598.     if {![string length $ftp(Command)]} {
  1599.     unset ftp(RenameFrom)
  1600.     unset ftp(RenameTo)
  1601.     }
  1602.     
  1603.     if { $rc } {
  1604.         return 1
  1605.     } else {
  1606.         return 0
  1607.     }
  1608. }
  1609.  
  1610. #############################################################################
  1611. #
  1612. # ElapsedTime --
  1613. #
  1614. # Gets the elapsed time for file transfer
  1615. # 
  1616. # Arguments:
  1617. # stop_time -         ending time
  1618.  
  1619. proc ftp::ElapsedTime {s stop_time} {
  1620.     upvar ::ftp::ftp$s ftp
  1621.  
  1622.     set elapsed [expr {$stop_time - $ftp(Start_Time)}]
  1623.     if { $elapsed == 0 } {
  1624.         set elapsed 1
  1625.     }
  1626.     set persec [expr {$ftp(Total) / $elapsed}]
  1627.     DisplayMsg $s "$ftp(Total) bytes sent in $elapsed seconds ($persec Bytes/s)"
  1628.     return
  1629. }
  1630.  
  1631. #############################################################################
  1632. #
  1633. # PUT --
  1634. #
  1635. # STORE DATA - Causes the server to accept the data transferred via the data 
  1636. # connection and to store the data as a file at the server site.  If the file
  1637. # exists at the server site, then its contents shall be replaced by the data
  1638. # being transferred.  A new file is created at the server site if the file
  1639. # does not already exist.
  1640. # (exported)
  1641. #
  1642. # Arguments:
  1643. # source -            local file name
  1644. # dest -            remote file name, if unspecified, ftp assigns
  1645. #                the local file name.
  1646. # Returns:
  1647. # 0 -            file not stored
  1648. # 1 -             OK
  1649.  
  1650. proc ftp::Put {s args} {
  1651.     upvar ::ftp::ftp$s ftp
  1652.  
  1653.     if { ![info exists ftp(State)] } {
  1654.         DisplayMsg $s "Not connected!" error
  1655.         return 0
  1656.     }
  1657.     if {([llength $args] < 1) || ([llength $args] > 4)} {
  1658.         DisplayMsg $s "wrong # args: should be \"ftp::Put handle (-data \"data\" | localFilename) remoteFilename\"" error
  1659.     return 0    
  1660.     }
  1661.  
  1662.     set ftp(inline) 0
  1663.     set flags 1
  1664.     set source ""
  1665.     set dest ""
  1666.     foreach arg $args {
  1667.         if {[string equal $arg "--"]} {
  1668.             set flags 0
  1669.         } elseif {($flags) && ([string equal $arg "-data"])} {
  1670.             set ftp(inline) 1
  1671.             set ftp(filebuffer) ""
  1672.     } elseif {$source == ""} {
  1673.             set source $arg
  1674.     } elseif {$dest == ""} {
  1675.             set dest $arg
  1676.     } else {
  1677.             DisplayMsg $s "wrong # args: should be \"ftp::Put handle (-data \"data\" | localFilename) remoteFilename\"" error
  1678.         return 0
  1679.         }
  1680.     }
  1681.  
  1682.     if {($source == "")} {
  1683.         DisplayMsg $s "Must specify a valid file to Put" error
  1684.         return 0
  1685.     }        
  1686.  
  1687.     set ftp(RemoteFilename) $dest
  1688.  
  1689.     if {$ftp(inline)} {
  1690.         set ftp(PutData) $source
  1691.         if { $dest == "" } {
  1692.             set dest ftp.tmp
  1693.         }
  1694.         set ftp(RemoteFilename) $dest
  1695.     } else {
  1696.         set ftp(PutData) ""
  1697.         if { ![file exists $source] } {
  1698.             DisplayMsg $s "File \"$source\" not exist" error
  1699.             return 0
  1700.         }
  1701.         if { $dest == "" } {
  1702.             set dest [file tail $source]
  1703.         }
  1704.         set ftp(LocalFilename) $source
  1705.         set ftp(RemoteFilename) $dest
  1706.  
  1707.     # TODO: read from source file asynchronously
  1708.         set ftp(SourceCI) [open $ftp(LocalFilename) r]
  1709.         if { [string equal $ftp(Type) "ascii"] } {
  1710.             fconfigure $ftp(SourceCI) -buffering line -blocking 1
  1711.         } else {
  1712.             fconfigure $ftp(SourceCI) -buffering line -translation binary -blocking 1
  1713.         }
  1714.     }
  1715.  
  1716.     set ftp(State) put_$ftp(Mode)
  1717.     StateHandler $s
  1718.  
  1719.     # wait for synchronization
  1720.     set rc [WaitOrTimeout $s]
  1721.     if { $rc } {
  1722.     if {![string length $ftp(Command)]} {
  1723.         ElapsedTime $s [clock seconds]
  1724.     }
  1725.         return 1
  1726.     } else {
  1727.         CloseDataConn $s
  1728.         return 0
  1729.     }
  1730. }
  1731.  
  1732. #############################################################################
  1733. #
  1734. # APPEND --
  1735. #
  1736. # APPEND DATA - Causes the server to accept the data transferred via the data 
  1737. # connection and to store the data as a file at the server site.  If the file
  1738. # exists at the server site, then the data shall be appended to that file; 
  1739. # otherwise the file specified in the pathname shall be created at the
  1740. # server site.
  1741. # (exported)
  1742. #
  1743. # Arguments:
  1744. # source -            local file name
  1745. # dest -            remote file name, if unspecified, ftp assigns
  1746. #                the local file name.
  1747. # Returns:
  1748. # 0 -            file not stored
  1749. # 1 -             OK
  1750.  
  1751. proc ftp::Append {s args} {
  1752.     upvar ::ftp::ftp$s ftp
  1753.  
  1754.     if { ![info exists ftp(State)] } {
  1755.         DisplayMsg $s "Not connected!" error
  1756.         return 0
  1757.     }
  1758.  
  1759.     if {([llength $args] < 1) || ([llength $args] > 4)} {
  1760.         DisplayMsg $s "wrong # args: should be \"ftp::Append handle (-data \"data\" | localFilename) remoteFilename\"" error
  1761.         return 0
  1762.     }
  1763.  
  1764.     set ftp(inline) 0
  1765.     set flags 1
  1766.     set source ""
  1767.     set dest ""
  1768.     foreach arg $args {
  1769.         if {[string equal $arg "--"]} {
  1770.             set flags 0
  1771.         } elseif {($flags) && ([string equal $arg "-data"])} {
  1772.             set ftp(inline) 1
  1773.             set ftp(filebuffer) ""
  1774.         } elseif {$source == ""} {
  1775.             set source $arg
  1776.         } elseif {$dest == ""} {
  1777.             set dest $arg
  1778.         } else {
  1779.             DisplayMsg $s "wrong # args: should be \"ftp::Append handle (-data \"data\" | localFilename) remoteFilename\"" error
  1780.             return 0
  1781.         }
  1782.     }
  1783.  
  1784.     if {($source == "")} {
  1785.         DisplayMsg $s "Must specify a valid file to Append" error
  1786.         return 0
  1787.     }   
  1788.  
  1789.     set ftp(RemoteFilename) $dest
  1790.  
  1791.     if {$ftp(inline)} {
  1792.         set ftp(PutData) $source
  1793.         if { $dest == "" } {
  1794.             set dest ftp.tmp
  1795.         }
  1796.         set ftp(RemoteFilename) $dest
  1797.     } else {
  1798.         set ftp(PutData) ""
  1799.         if { ![file exists $source] } {
  1800.             DisplayMsg $s "File \"$source\" not exist" error
  1801.             return 0
  1802.         }
  1803.             
  1804.         if { $dest == "" } {
  1805.             set dest [file tail $source]
  1806.         }
  1807.  
  1808.         set ftp(LocalFilename) $source
  1809.         set ftp(RemoteFilename) $dest
  1810.  
  1811.         set ftp(SourceCI) [open $ftp(LocalFilename) r]
  1812.         if { [string equal $ftp(Type) "ascii"] } {
  1813.             fconfigure $ftp(SourceCI) -buffering line -blocking 1
  1814.         } else {
  1815.             fconfigure $ftp(SourceCI) -buffering line -translation binary \
  1816.                     -blocking 1
  1817.         }
  1818.     }
  1819.  
  1820.     set ftp(State) append_$ftp(Mode)
  1821.     StateHandler $s
  1822.  
  1823.     # wait for synchronization
  1824.     set rc [WaitOrTimeout $s]
  1825.     if { $rc } {
  1826.     if {![string length $ftp(Command)]} {
  1827.         ElapsedTime $s [clock seconds]
  1828.     }
  1829.         return 1
  1830.     } else {
  1831.         CloseDataConn $s
  1832.         return 0
  1833.     }
  1834. }
  1835.  
  1836.  
  1837. #############################################################################
  1838. #
  1839. # Get --
  1840. #
  1841. # RETRIEVE DATA - Causes the server to transfer a copy of the specified file
  1842. # to the local site at the other end of the data connection.
  1843. # (exported)
  1844. #
  1845. # Arguments:
  1846. # source -            remote file name
  1847. # dest -            local file name, if unspecified, ftp assigns
  1848. #                the remote file name.
  1849. # Returns:
  1850. # 0 -            file not retrieved
  1851. # 1 -             OK
  1852.  
  1853. proc ftp::Get {s args} {
  1854.     upvar ::ftp::ftp$s ftp
  1855.  
  1856.     if { ![info exists ftp(State)] } {
  1857.         DisplayMsg $s "Not connected!" error
  1858.         return 0
  1859.     }
  1860.  
  1861.     if {([llength $args] < 1) || ([llength $args] > 4)} {
  1862.         DisplayMsg $s "wrong # args: should be \"ftp::Get handle remoteFile ?(-variable varName | localFilename)?\"" error
  1863.     return 0    
  1864.     }
  1865.  
  1866.     set ftp(inline) 0
  1867.     set flags 1
  1868.     set source ""
  1869.     set dest ""
  1870.     set varname "**NONE**"
  1871.     foreach arg $args {
  1872.         if {[string equal $arg "--"]} {
  1873.             set flags 0
  1874.         } elseif {($flags) && ([string equal $arg "-variable"])} {
  1875.             set ftp(inline) 1
  1876.             set ftp(filebuffer) ""
  1877.     } elseif {($ftp(inline)) && ([string equal $varname "**NONE**"])} {
  1878.             set varname $arg
  1879.         set ftp(get:varname) $varname
  1880.     } elseif {$source == ""} {
  1881.             set source $arg
  1882.     } elseif {$dest == ""} {
  1883.             set dest $arg
  1884.     } else {
  1885.             DisplayMsg $s "wrong # args: should be \"ftp::Get handle remoteFile
  1886. ?(-variable varName | localFilename)?\"" error
  1887.         return 0
  1888.         }
  1889.     }
  1890.  
  1891.     if {($ftp(inline)) && ($dest != "")} {
  1892.         DisplayMsg $s "Cannot return data in a variable, and place it in destination file." error
  1893.         return 0
  1894.     }
  1895.  
  1896.     if {$source == ""} {
  1897.         DisplayMsg $s "Must specify a valid file to Get" error
  1898.         return 0
  1899.     }
  1900.  
  1901.     if { $dest == "" } {
  1902.         set dest $source
  1903.     } else {
  1904.         if {[file isdirectory $dest]} {
  1905.             set dest [file join $dest [file tail $source]]
  1906.         }
  1907.     }
  1908.  
  1909.     set ftp(RemoteFilename) $source
  1910.     set ftp(LocalFilename) $dest
  1911.  
  1912.     set ftp(State) get_$ftp(Mode)
  1913.     StateHandler $s
  1914.  
  1915.     # wait for synchronization
  1916.     set rc [WaitOrTimeout $s]
  1917.     if { $rc } {
  1918.     if {![string length $ftp(Command)]} {
  1919.         ElapsedTime $s [clock seconds]
  1920.         if {$ftp(inline)} {
  1921.         upvar $varname returnData
  1922.         set returnData $ftp(GetData)
  1923.         }
  1924.     }
  1925.         return 1
  1926.     } else {
  1927.         if {$ftp(inline)} {
  1928.             return ""
  1929.     }
  1930.         CloseDataConn $s
  1931.         return 0
  1932.     }
  1933. }
  1934.  
  1935. #############################################################################
  1936. #
  1937. # Reget --
  1938. #
  1939. # RESTART RETRIEVING DATA - Causes the server to transfer a copy of the specified file
  1940. # to the local site at the other end of the data connection like get but skips over 
  1941. # the file to the specified data checkpoint. 
  1942. # (exported)
  1943. #
  1944. # Arguments:
  1945. # source -            remote file name
  1946. # dest -            local file name, if unspecified, ftp assigns
  1947. #                the remote file name.
  1948. # Returns:
  1949. # 0 -            file not retrieved
  1950. # 1 -             OK
  1951.  
  1952. proc ftp::Reget {s source {dest ""}} {
  1953.     upvar ::ftp::ftp$s ftp
  1954.  
  1955.     if { ![info exists ftp(State)] } {
  1956.         DisplayMsg $s "Not connected!" error
  1957.         return 0
  1958.     }
  1959.  
  1960.     if { $dest == "" } {
  1961.         set dest $source
  1962.     }
  1963.  
  1964.     set ftp(RemoteFilename) $source
  1965.     set ftp(LocalFilename) $dest
  1966.  
  1967.     if { [file exists $ftp(LocalFilename)] } {
  1968.         set ftp(FileSize) [file size $ftp(LocalFilename)]
  1969.     } else {
  1970.         set ftp(FileSize) 0
  1971.     }
  1972.     
  1973.     set ftp(State) reget_$ftp(Mode)
  1974.     StateHandler $s
  1975.  
  1976.     # wait for synchronization
  1977.     set rc [WaitOrTimeout $s]
  1978.     if { $rc } {
  1979.     if {![string length $ftp(Command)]} {
  1980.         ElapsedTime $s [clock seconds]
  1981.     }
  1982.         return 1
  1983.     } else {
  1984.         CloseDataConn $s
  1985.         return 0
  1986.     }
  1987. }
  1988.  
  1989. #############################################################################
  1990. #
  1991. # Newer --
  1992. #
  1993. # GET NEWER DATA - Get the file only if the modification time of the remote 
  1994. # file is more recent that the file on the current system. If the file does
  1995. # not exist on the current system, the remote file is considered newer.
  1996. # Otherwise, this command is identical to get. 
  1997. # (exported)
  1998. #
  1999. # Arguments:
  2000. # source -            remote file name
  2001. # dest -            local file name, if unspecified, ftp assigns
  2002. #                the remote file name.
  2003. #
  2004. # Returns:
  2005. # 0 -            file not retrieved
  2006. # 1 -             OK
  2007.  
  2008. proc ftp::Newer {s source {dest ""}} {
  2009.     upvar ::ftp::ftp$s ftp
  2010.  
  2011.     if { ![info exists ftp(State)] } {
  2012.         DisplayMsg $s "Not connected!" error
  2013.         return 0
  2014.     }
  2015.  
  2016.     if {[string length $ftp(Command)]} {
  2017.     return -code error "unable to retrieve file asynchronously (not implemented yet)"
  2018.     }
  2019.  
  2020.     if { $dest == "" } {
  2021.         set dest $source
  2022.     }
  2023.  
  2024.     set ftp(RemoteFilename) $source
  2025.     set ftp(LocalFilename) $dest
  2026.  
  2027.     # get remote modification time
  2028.     set rmt [ModTime $s $ftp(RemoteFilename)]
  2029.     if { $rmt == "-1" } {
  2030.         return 0
  2031.     }
  2032.  
  2033.     # get local modification time
  2034.     if { [file exists $ftp(LocalFilename)] } {
  2035.         set lmt [file mtime $ftp(LocalFilename)]
  2036.     } else {
  2037.         set lmt 0
  2038.     }
  2039.     
  2040.     # remote file is older than local file
  2041.     if { $rmt < $lmt } {
  2042.         return 0
  2043.     }
  2044.  
  2045.     # remote file is newer than local file or local file doesn't exist
  2046.     # get it
  2047.     set rc [Get $s $ftp(RemoteFilename) $ftp(LocalFilename)]
  2048.     return $rc
  2049.         
  2050. }
  2051.  
  2052. #############################################################################
  2053. #
  2054. # Quote -- 
  2055. #
  2056. # The arguments specified are sent, verbatim, to the remote ftp server.     
  2057. #
  2058. # Arguments:
  2059. #     arg1 arg2 ...
  2060. #
  2061. # Returns:
  2062. #  string sent back by the remote ftp server or null string if any error
  2063. #
  2064.  
  2065. proc ftp::Quote {s args} {
  2066.     upvar ::ftp::ftp$s ftp
  2067.  
  2068.     if { ![info exists ftp(State)] } {
  2069.         DisplayMsg $s "Not connected!" error
  2070.         return 0
  2071.     }
  2072.  
  2073.     set ftp(Cmd) $args
  2074.     set ftp(Quote) {}
  2075.  
  2076.     set ftp(State) quote
  2077.     StateHandler $s
  2078.  
  2079.     # wait for synchronization
  2080.     set rc [WaitOrTimeout $s] 
  2081.  
  2082.     unset ftp(Cmd)
  2083.  
  2084.     if { $rc } {
  2085.         return $ftp(Quote)
  2086.     } else {
  2087.         return {}
  2088.     }
  2089. }
  2090.  
  2091.  
  2092. #############################################################################
  2093. #
  2094. # Abort -- 
  2095. #
  2096. # ABORT - Tells the server to abort the previous ftp service command and 
  2097. # any associated transfer of data. The control connection is not to be 
  2098. # closed by the server, but the data connection must be closed.
  2099. # 
  2100. # NOTE: This procedure doesn't work properly. Thus the ftp::Abort command
  2101. # is no longer available!
  2102. #
  2103. # Arguments:
  2104. # None.
  2105. #
  2106. # Returns:
  2107. # 0 -            ERROR
  2108. # 1 -             OK
  2109. #
  2110. # proc Abort {} {
  2111. #
  2112. # }
  2113.  
  2114. #############################################################################
  2115. #
  2116. # Close -- 
  2117. #
  2118. # Terminates a ftp session and if file transfer is not in progress, the server
  2119. # closes the control connection.  If file transfer is in progress, the 
  2120. # connection will remain open for result response and the server will then
  2121. # close it. 
  2122. # (exported)
  2123. # 
  2124. # Arguments:
  2125. # None.
  2126. #
  2127. # Returns:
  2128. # 0 -            ERROR
  2129. # 1 -             OK
  2130.  
  2131. proc ftp::Close {s } {
  2132.     variable connections
  2133.     upvar ::ftp::ftp$s ftp
  2134.  
  2135.     if { ![info exists ftp(State)] } {
  2136.         DisplayMsg $s "Not connected!" error
  2137.         return 0
  2138.     }
  2139.  
  2140.     if {[info exists \
  2141.             connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid)]} {
  2142.         unset connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid)
  2143.         unset connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost))
  2144.     }
  2145.  
  2146.     set ftp(State) quit
  2147.     StateHandler $s
  2148.  
  2149.     # wait for synchronization
  2150.     WaitOrTimeout $s
  2151.  
  2152.     catch {close $ftp(CtrlSock)}
  2153.     catch {unset ftp}
  2154.     return 1
  2155. }
  2156.  
  2157. proc ftp::LazyClose {s } {
  2158.     variable connections
  2159.     upvar ::ftp::ftp$s ftp
  2160.  
  2161.     if { ![info exists ftp(State)] } {
  2162.         DisplayMsg $s "Not connected!" error
  2163.         return 0
  2164.     }
  2165.  
  2166.     if {[info exists connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost))]} {
  2167.         set connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid) \
  2168.                 [after 5000 [list ftp::Close $s]]
  2169.     }
  2170.     return 1
  2171. }
  2172.  
  2173. #############################################################################
  2174. #
  2175. # Open --
  2176. #
  2177. # Starts the ftp session and sets up a ftp control connection.
  2178. # (exported)
  2179. # 
  2180. # Arguments:
  2181. # server -         The ftp server hostname.
  2182. # user -        A string identifying the user. The user identification 
  2183. #            is that which is required by the server for access to 
  2184. #            its file system.  
  2185. # passwd -        A string specifying the user's password.
  2186. # options -        -blocksize size        writes "size" bytes at once
  2187. #                        (default 4096)
  2188. #            -timeout seconds    if non-zero, sets up timeout to
  2189. #                        occur after specified number of
  2190. #                        seconds (default 120)
  2191. #            -progress proc        procedure name that handles callbacks
  2192. #                        (no default)  
  2193. #            -output proc        procedure name that handles output
  2194. #                        (no default)  
  2195. #            -mode mode        switch active or passive file transfer
  2196. #                        (default active)
  2197. #            -port number        alternative port (default 21)
  2198. #            -command proc        callback for completion notification
  2199. #                        (no default)
  2200. # 
  2201. # Returns:
  2202. # 0 -            Not logged in
  2203. # 1 -             User logged in
  2204.  
  2205. proc ftp::Open {server user passwd args} {
  2206.     variable DEBUG 
  2207.     variable VERBOSE
  2208.     variable serial
  2209.     variable connections
  2210.  
  2211.     set s $serial
  2212.     incr serial
  2213.     upvar ::ftp::ftp$s ftp
  2214. #    if { [info exists ftp(State)] } {
  2215. #        DisplayMsg $s "Mmh, another attempt to open a new connection? There is already a hot wire!" error
  2216. #        return 0
  2217. #    }
  2218.  
  2219.     # default NO DEBUG
  2220.     if { ![info exists DEBUG] } {
  2221.         set DEBUG 0
  2222.     }
  2223.  
  2224.     # default NO VERBOSE
  2225.     if { ![info exists VERBOSE] } {
  2226.         set VERBOSE 0
  2227.     }
  2228.     
  2229.     if { $DEBUG } {
  2230.         DisplayMsg $s "Starting new connection with: "
  2231.     }
  2232.     
  2233.     set ftp(User)       $user
  2234.     set ftp(Passwd)     $passwd
  2235.     set ftp(RemoteHost) $server
  2236.     set ftp(LocalHost)     [info hostname]
  2237.     set ftp(DataPort)     0
  2238.     set ftp(Type)     {}
  2239.     set ftp(Error)     ""
  2240.     set ftp(Progress)     {}
  2241.     set ftp(Command)    {}
  2242.     set ftp(Output)     {}
  2243.     set ftp(Blocksize)     4096    
  2244.     set ftp(Timeout)     600    
  2245.     set ftp(Mode)     active    
  2246.     set ftp(Port)     21    
  2247.  
  2248.     set ftp(State)     user
  2249.     
  2250.     # set state var
  2251.     set ftp(state.control) ""
  2252.     
  2253.     # Get and set possible options
  2254.     set options {-blocksize -timeout -mode -port -progress -output -command}
  2255.     foreach {option value} $args {
  2256.         if { [lsearch -exact $options $option] != "-1" } {
  2257.             if { $DEBUG } {
  2258.                 DisplayMsg $s "  $option = $value"
  2259.             }
  2260.             regexp -- {^-(.?)(.*)$} $option all first rest
  2261.             set option "[string toupper $first]$rest"
  2262.             set ftp($option) $value
  2263.         } 
  2264.     }
  2265.     if { $DEBUG && ([llength $args] == 0) } {
  2266.         DisplayMsg $s "  no option"
  2267.     }
  2268.  
  2269.     if {[info exists \
  2270.             connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid)]} {
  2271.         after cancel $connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid)
  2272.     Command $ftp(Command) connect $connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost))
  2273.         return $connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost))
  2274.     }
  2275.  
  2276.  
  2277.     # No call of StateHandler is required at this time.
  2278.     # StateHandler at first time is called automatically
  2279.     # by a fileevent for the control channel.
  2280.  
  2281.     # Try to open a control connection
  2282.     if { ![OpenControlConn $s [expr {[string length $ftp(Command)] > 0}]] } {
  2283.         return -1
  2284.     }
  2285.  
  2286.     # waits for synchronization
  2287.     #   0 ... Not logged in
  2288.     #   1 ... User logged in
  2289.     if {[string length $ftp(Command)]} {
  2290.     # Don't wait - asynchronous operation
  2291.     set ftp(NextState) {type connect_last}
  2292.         set connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost)) $s
  2293.     return $s
  2294.     } elseif { [WaitOrTimeout $s] } {
  2295.         # default type is binary
  2296.         Type $s binary
  2297.         set connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost)) $s
  2298.     Command $ftp(Command) connect $s
  2299.         return $s
  2300.     } else {
  2301.         # close connection if not logged in
  2302.         Close $s
  2303.         return -1
  2304.     }
  2305. }
  2306.  
  2307. #############################################################################
  2308. #
  2309. # CopyNext --
  2310. #
  2311. # recursive background copy procedure for ascii/binary file I/O
  2312. # 
  2313. # Arguments:
  2314. # bytes -         indicates how many bytes were written on $ftp(DestCI)
  2315.  
  2316. proc ftp::CopyNext {s bytes {error {}}} {
  2317.     upvar ::ftp::ftp$s ftp
  2318.     variable DEBUG
  2319.     variable VERBOSE
  2320.  
  2321.     # summary bytes
  2322.  
  2323.     incr ftp(Total) $bytes
  2324.  
  2325.     # callback for progress bar procedure
  2326.     
  2327.     if { ([info exists ftp(Progress)]) && \
  2328.         [string length $ftp(Progress)] && \
  2329.         ([info commands [lindex $ftp(Progress) 0]] != "") } { 
  2330.         eval $ftp(Progress) $ftp(Total)
  2331.     }
  2332.  
  2333.     # setup new timeout handler
  2334.  
  2335.     catch {after cancel $ftp(Wait)}
  2336.     set ftp(Wait) [after [expr {$ftp(Timeout) * 1000}] [namespace current]::Timeout $s]
  2337.  
  2338.     if { $DEBUG } {
  2339.         DisplayMsg $s "-> $ftp(Total) bytes $ftp(SourceCI) -> $ftp(DestCI)" 
  2340.     }
  2341.  
  2342.     if { $error != "" } {
  2343.         catch {close $ftp(DestCI)}
  2344.         catch {close $ftp(SourceCI)}
  2345.         unset ftp(state.data)
  2346.         DisplayMsg $s $error error
  2347.  
  2348.     } elseif { [eof $ftp(SourceCI)] } {
  2349.         close $ftp(DestCI)
  2350.         close $ftp(SourceCI)
  2351.         unset ftp(state.data)
  2352.         if { $VERBOSE } {
  2353.             DisplayMsg $s "D: Port closed" data
  2354.         }
  2355.  
  2356.     } else {
  2357.         fcopy $ftp(SourceCI) $ftp(DestCI) -command [list [namespace current]::CopyNext $s] -size $ftp(Blocksize)
  2358.  
  2359.     }
  2360.     return
  2361. }
  2362.  
  2363. #############################################################################
  2364. #
  2365. # HandleData --
  2366. #
  2367. # Handles ascii/binary data transfer for Put and Get 
  2368. # 
  2369. # Arguments:
  2370. # sock -         socket name (data channel)
  2371.  
  2372. proc ftp::HandleData {s sock} {
  2373.     upvar ::ftp::ftp$s ftp
  2374.  
  2375.     # Turn off any fileevent handlers
  2376.  
  2377.     fileevent $sock writable {}        
  2378.     fileevent $sock readable {}
  2379.  
  2380.     # create local file for ftp::Get 
  2381.  
  2382.     if { [regexp -- "^get" $ftp(State)]  && (!$ftp(inline))} {
  2383.         set rc [catch {set ftp(DestCI) [open $ftp(LocalFilename) w]} msg]
  2384.         if { $rc != 0 } {
  2385.             DisplayMsg $s "$msg" error
  2386.             return 0
  2387.         }
  2388.     # TODO: Use non-blocking I/O
  2389.         if { [string equal $ftp(Type) "ascii"] } {
  2390.             fconfigure $ftp(DestCI) -buffering line -blocking 1
  2391.         } else {
  2392.             fconfigure $ftp(DestCI) -buffering line -translation binary -blocking 1
  2393.         }
  2394.     }    
  2395.  
  2396.     # append local file for ftp::Reget 
  2397.  
  2398.     if { [regexp -- "^reget" $ftp(State)] } {
  2399.         set rc [catch {set ftp(DestCI) [open $ftp(LocalFilename) a]} msg]
  2400.         if { $rc != 0 } {
  2401.             DisplayMsg $s "$msg" error
  2402.             return 0
  2403.         }
  2404.     # TODO: Use non-blocking I/O
  2405.         if { [string equal $ftp(Type) "ascii"] } {
  2406.             fconfigure $ftp(DestCI) -buffering line -blocking 1
  2407.         } else {
  2408.             fconfigure $ftp(DestCI) -buffering line -translation binary -blocking 1
  2409.         }
  2410.     }    
  2411.  
  2412.     # perform fcopy
  2413.  
  2414.     set ftp(Total) 0
  2415.     set ftp(Start_Time) [clock seconds]
  2416.     fcopy $ftp(SourceCI) $ftp(DestCI) -command [list [namespace current]::CopyNext $s] -size $ftp(Blocksize)
  2417.     return 1
  2418. }
  2419.  
  2420. #############################################################################
  2421. #
  2422. # HandleList --
  2423. #
  2424. # Handles ascii data transfer for list commands
  2425. # 
  2426. # Arguments:
  2427. # sock -         socket name (data channel)
  2428.  
  2429. proc ftp::HandleList {s sock} {
  2430.     upvar ::ftp::ftp$s ftp
  2431.     variable VERBOSE
  2432.  
  2433.     if { ![eof $sock] } {
  2434.         set buffer [read $sock]
  2435.         if { $buffer != "" } {
  2436.             set ftp(List) [append ftp(List) $buffer]
  2437.         }    
  2438.     } else {
  2439.         close $sock
  2440.         catch {unset ftp(state.data)}
  2441.         if { $VERBOSE } {
  2442.             DisplayMsg $s "D: Port closed" data
  2443.         }
  2444.     }
  2445.     return
  2446. }
  2447.  
  2448. #############################################################################
  2449. #
  2450. # HandleVar --
  2451. #
  2452. # Handles data transfer for get/put commands that use buffers instead
  2453. # of files.
  2454. # 
  2455. # Arguments:
  2456. # sock -         socket name (data channel)
  2457.  
  2458. proc ftp::HandleVar {s sock} {
  2459.     upvar ::ftp::ftp$s ftp
  2460.     variable VERBOSE
  2461.  
  2462.     if {$ftp(Start_Time) == -1} {
  2463.         set ftp(Start_Time) [clock seconds]
  2464.     }
  2465.  
  2466.     if { ![eof $sock] } {
  2467.         set buffer [read $sock]
  2468.         if { $buffer != "" } {
  2469.             append ftp(GetData) $buffer
  2470.             incr ftp(Total) [string length $buffer]
  2471.         }    
  2472.     } else {
  2473.         close $sock
  2474.         catch {unset ftp(state.data)}
  2475.         if { $VERBOSE } {
  2476.             DisplayMsg $s "D: Port closed" data
  2477.         }
  2478.     }
  2479.     return
  2480. }
  2481.  
  2482. #############################################################################
  2483. #
  2484. # HandleOutput --
  2485. #
  2486. # Handles data transfer for get/put commands that use buffers instead
  2487. # of files.
  2488. # 
  2489. # Arguments:
  2490. # sock -         socket name (data channel)
  2491.  
  2492. proc ftp::HandleOutput {s sock} {
  2493.     upvar ::ftp::ftp$s ftp
  2494.     variable VERBOSE
  2495.  
  2496.     if {$ftp(Start_Time) == -1} {
  2497.         set ftp(Start_Time) [clock seconds]
  2498.     }
  2499.  
  2500.     if { $ftp(Total) < [string length $ftp(PutData)] } {
  2501.         set substr [string range $ftp(PutData) $ftp(Total) \
  2502.                 [expr {$ftp(Total) + $ftp(Blocksize)}]]
  2503.         if {[catch {puts -nonewline $sock "$substr"} result]} {
  2504.             close $sock
  2505.             unset ftp(state.data)
  2506.             if { $VERBOSE } {
  2507.                 DisplayMsg $s "D: Port closed" data
  2508.             }
  2509.         } else {
  2510.             incr ftp(Total) [string length $substr]
  2511.         }
  2512.     } else {
  2513.         fileevent $sock writable {}        
  2514.         close $sock
  2515.         catch {unset ftp(state.data)}
  2516.         if { $VERBOSE } {
  2517.             DisplayMsg $s "D: Port closed" data
  2518.         }
  2519.     }
  2520.     return
  2521. }
  2522.  
  2523. ############################################################################
  2524. #
  2525. # CloseDataConn -- 
  2526. #
  2527. # Closes all sockets and files used by the data conection
  2528. #
  2529. # Arguments:
  2530. # None.
  2531. #
  2532. # Returns:
  2533. # None.
  2534. #
  2535. proc ftp::CloseDataConn {s } {
  2536.     upvar ::ftp::ftp$s ftp
  2537.  
  2538.     catch {after cancel $ftp(Wait)}
  2539.     catch {fileevent $ftp(DataSock) readable {}}
  2540.     catch {close $ftp(DataSock); unset ftp(DataSock)}
  2541.     catch {close $ftp(DestCI); unset ftp(DestCI)} 
  2542.     catch {close $ftp(SourceCI); unset ftp(SourceCI)}
  2543.     catch {close $ftp(DummySock); unset ftp(DummySock)}
  2544.     return
  2545. }
  2546.  
  2547. #############################################################################
  2548. #
  2549. # InitDataConn --
  2550. #
  2551. # Configures new data channel for connection to ftp server 
  2552. # ATTENTION! The new data channel "sock" is not the same as the 
  2553. # server channel, it's a dummy.
  2554. # 
  2555. # Arguments:
  2556. # sock -        the name of the new channel
  2557. # addr -        the address, in network address notation, 
  2558. #            of the client's host,
  2559. # port -        the client's port number
  2560.  
  2561. proc ftp::InitDataConn {s sock addr port} {
  2562.     upvar ::ftp::ftp$s ftp
  2563.     variable VERBOSE
  2564.  
  2565.     # If the new channel is accepted, the dummy channel will be closed
  2566.  
  2567.     catch {close $ftp(DummySock); unset ftp(DummySock)}
  2568.  
  2569.     set ftp(state.data) 0
  2570.  
  2571.     # Configure translation and blocking modes
  2572.  
  2573.     set blocking 1
  2574.     if {[string length $ftp(Command)]} {
  2575.     set blocking 0
  2576.     }
  2577.  
  2578.     if { [string equal $ftp(Type) "ascii"] } {
  2579.         fconfigure $sock -buffering line -blocking $blocking
  2580.     } else {
  2581.         fconfigure $sock -buffering line -translation binary -blocking $blocking
  2582.     }
  2583.  
  2584.     # assign fileevent handlers, source and destination CI (Channel Identifier)
  2585.  
  2586.     switch -regexp -- $ftp(State) {
  2587.         list {
  2588.             fileevent $sock readable [list [namespace current]::HandleList $s $sock]
  2589.             set ftp(SourceCI) $sock          
  2590.         }
  2591.         get {
  2592.             if {$ftp(inline)} {
  2593.                 set ftp(GetData) ""
  2594.                 set ftp(Start_Time) -1
  2595.                 set ftp(Total) 0
  2596.                 fileevent $sock readable [list [namespace current]::HandleVar $s $sock]
  2597.         } else {
  2598.                 fileevent $sock readable [list [namespace current]::HandleData $s $sock]
  2599.                 set ftp(SourceCI) $sock
  2600.         }              
  2601.         }
  2602.         append -
  2603.         put {
  2604.             if {$ftp(inline)} {
  2605.                 set ftp(Start_Time) -1
  2606.                 set ftp(Total) 0
  2607.                 fileevent $sock writable [list [namespace current]::HandleOutput $s $sock]
  2608.         } else {
  2609.                 fileevent $sock writable [list [namespace current]::HandleData $s $sock]
  2610.                 set ftp(DestCI) $sock
  2611.         }              
  2612.         }
  2613.     default {
  2614.         error "Unknown state \"$ftp(State)\""
  2615.     }
  2616.     }
  2617.  
  2618.     if { $VERBOSE } {
  2619.         DisplayMsg $s "D: Connection from $addr:$port" data
  2620.     }
  2621.     return
  2622. }
  2623.  
  2624. #############################################################################
  2625. #
  2626. # OpenActiveConn --
  2627. #
  2628. # Opens a ftp data connection
  2629. # 
  2630. # Arguments:
  2631. # None.
  2632. # 
  2633. # Returns:
  2634. # 0 -            no connection
  2635. # 1 -             connection established
  2636.  
  2637. proc ftp::OpenActiveConn {s } {
  2638.     upvar ::ftp::ftp$s ftp
  2639.     variable VERBOSE
  2640.  
  2641.     # Port address 0 is a dummy used to give the server the responsibility 
  2642.     # of getting free new port addresses for every data transfer.
  2643.     
  2644.     set rc [catch {set ftp(DummySock) [socket -server [list [namespace current]::InitDataConn $s] 0]} msg]
  2645.     if { $rc != 0 } {
  2646.         DisplayMsg $s "$msg" error
  2647.         return 0
  2648.     }
  2649.  
  2650.     # get a new local port address for data transfer and convert it to a format
  2651.     # which is useable by the PORT command
  2652.  
  2653.     set p [lindex [fconfigure $ftp(DummySock) -sockname] 2]
  2654.     if { $VERBOSE } {
  2655.         DisplayMsg $s "D: Port is $p" data
  2656.     }
  2657.     set ftp(DataPort) "[expr {$p / 256}],[expr {$p % 256}]"
  2658.  
  2659.     return 1
  2660. }
  2661.  
  2662. #############################################################################
  2663. #
  2664. # OpenPassiveConn --
  2665. #
  2666. # Opens a ftp data connection
  2667. # 
  2668. # Arguments:
  2669. # buffer - returned line from server control connection 
  2670. # 
  2671. # Returns:
  2672. # 0 -            no connection
  2673. # 1 -             connection established
  2674.  
  2675. proc ftp::OpenPassiveConn {s buffer} {
  2676.     upvar ::ftp::ftp$s ftp
  2677.  
  2678.     if { [regexp -- {([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)} $buffer all a1 a2 a3 a4 p1 p2] } {
  2679.         set ftp(LocalAddr) "$a1.$a2.$a3.$a4"
  2680.         set ftp(DataPort) "[expr {$p1 * 256 + $p2}]"
  2681.  
  2682.         # establish data connection for passive mode
  2683.  
  2684.         set rc [catch {set ftp(DataSock) [socket $ftp(LocalAddr) $ftp(DataPort)]} msg]
  2685.         if { $rc != 0 } {
  2686.             DisplayMsg $s "$msg" error
  2687.             return 0
  2688.         }
  2689.  
  2690.         InitDataConn $s $ftp(DataSock) $ftp(LocalAddr) $ftp(DataPort)
  2691.         return 1
  2692.     } else {
  2693.         return 0
  2694.     }
  2695. }
  2696.  
  2697. #############################################################################
  2698. #
  2699. # OpenControlConn --
  2700. #
  2701. # Opens a ftp control connection
  2702. # 
  2703. # Arguments:
  2704. #    s    connection id
  2705. #    block    blocking or non-blocking mode
  2706. # 
  2707. # Returns:
  2708. # 0 -            no connection
  2709. # 1 -             connection established
  2710.  
  2711. proc ftp::OpenControlConn {s {block 1}} {
  2712.     upvar ::ftp::ftp$s ftp
  2713.     variable DEBUG
  2714.     variable VERBOSE
  2715.  
  2716.     # open a control channel
  2717.  
  2718.     set rc [catch {set ftp(CtrlSock) [socket $ftp(RemoteHost) $ftp(Port)]} msg]
  2719.     if { $rc != 0 } {
  2720.         if { $VERBOSE } {
  2721.             DisplayMsg $s "C: No connection to server!" error
  2722.         }
  2723.         if { $DEBUG } {
  2724.             DisplayMsg $s "[list $msg]" error
  2725.         }
  2726.         unset ftp(State)
  2727.         return 0
  2728.     }
  2729.  
  2730.     # configure control channel
  2731.  
  2732.     fconfigure $ftp(CtrlSock) -buffering line -blocking $block -translation {auto crlf}
  2733.     fileevent $ftp(CtrlSock) readable [list [namespace current]::StateHandler $s $ftp(CtrlSock)]
  2734.     
  2735.     # prepare local ip address for PORT command (convert pointed format
  2736.     # to comma format)
  2737.  
  2738.     set ftp(LocalAddr) [lindex [fconfigure $ftp(CtrlSock) -sockname] 0]
  2739.     regsub -all -- "\[.\]" $ftp(LocalAddr) "," ftp(LocalAddr) 
  2740.  
  2741.     # report ready message
  2742.  
  2743.     set peer [fconfigure $ftp(CtrlSock) -peername]
  2744.     if { $VERBOSE } {
  2745.         DisplayMsg $s "C: Connection from [lindex $peer 0]:[lindex $peer 2]" control
  2746.     }
  2747.     
  2748.     return 1
  2749. }
  2750.  
  2751. # ftp::Command --
  2752. #
  2753. #    Wrapper for evaluated user-supplied command callback
  2754. #
  2755. # Arguments:
  2756. #    cb    callback script
  2757. #    msg    what happened
  2758. #    args    additional info
  2759. #
  2760. # Results:
  2761. #    Depends on callback script
  2762.  
  2763. proc ftp::Command {cb msg args} {
  2764.     if {[string length $cb]} {
  2765.     uplevel #0 $cb [list $msg] $args
  2766.     }
  2767. }
  2768.  
  2769. # ?????? Hmm, how to do multithreaded for tkcon?
  2770. # added TkCon support
  2771. # TkCon is (c) 1995-2001 Jeffrey Hobbs, http://tkcon.sourceforge.net/
  2772. # started with: tkcon -load ftp
  2773. if { [string equal [uplevel "#0" {info commands tkcon}] "tkcon"] } {
  2774.  
  2775.     # new ftp::List proc makes the output more readable
  2776.     proc ::ftp::__ftp_ls {args} {
  2777.         foreach i [eval ::ftp::List_org $args] {
  2778.             puts $i
  2779.         }
  2780.     }
  2781.  
  2782.     # rename the original ftp::List procedure
  2783.     rename ::ftp::List ::ftp::List_org
  2784.  
  2785.     alias ::ftp::List    ::ftp::__ftp_ls
  2786.     alias bye        catch {::ftp::Close; exit}    
  2787.  
  2788.     set ::ftp::VERBOSE 1
  2789.     set ::ftp::DEBUG 0
  2790. }
  2791.  
  2792.