diff options
| author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
|---|---|---|
| committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
| commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
| tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/ftp | |
| parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
| parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
| download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 | |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/ftp')
27 files changed, 5712 insertions, 0 deletions
diff --git a/tcllib/modules/ftp/ChangeLog b/tcllib/modules/ftp/ChangeLog new file mode 100644 index 0000000..ff11511 --- /dev/null +++ b/tcllib/modules/ftp/ChangeLog @@ -0,0 +1,621 @@ +2013-03-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * rfc959.txt: Removed copies of RFC documents. Keep only links. + * std9.txt: + +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-08-09 Andreas Kupries <andreask@activestate.com> + + * ftp.man: Bumped version to 2.4.11. + * ftp.tcl: + * pkgIndex.tcl: + + * ftp.tcl (::ftp::OpenActiveConn, ::ftp::OpenControlConn): + [Bug 3325112]: Accepted patch by Alexandre Ferrieux + <ferrieux@users.sourceforge.net> reducing the number of reverse + DNS lookups. + +2011-04-18 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (::ftp::__ftp_ls): [Bug 3288793]: Fixed ftp::List + variant used by Tkcon, to not only print the result, but + continue returning it as well, for non-interactive use. Thanks + to Pedro <proteco@users.sourceforge.net> + + * ftp.tcl (::ftp::StateHandler): [Bug 3288977]: Fixed handling of + multi-line replies which are not strictly RFC 959. Thanks to + Shaun Zinck <szinck@users.sourceforge.net>. This partially fixes + [Bug 2813069]. + + * pkgIndex.tcl: Bumped version to 2.4.10. + * ftp.man: + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2008-08-05 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl: Fixed [Bug 2038279], a creative-writing problem. + * ftp.man: Bumped package version to 2.4.9. + * pkgIndex.tcl: + +2008-03-17 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp_geturl.man: Separated the documentation of the ftp and + * ftp.man: ftp::geturl packages into two files. + +2007-09-13 Andreas Kupries <andreask@activestate.com> + + * ftp_geturl.tcl (::ftp::geturl): Fixed the handling of urls which + * pkgIndex.tcl: are directories instead of files, per the patch + * ftp.man: coming with [SF Tcllib Bug 1793855], suggested by + Gerald Lester. Bumped version of ftp::geturl to 0.2.1. + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-05-07 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (::ftp::Get): SF Bug 1708350. Do not unset get:channel + * pkgIndex.tcl: state information to prevent async get from + * ftp.man: blowing in HandleData. More comments in the + code. Version bumped to 2.4.8. + +2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2006-11-09 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (::ftp::StateHandler): Fixed [Bug 1191607] using the + * ftp.man: minimum possible change. Exporting information + * pkgIndex.tcl: accumulated in buffer to msgtext. Version is + now 2.4.7. + +2006-10-23 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (::ftp::StateHandler): Applied patch by Guy Hofkens + * ftp.man: <hofkensg@users.sourceforge.net>, with small + * pkgIndex.tcl: modification by myself (removing a no-op), for + [SF Tcllib Bug 15822535], reported by same person, fixing an + infinite recursion through vwait because the ctrl socket at eof + is not closed and immediately waited upon again for more + events. Version now 2.4.6. + +2006-10-20 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl: Wrapped several 'unset ftp(state.data)' into 'catch' + * ftp.man: as the state-logic apparently is able to run several + * pkgIndex.tcl: of them multiple times in exceptional situations + (i.e. ftp errors). This should fix both [SF Tcllib Bug 1234831] + and [SF Tcllib Bug 1581453]. Version now 2.4.5. Thanks to + <goodegod@users.sourceforge.net> who tracked this down. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-09-22 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (::ftp::NList): Fixed [SF Tcllib Bug 1563137] using the + * ftp.man: patch submitted by Keith Vetter + * pkgIndex.tcl: <keithv@users.sourceforge.net> as part of his + report. Bumped version to 2.4.4 See also the duplicate entry + [SF Tcllib Bug 1553919]. And also [SF Tcllib Bug 748758]. + +2006-09-19 Andreas Kupries <andreask@activestate.com> + + * ftp.man: Bumped version to 2.4.3 + * ftp.tcl: + * pkgIndex.tcl: + +2006-06-13 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (::ftp::StateHandler): Replaced use of 8.4ism (expr 'ne' + operator) with appropriate invokation of 'string equal'. This + fixes [SF Tcllib Bug 1429377], reported by John Mercogliano III. + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-02-14 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (::ftp::StateHandler): Accepted patch by Keith Vetter + <keithv@users.sourceforge.net> for [SF Tcllib Bug 1076923], also + reported by him. This fixes a race condition where the client + has sent QUIT and is waiting for response, but gets the socket + closed without any. + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2003-12-01 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (ftp::StateHandler): See last entry. The condition to + invoke a report for a failure of the regex was wrong, and + missing a negation. Fixed this. Also cleaned up the regexp, it + had a caret to much in it. Thanks to <nafis@crd.ge.com> for + reporting this. The bug report is at --> + http://bugs.activestate.com/show_bug.cgi?id=28433, and not on + SourceForge. + +2003-10-21 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (ftp::StateHandler): Accepted change to the regexp + pattern to handle irregular input better. [Bug 739393]. Also + added code to handle future regex failures better. + +2003-07-28 Aaron Faupell <afaupell@users.sourceforge.net> + + * ftp.tcl: fixed bug #753770, added verbose flag check in + ElapsedTime. + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-11 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl: + * ftp.man: + * ftp_geturl.tcl: + * pkgIndex.tcl: Fixed bug #614591. Set version of the package to + to 2.4. Set version of geturl package to 0.2. + +2003-03-31 Andreas Kupries <andreask@activestate.com> + + * ftp.tcl (ModTime): Applied patch #659238 supplied by Dan Rogahn + <ddrogahn@users.sourceforge.net> to allow setting the + modification time of a file, assuming the server allows this as + well. + +2003-03-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * ftp.tcl (ftp::InitDataConn): revert -regexp to fix bug 701288. + +2003-02-24 David N. Welton <davidw@dedasys.com> + + * ftp.tcl (ftp::OpenControlConn): Use string map instead of + regsub. + +2003-01-28 David N. Welton <davidw@dedasys.com> + + * ftp.tcl (ftp::InitDataConn): Use 'string match' instead of + regexp. + +2003-01-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.man: More semantic markup, less visual one. + +2002-08-30 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * examples (hpupdate.tcl): Updated 'info exist' to 'info exists'. + +2002-08-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftpdemo.tcl (Examples): Changed ftp.tcl to ftpdemo.tcl in + [test_40afile] and [test_70append]. Problem found and reported + by Jussi Kuosa <Jussi.Kuosa@tellabs.com>. + +2002-08-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl: Fixed SF Bug #582668, reported by Frank Richter + <frari@users.sourceforge.net>. + +2002-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.man: New, doctools manpage. + +2002-02-14 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl: Frink run. + + * ftp: Version is now 2.3.1 to distinguish this from the code in + tcllib release 1.2 + +2002-01-26 Pat Thoyts <patthoyts@users.sourceforge.net> + + * ftp_geturl.tcl: Re-opened FR #476804 to add support for + username and password and for non-unix based FTP servers. + +2002-01-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * Bumped version to 2.3 + +2002-01-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl: Fix for bug #503471. The commands Get, Reget, and Newer + now check if the directory the local file is to be placed in + does exist. They now immediately throw an error if the directory + does not exist instead of starting the download and getting + confused. + + * ftp.n: Typo fix. Updates in the descriptions of Get, Reget, and + Newer explaining the new behaviour, s.a. + +2001-11-20 Joe English <jenglish@users.sourceforge.net> + + * ftp.n: (r1.6 -> r1.8) Update for bug report #474999 + "ftp man page description typo" -- attempt to clarify + description of "ftp::List" command. Also fixed minor + markup errors. + +2001-11-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl: Tested implementation of FR #481161. Fixed the errors + found that way (incomplete cleanup by 'Get', interfered with the + following 'Put' command). + +2001-11-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl, ftp.n: Implemented and documented FR #481161. + + * ftp.tcl: Applied patch #428053 provided by Sreangsu Acharyya + <srean_list@myrealbox.com>. The patch extends 'Reget' to allow + download of an exactly specified slice of the the source + file. This enables the implementation of a 'resume' after a + partial download and also the parallel download of + non-overlaping parts of the same file from different servers. + + * ftp.n: updated documentation to cover the new code above and + below. + + * ftp_geturl.tcl: New file, provides a geturl command for use by + uri. Declared in a separate package to avoid a cyclic dependency + between the ftp and uri packages. The uri package is changed to + try for a scheme::geturl package first and then for a scheme + package to get the desired functionality. Implements FR #476804. + +2001-11-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl: Applied patch in #478478 to handle non-standard date + information from servers with a buggy y2k patch. 2001 is + rendered as 19101 (19*100 + 101 = 2001). + +2001-11-04 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.n: Updated description of DisplayMsg to the changed + behaviour and added a discussion of what happens should it throw + errors. Also added a description of option -output to the + description of ftp::Open. + + * ftp.tcl: Fixed bug #476729. Instead of describing the behaviour + of the default 'DisplayMsg' the procedure is changed instead to + throw no errors, and to use the log module of tcllib. Thanks to + Larry Virden <lvirden@users.sourceforge.net> for pointing out + the deficiencies in the documentation. + +2001-10-20 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl: Fixed bug #466746. Reporter of bug unknown, provided + fix too. Problem was incomplete handling of [gets] return + values. Value -1 signaling an incomplete line was not handled. + +2001-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.n: + * ftp.tcl: + * pkgIndex.tcl: Version up to 2.2.1. + +2001-09-17 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * example/hpupdate.tcl: Some cleanups in the example code, + provided by Larry Virden <lvirden@users.sourceforge.net>. This + fixes [440064]. + +2001-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * Added manpages for ftp package. + +2001-08-01 Don Porter <dgp@users.sourceforge.net> + + * example/hpupdate.tcl: Workaround for moving Tk internal + command [tkButtonInvoke]. [Bug 450914] + +2001-08-01 Jeff Hobbs <jeffh@ActiveState.com> + + * ftp.tcl: added eval in ftp::List wrapper when used in tkcon. + [Bug: #439779] (loring) + +2001-07-10 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftp.tcl: Frink 2.2 run, fixed dubious code. + +2001-06-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * ftpdemo.tcl: + * ftp.tcl: Fixed dubious code reported by frink. + +2000-10-01 Dan Kuchler <kuchler@ajubasolutions.com> + + * ftp.tcl: Moved the call to 'DisplayMsg' from inside of the + fileevent loop (in ftp::StateHandler) to WaitorTimeout. Now + errors that occur in StateHandler won't be thrown until after the + the asynchronous (fileevent) portion of the code has completed. + ftp::OpenActiveConn and ftp::OpenPassiveConn can both still generate + errors in the event loop, which will cause a bgerror to be thrown. + Added some (untested) code to support Tenex mode ftp transfers. So + far tenex mode sends across 'TYPE L', and then does the transfer with + a binary encoded channel. Since I don't have a tenex system to test + it with, this feature is very alpha at this point. + +2000-09-28 Dan Kuchler <kuchler@ajubasolutions.com> + + * ftp.tcl: Fixed a line of code in the "list_close" state of StateHandler, + switching a ![info exists... to [info exists... + +2000-09-25 Sandeep Tamhankar <sandeep@ajubasolutions.com> + + * ftp.tcl: Fixed a line of code in the "connect" state of StateHandler, + switching a ![info exists... to [info exists... It was originally + stack tracing when opening a connection. + +2000-08-29 Steve Ball <Steve.Ball@zveno.com> + + * README + * ftp.tcl + * pkgIndex.tcl + * docs/Open.html: Added '-command' configuration to the Open + command. This option indicates that all operations performed + on this connection are to be made asynchronously. The value + given to the option is a script which is invoked when operations + have finished. Updated documentation and bumped the version + number from 2.1 to 2.2 because a new feature was added. + +2000-08-16 Dan Kuchler <kuchler@ajubasolutions.com> + + * README + * ftp.tcl + * pkgIndex.tcl + * docs/*.html: Added new optional arguments to the Get, Put, and + Append commands. The Append and Put commands have a new optional + argument '-data "data"' that can be used to specify data to transfer + instead of transferring data from a local file. The Get command has + a new optional argument '-variable varname' that specifies a variable + to store the retrieved data into, that can be used instead of + specifying a local filename. Updated the documentation to reflect + the changes and bumped the version number from 2.0 to 2.1 because + new features were added. + + +2000-08-10 Dan Kuchler <kuchler@ajubasolutions.com> + + * ftp.tcl + * pkgIndex.tcl: Fixed the ftp package to allow for + the destination location of the ftp::Get command to + be a directory as well as a file. + +2000-07-08 Dan Kuchler <kuchler@ajubasolutions.com> + + * README + * ftp.tcl + * ftpdemo.tcl + * pkgIndex.tcl + * example/README + * example/hpupdate.tcl + * example/mirror.tcl + * example/newer.tcl + * docs/*.html: Updated for the change of ftp_lib.tcl -> ftp.tcl, for + the change of ftp_demo.tcl to ftpdemo.tcl, and for the FTP namespace + change. Made lots of fixes to complete the partially done work to + make ftp handle multiple concurrent ftps at the same time. Updated the + version in the docs, examples, source, and pkgIndex to be version 2.0 + +2000-06-02 Eric Melski <ericm@scriptics.com> + + * ftp.tcl: Changed namespace to ftp (from FTP). Updated license + information. Renamed ftp_lib.tcl to ftp.tcl in preparation for + inclusion in tcllib. + +1999-12-31 Peter MacDonald <peter@pdqi.com> + * ftp_lib.tcl: Modified to allow multiple concurrent ftps at the same + time. Unfortunately this is incompatible with the old procs. + Rewrite proc headers to be declared outside namespace eval. + Incremented version to 2.0. + +-------------------------- Released 1.2 ----------------------------- + +1999-04-30 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: added new FTP command FTP::Append to append local + files to remote files. + + * ftp_lib.tcl: Added TkCon support to make FTP::List inside TkCon + more readable. + + * ftp_lib.tcl: In some strange cases ftp_lib overlaps the state + machine, to prevent this the state handler disables fileevents on + control socket a the beginning and enables it again at the end + (this failure comes with an earlier release of tkcon, it is only a + debugging feature now and commented). + + * examples/*.tcl: Store the example files in a separate directory. + +-------------------------- Released 1.12 ---------------------------- + +1999-02-28 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: Disabled remote Abort command, it doesn't work. + Insert an internal CloseDataConn command instaed of Abort. + Get/Reget: create local file only if the remote file really + exist. Fix major bug for passive mode that ftp_lib blocks in + every cases if file or directory doesn't exist at the remote + machine, THANKS to Brian Lalo <blalor@hcirisc.cs.binghamton.edu> + for his investigation. Added current namespace prefix to + InitDataConn procedure. + +1999-01-31 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: Changed return values of the FTP::Quote command, + sent back the string it received instead of any parsing THANKS + Keith Vetter <kvetter@us.oracle.com> for his patch. Improved + buffer mechanism in StateHandler, buffer represents the whole + received data. VERBOSE variable controlled output now will be + handled by the package not by the application. New online HTML + help files are available under the directory docs. + +1998-11-30 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: Can now also operate in the passive data transfer + mode, added "PASV" ability for every command that uses data + connection. Improved procedure return codes for a better error + handling. Restore correct type after switching to ascii mode in + FTP::List and FTP::NList. Insert a hook for using a graphical + progress bar that shows the elapsed time. Added new command + FTP::FileSize which gets the file size of the file on the remote + machine. FTP::Newer now is able to compare the modification date + of a remote file with the date of any local file. Enabled DEBUG + variable displays in additional the real FTP commands (old VERBOSE + feature). Signification of the VERBOSE variable is changed, if + enabled it shows the responses from the remote server. Allows to + call FTP::Cd without any parameter. Include some examples in + ftp_lib distribution. + +1998-05-31 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: Fixed a little bug in FTP::Open that makes it not + possible to use this procedure in a proc (upvar #0 ..) + +1998-03-31 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: Non-Blocking I/O of the control channel doesn't + work on Windows, changed to block the I/O channel + +-------------------------- Released 1.0 ----------------------------- + +1998-03-30 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: Complete redesign to handle timeouts after + specified amount of time. Added new FTP command FTP::Quote for + sending verbatim commands to the FTP server THANKS to Ron Zajac + <Ron.Zajac.zajac@nt.com> for inspiration + +-------------------------- Released 0.9 ----------------------------- + +1998-02-28 Steffen Traeger <Steffen.Traeger@t-online.de> + + * ftp_lib.tcl: Uses only the highest-order digit of the 3-digit + reply code for switching in procedure StateHandler. Added new FTP + command FTP::ModTime to show the last modification time of a file + on the remote machine. THANKS to Bill Thorson + <thorson@typhoon.atmos.colostate.edu> for the patch. Added new + FTP command FTP::Newer to get remote file only if it is newer than + local file. DEBUG flag. VERBOSE flag. Added two options for + FTP::Open command: -timeout seconds, sets up timeout; -blocksize + size, writes "size" bytes at once. Procedure DisplayMsg now is + provided to display in different colors. + +0.84 (02/98) +----------- +- FTP commands now runs only if control connection is available +- changed ls-output, removed "total"-line and blank lines from + the list + +0.83 (02/98) +----------- +- changed the FTP::NList command to query data of empty directories +- added new FTP command FTP::Reget to skip over big files after + broken file transfer + THANKS to Paulo da Silva <pdasilva@mail2.esoterica.pt> for help +- specially interpretation of the 421 reply code ("Service + not available, closing control connection"), it is necessary + for reget + +0.82 (12/97) +----------- +- added current namespace prefix to CopyNext procedure, + because of ftp_lib doesn't work correctly with tlc/tk8.0p2 + +0.81 (08/97) +----------- +- replaced tkwait with vwait, this allows only to use + tcl shell for FTP library + +0.8 (07/97) +----------- +- redesigned to support namespace +- added simple installation program +- modified to support the tcl package specification + +0.7 (06/97) +----------- +- changed to tcl/tk version 8.0 +- used the new fcopy command to transfer binary data + +0.6 (02/97) +----------- +- bugfix: close data socket after every data transfer +- added the rename command + +0.5 (02/97) +----------- +- bugfixes +- added directory manipulation commands + +0.4 (02/97) +----------- +- changed to tcl7.6/tk4.2 +- added put/get commands + +0.1 - 0.3 (01/97) +----------------- +- ??? + diff --git a/tcllib/modules/ftp/README b/tcllib/modules/ftp/README new file mode 100644 index 0000000..2591c7a --- /dev/null +++ b/tcllib/modules/ftp/README @@ -0,0 +1,80 @@ +========================= +ftp 2.3 (08/16/2000) +========================= + +files: + + README - this file + ChangeLog - change log + + ftp.tcl - ftp library package + ftpdemo.tcl - ftp test program + pkgIndex.tcl - package index file for ftp package + + example/README - Overview of the example scripts + example/hpupdate.tcl - ftp example "homepage update" + example/mirror.tcl - ftp example "directoy mirror" + example/newer.tcl - ftp example "software update" + + docs/*html - HTML manual pages + +1. Introduction +=============== + +In order to speed up the update of homepage files on the ftp server of +my ISP, in spring of 1996 I looked for a useful solution. In those days +I worked with Linux and used the Linux inside ftp tool. +As fan of Tcl/Tk 'expect' was my next choice. It is excelently +suitabled to control interactive processes like ftp sessions. +A little bit more Tcl/Tk source and hpupdate 0.1 was ready, a script +for the automatical update of homepage files without subdirectories. + +In the beginning of 1997 I was intense employed with RFC 959. +Simultaneous I played with the Tcl socket command. Thus the +FTP library for Tcl was developed... + + +2. Overview +=============== + +The FTP Library Package extends tcl/tk with commands to support the +FTP protocol. The library package is 100% tcl code, no extensions, no +C stuff. It is easily to include in programs with + + package require ftp 2.2 + +Now everybody can write an own ftp program with an own GUI. It works +with Windows, UNIX, and also, but not tested on Mac. The ftp package +makes it comfortable and quick to create small tcl scripts for downloading +files or directory trees. The ftp::Open command creates a session handle for +each connection, and that handle is then used as the first argument to the +rest of the commands. + + Supports the following commands: + + ftp::Open <server> <user> <passwd> + ftp::Close <handle> + ftp::Cd <handle> <directory> + ftp::Pwd <handle> + ftp::Type <handle> <?ascii|binary|tenex?> + ftp::List <handle> <?directory?> + ftp::NList <handle> <?directory?> + ftp::FileSize <handle> <file> + ftp::ModTime <handle> <file> + ftp::Delete <handle> <file> + ftp::Rename <handle> <from> <to> + ftp::Put <handle> <(local | -data "data")> <?remote?> + ftp::Append <handle> <(local | -data "data")> <?remote?> + ftp::Get <handle> <remote> <?(local | -variable varname)?> + ftp::Reget <handle> <remote> <?local?> + ftp::Newer <handle> <remote> <?local?> + ftp::MkDir <handle> <directory> + ftp::RmDir <handle> <directory> + ftp::Quote <handle> <arg1> <arg2> ... + +This new Releases use the new "fcopy" command to transfer binary data +between two channels. There is also a version 0.4 of ftp for +tcl7.6/tk4.2, which works stable using the undocumented command +"unsupported0" for binary data transfer. + + diff --git a/tcllib/modules/ftp/docs/fhelp1.html b/tcllib/modules/ftp/docs/fhelp1.html new file mode 100644 index 0000000..1bc01d9 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp1.html @@ -0,0 +1,126 @@ +<html> +<head> +<title>ftp Library Package 2.2 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Open</b> <em>server user passwd ?options?</em></dd> + <dd> </dd> + <dd> + The <b>ftp::Open</b> command is used to start the FTP session by + establishing a control connection to the FTP server. If no + options are specified, then the defaults are used. + + <p>The <b>ftp::Open</b> command takes a host name <em>server</em>, a user name + <em>user</em> and a password <em>password</em> as its parameters and returns + a session handle that is an integer greater than or equal to 0 if the + connection is successfully established, otherwise it returns "-1".<br> + The <em>server</em> parameter must be the name or internet address (in dotted decimal + notation) of the ftp server. The <em>user</em> and <em>passwd</em> parameters must contain a + valid user name and password to complete the login process.</p> + + The options overwrite some default values or set special + abilities: + + <p><b>-blocksize size</b><dl><dd> + The blocksize is used during data transfer. At most <em>size</em> + bytes are transfered at once. After each block, a call to the "-progress callback" is made. + The default value for this option is 4096.</dd></dl></p> + + <p><b>-timeout seconds</b><dl><dd> + If <em>seconds</em> is non-zero, then <b>ftp::Open</b> sets up a timeout + to occur after the specified number of seconds. The default value is 600.</dd></dl></p> + + <p><b>-port number</b><dl><dd> + The <em>port number</em> specifies an alternative remote port on + the ftp server on which the ftp service resides. Most + ftp services listen for connection requests on default + port 21. Sometimes, usually for security reasons, port + numbers other than 21 are used for ftp connections.</dd></dl></p> + + <p><b>-mode mode</b><dl><dd> + The <em>transfer mode</em> option determines if a file transfer + occurs in an active or passive way. In passive mode the + client session may want to request the ftp Server to + listen for a data port and wait for the connection + rather than initiate the process when a data transfer + request comes in. Passive mode is normally a requirement + when accessing sites via a firewall. The default mode is active.</dd></dl></p> + + <p><b>-progress callback</b><dl><dd> + The <em>callback</em> is made after each transfer of a data + block specified in blocksize. The callback gets as + additional argument the current number of bytes transferred so far. + Here is a template for the progress callback:<br> + + <pre>proc Progress {total} { + puts "$total bytes transfered!" +}</pre></dd></dl></p> + + <p><b>-command callback</b><dl><dd> + Specifying this option puts the connection in asynchronous mode. + The <em>callback</em> is made after each operation has been + completed. The callback gets as an additional argument + a keyword of the operation that has completed plus + additional arguments specific to the operation. + If an error occurs the callback is made with the keyword + "error". When an operation, such as "Cd", "Get", and so on, + has been started no further operations should be started + until a callback has been received for the current + operation. + A template for the callback is:<br> + + <pre>proc Callback {what args} { + puts "Operation $what $args completed" +}</pre></dd></dl></p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre>set server "ftp.server.com" +set user "anonymous" +set passwd "mist@foo.com" + +# define callback +proc Progress {total} { + puts "$total bytes transfered!" +} + +# open a new connection +if {[set conn [ftp::Open $server $user $passwd -progress Progress -blocksize 1024 -mode passive]] == -1} { + puts "Connection refused!" + exit 1 +} + +# get a file +ftp::Get $conn index.html + +# close connection +ftp::Close $conn + </pre> + + </dd> + </dl></dd> + +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Next:</b> <a href="fhelp2.html">ftp::Close</a>] +</p> + +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp10.html b/tcllib/modules/ftp/docs/fhelp10.html new file mode 100644 index 0000000..f1425a8 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp10.html @@ -0,0 +1,54 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Delete</b><em> handle file</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Delete</b> command deletes the specified file on the ftp + server. The command returns 1 if the specified file can be + successfully deleted or 0 if it fails. + + <p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># delete file +if {![ftp::Delete $conn index.htm]} { + puts "File couldn't be deleted!" +} + +# delete all like "rm *" +foreach file [ftp::NList $conn] { + ftp::Delete $conn $file +} + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp9.html">ftp::ModTime</a>] +[<b>Next:</b> <a href="fhelp11.html">ftp::Rename</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp11.html b/tcllib/modules/ftp/docs/fhelp11.html new file mode 100644 index 0000000..adc9440 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp11.html @@ -0,0 +1,52 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Rename</b><em> handle from to</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Rename</b> command renames the file in the current + directory of the ftp server with the specified file name <em>from</em> + to the specified new file name <em>to</em>. This new file name cannot + be the same as any existing subdirectory or file name. + + <p>The command returns 1 if the specified file can be successfully + renamed or 0 if it fails.</p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># rename file +ftp::Rename $conn index.htm index.htm.org + +# with fully qualified path name +ftp::Rename $conn /usr/htdocs/index.htm /usr/htdocs/index.htm.org + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp10.html">ftp::Delete</a>] +[<b>Next:</b> <a href="fhelp12.html">ftp::Put</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp12.html b/tcllib/modules/ftp/docs/fhelp12.html new file mode 100644 index 0000000..f517e65 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp12.html @@ -0,0 +1,58 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Put</b><em> handle (local | -data "data") ?remote?</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Put</b> command stores a local file <em>local</em> to a remote + file <em>remote</em> on the ftp server. The file parameters passed must + contain a fully qualified path name, otherwise the command uses + the current directory. If '-data "data"' is specified, then rather than + transferring a file, the data passed in is used as the data to transfer. + If remote file name is unspecified, the local file name is assigned to + the remote file name. + + <p>If the file was successfully transferred, then the command + returns 1, if it fails 0. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># store unique file name +ftp::Put $conn index.htm + +# store different file names +ftp::Put $conn test.htm index.htm + +# with different fully qualified path name +ftp::Put $conn /usr/local/src/my.tar.gz /incoming/foo.tar.gz + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp11.html">ftp::Rename</a>] +[<b>Next:</b> <a href="fhelp125.html">ftp::Append</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp125.html b/tcllib/modules/ftp/docs/fhelp125.html new file mode 100644 index 0000000..9ce6132 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp125.html @@ -0,0 +1,58 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Append</b><em> handle (local | -data "data") ?remote?</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Append</b> command appends a local file <em>local</em> to an + existing remote file <em>remote</em> on the ftp server. If the file + not exists at the server site, the file shall be created at the server + site. If '-data "data"' is specified, then rather than + transferring a file, the data passed in is used as the data to transfer. +<br> + The file parameters passed must + contain a fully qualified path name, otherwise the command uses + the current directory. If remote file name is unspecified, the + local file name is assigned to the remote file name. + + <p>If the file was successfully transferred, then the command + returns 1, if it fails 0. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># store data +ftp::Put $conn data.log + +# append new data +ftp::Append $conn logfile data.log + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp12.html">ftp::Put</a>] +[<b>Next:</b> <a href="fhelp13.html">ftp::Get</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp13.html b/tcllib/modules/ftp/docs/fhelp13.html new file mode 100644 index 0000000..a6813ea --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp13.html @@ -0,0 +1,62 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Get</b><em> handle remote ?(local | -variable varname)?</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Get</b> command retrieves a remote file <em>remote</em> on the + ftp server to a local file <em>local</em>. If '-variable varname' is + specified, then the variable 'varname' will get the retreived data + stored in it, rather than storing the data in a file. The file + parameters passed must contain a fully qualified path name, otherwise + the command uses the current directory. If local file name is + unspecified, the remote file name is assigned to the remote file name. + + <p>If the file was successfully transferred, then the command + returns 1, if it fails 0. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># retrieve unique file name +ftp::Get $conn index.htm + +# retrieve different file names +ftp::Get $conn index.htm new.htm + +# with different fully qualified path name +if [ftp::Get $conn /incoming/foo.tar.gz /usr/local/src] { + cd /usr/local/src + exec gunzip foo.tar.gz + exec tar xf foo.tar +} + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp125.html">ftp::Append</a>] +[<b>Next:</b> <a href="fhelp14.html">ftp::Reget</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp14.html b/tcllib/modules/ftp/docs/fhelp14.html new file mode 100644 index 0000000..2cc83ca --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp14.html @@ -0,0 +1,51 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Newer</b><em> handle remote ?local?</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Newer</b> command has the same behavior as <b>ftp::Get</b>, except + that it gets the remote file only if the modification time of + the remote file is more recent that the file on the local + system. If the file does not exist on the current system, the + remote file is considered newer. + + <p>If the file was successfully transferred, then the command + returns 1, if it fails 0. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># package update +if {[ftp::Newer $conn /pub/tcl/httpd/tclhttpd.tar.gz /usr/local/src/tclhttpd.tgz]} { + exec echo "New httpd arrived!" | mailx -s ANNOUNCE root +} + </pre> + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp13.html">ftp::Get</a>] +[<b>Next:</b> <a href="fhelp15.html">ftp::Newer</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp15.html b/tcllib/modules/ftp/docs/fhelp15.html new file mode 100644 index 0000000..c03bbbd --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp15.html @@ -0,0 +1,57 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Reget</b><em> handle remote ?local?</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Reget</b> command has the same behavior as <b>ftp::Get</b>, except + that if local file <em>local</em> exists and is smaller than remote + file <em>remote</em>, the local file is presumed to be a partially + transferred copy of the remote file and the transfer is + continued from the apparent point of failure. This command is + useful when transferring very large files over networks that + tend to drop connections. + + <p>If the file was successfully transferred, then the command + returns 1, if it fails 0. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># retrieve a large file name (12 MByte) +ftp::Get $conn foo.tar + +.... after 1 hour and 11.9 transfered MBytes the connection is broken :-( + +# restart file transfer at the broken position and +# retrieve only the remaining 0.1 MByte +ftp::Reget $conn foo.tar + </pre> + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp14.html">ftp::Reget</a>] +[<b>Next:</b> <a href="fhelp16.html">ftp::MkDir</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp16.html b/tcllib/modules/ftp/docs/fhelp16.html new file mode 100644 index 0000000..f893d10 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp16.html @@ -0,0 +1,53 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>FTP Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::MkDir</b><em> handle directory</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::MkDir</b> causes the directory specified in directory to + be created as a directory (if the directory is absolute) or as + a subdirectory of the current working directory (if directory + is relative). + + <p>If the directory was successfully created, then the command + returns 1, if it fails 0. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># create directory +ftp::MkDir $conn /incoming/newdir + +# or +ftp::Cd $conn /incoming +ftp::MkDir $conn newdir + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp15.html">ftp::Newer</a>] +[<b>Next:</b> <a href="fhelp17.html">ftp::RmDir</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp17.html b/tcllib/modules/ftp/docs/fhelp17.html new file mode 100644 index 0000000..38b5c8a --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp17.html @@ -0,0 +1,51 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::RmDir</b><em> handle directory</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::RmDir</b> command removes the specified directory on the + ftp server. The remote directory must be empty. + + <p>The command returns 1 if the specified directory can be successfully + removed or 0 if it fails. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># remove directory +ftp::RmDir $conn /incoming/newdir + +# or +ftp::Cd $conn /incoming +ftp::RmDir $conn newdir + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp16.html">ftp::MkDir</a>] +[<b>Next:</b> <a href="fhelp18.html">ftp::Quote</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp18.html b/tcllib/modules/ftp/docs/fhelp18.html new file mode 100644 index 0000000..3ede807 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp18.html @@ -0,0 +1,52 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Quote</b><em> handle arg1 arg2 ...</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Quote</b> command is used to send the specified arguments + verbatim, as is, to the remote ftp server. This command cannot + be used to obtain a directory listing or for transferring files, + but it can be used for any other ftp commands. It is typically + used to execute commands on the server that are not directly + available from the ftp_lib itself. + + <p>The command sent back the string it received instead of any parsing</p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># change the mode settings on UNIX systems +ftp::Quote $conn site chmod 644 index.htm + +# request supported ftp server commands +puts [ftp::Quote $conn help] + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp17.html">ftp::RmDir</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp2.html b/tcllib/modules/ftp/docs/fhelp2.html new file mode 100644 index 0000000..5f5895b --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp2.html @@ -0,0 +1,57 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Close</b> <em>handle</em></dd> + <dd> </dd> + <dd> + The <b>ftp::Close</b> command terminates the ftp session and if file + transfer is not in progress, the server closes the control + connection. If file transfer is in progress, the connection + will remain open for result response and the server will then + close it. + </dd> + <dd> </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># open a new connection +if {[set conn [ftp::Open ...]] == -1} { + puts "Connection refused!" + exit 1 +} + +# get file +ftp::Get $conn index.html + +# close connection +ftp::Close $conn + </pre> + + </dd> + </dl></dd> + +</dl> +</p> + +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp1.html">ftp::Open</a>] +[<b>Next:</b> <a href="fhelp3.html">ftp::Cd</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp3.html b/tcllib/modules/ftp/docs/fhelp3.html new file mode 100644 index 0000000..15ec010 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp3.html @@ -0,0 +1,54 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::CD</b> <em>handle</em> <em>directory</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Cd</b> command changes the current working directory on + the ftp server to a specified target directory. This target + directory can be a subdirectory of the current directory, ".." + (for the parent directory) or a fully qualified path to a new + working directory. + + <p>The command returns 1 if the current working directory can be + successfully changed to the specified directory or 0 if it fails.</p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># change directory +ftp::Cd $conn pub/tcl +ftp::Cd $conn .. + + </pre> + + </dd> + </dl></dd> + +</dl> +</p> + +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp2.html">ftp::Close</a>] +[<b>Next:</b> <a href="fhelp4.html">ftp::Pwd</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp4.html b/tcllib/modules/ftp/docs/fhelp4.html new file mode 100644 index 0000000..9131d54 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp4.html @@ -0,0 +1,47 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Pwd</b> <em>handle</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Pwd</b> command gets the complete path of the current + working directory on the ftp server or an empty string if an + error occurs. + + <p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># get directory path +set current_path [ftp::Pwd $conn] + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp3.html">ftp::Cd</a>] +[<b>Next:</b> <a href="fhelp5.html">ftp::Type</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp5.html b/tcllib/modules/ftp/docs/fhelp5.html new file mode 100644 index 0000000..581dfa3 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp5.html @@ -0,0 +1,57 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::Type</b><em> handle ?ascii|binary?</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::Type</b> command sets the ftp file transfer type either + to <em>ascii</em>, <em>binary</em>, or to <em>tenex</em>. In every + case, also if the type name is unspecified, it returns the current type. + + <p>Only <b>ascii</b> and <b>binary</b> types are currently supported. + There is some early (alhpa) support for Tenex mode. The ascii + type is normally used to convert text files to a format suitable + for text editors on the platform depended destination machine. + The binary type allows undisturbed transfers of non-text files, + such as compressed files, images and executables. </p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># get file transfer type +set current_type [ftp::Type $conn] + +# set file transfer type +ftp::Type $conn ascii + + + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp4.html">ftp::Pwd</a>] +[<b>Next:</b> <a href="fhelp6.html">ftp::List</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp6.html b/tcllib/modules/ftp/docs/fhelp6.html new file mode 100644 index 0000000..dc8b19d --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp6.html @@ -0,0 +1,74 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::List</b><em> handle ?directory?</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::List</b> command lists the contents of the current remote + directory or if the directory parameter is specified a directory + or other group of files. Also wildcard expression, such as + "*.tcl", can be specified. The directory or file name must be + fully qualified, otherwise the it takes entries in the current + remote directory. + + <p>The listing includes any system-dependent information that the + server chooses to include; for example, most UNIX systems + produce output from the command "ls -l". <b>ftp::List</b> returns + these information as a <b>tcl list</b> with one line for every entry. + Empty lines and UNIX's "total" lines are ignored. So it should + offer only usable informations.</p> + + <p>If the command fails an empty list is returned.</p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># list current directory +foreach line [ftp::List $conn] + puts $line +} + +# list only tcl files +foreach line [ftp::List $conn *.tcl] + puts $line +} + +# list specified directory +set dir_list [ftp::List $conn /pub/usr/lib] + +# list if directory exist +if {[ftp::Cd $conn /pub/usr/lib]} { + set dir_list [ftp::List $conn] +} else { + puts "Directory doesn't exist!" +} + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp5.html">ftp::Type</a>] +[<b>Next:</b> <a href="fhelp7.html">ftp::NList</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp7.html b/tcllib/modules/ftp/docs/fhelp7.html new file mode 100644 index 0000000..548b20f --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp7.html @@ -0,0 +1,48 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::NList</b><em> handle ?directory?</em></dd> + <dd> </dd> + <dd> + + This command has the same behavior as previous <b>ftp::List</b> command, except that it + only gets a abbreviated listing. This means only file names are + returned in a sorted list. + + <p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># list current directory +set file_names [ftp::NList $conn] + + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp6.html">ftp::List</a>] +[<b>Next:</b> <a href="fhelp8.html">ftp::FileSize</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp8.html b/tcllib/modules/ftp/docs/fhelp8.html new file mode 100644 index 0000000..185dec3 --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp8.html @@ -0,0 +1,50 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::FileSize</b><em> handle file</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::FileSize</b> command gets the file size of the specified + file on the ftp server.<br> <b><font color="#ff0000">ATTENTION!</font></b> It doesn't work properly in + ascci mode and isn't supported by all ftp server implementations. + + <p>If the command fails an empty string is returned.</p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># get file size +set old_type [ftp::Type $conn] +ftp::Type $conn binary +set size [ftp::FileSize $conn index.htm] +ftp::Type $conn $old_type + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp7.html">ftp::NList</a>] +[<b>Next:</b> <a href="fhelp9.html">ftp::ModTime</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/fhelp9.html b/tcllib/modules/ftp/docs/fhelp9.html new file mode 100644 index 0000000..2952bab --- /dev/null +++ b/tcllib/modules/ftp/docs/fhelp9.html @@ -0,0 +1,49 @@ +<html> +<head> +<title>ftp Library Package 2.1 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>COMMAND</b></font></dd> + <dd><dl> + <dd><b>ftp::ModTime</b><em> handle file</em></dd> + <dd> </dd> + <dd> + + The <b>ftp::ModTime</b> command gets the last modification time of the + file on the ftp server as a system dependent integer value in + seconds (see tcl's clock command) or an empty string in error cases. + + <p> + + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>EXAMPLE</b></font></dd> + <dd><dl> + <dd> + <pre># get modification time +puts [clock format [ftp::ModTime $conn index.htm]] + +set year [clock format [ftp::ModTime $conn index.htm] -format %y] + </pre> + + </dd> + </dl></dd> +</dl> +</p> +<p> +[<a href="index.html">Contents</a>] +[<b>Previous:</b> <a href="fhelp8.html">ftp::FileSize</a>] +[<b>Next:</b> <a href="fhelp10.html">ftp::Delete</a>] +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> diff --git a/tcllib/modules/ftp/docs/index.html b/tcllib/modules/ftp/docs/index.html new file mode 100644 index 0000000..012727c --- /dev/null +++ b/tcllib/modules/ftp/docs/index.html @@ -0,0 +1,107 @@ +<html> +<head> +<title>ftp Library Package 2.2 for Tcl/Tk help file</title> +</head> +<body bgcolor="#ffffff" text="#000000"> +<body> + +<p> +<dl> + <dd> + <p><font face="Arial,Helvetica" color="#526e9c" size="+2"><b>ftp Library Package 2.1 for Tcl/Tk Manual Pages</b></font></p> + </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>NAME</b></font></dd> + <dd><dl> + <dd><b>ftp - Client-side tcl implementation of the ftp protocol</b></dd> + </dl></dd> + <dd> </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>SYNOPSIS</b></font></dd> + <dd><dl> + <dd><b>package require ftp ?2.2?</b></dd> + <dd> </dd> + <dd><b>ftp::<a href="fhelp1.html">Open</b><em> server user passwd ?options?</em></a></dd> + <dd><b>ftp::<a href="fhelp2.html">Close</b><em> handle</em></a></dd> + <dd><b>ftp::<a href="fhelp3.html">Cd</b><em> handle directory</em></a></dd> + <dd><b>ftp::<a href="fhelp4.html">Pwd</b><em> handle</em></a></dd> + <dd><b>ftp::<a href="fhelp5.html">Type</b><em> handle ?ascii|binary|tenex?</em></a></dd> + <dd><b>ftp::<a href="fhelp6.html">List</b><em> handle ?directory?</em></a></dd> + <dd><b>ftp::<a href="fhelp7.html">NList</b><em> handle ?directory?</em></a></dd> + <dd><b>ftp::<a href="fhelp8.html">FileSize</b><em> handle file</em></a></dd> + <dd><b>ftp::<a href="fhelp9.html">ModTime</b><em> handle from to</em></a></dd> + <dd><b>ftp::<a href="fhelp10.html">Delete</b><em> handle file</em></a></dd> + <dd><b>ftp::<a href="fhelp11.html">Rename</b><em> handle from to</em></a></dd> + <dd><b>ftp::<a href="fhelp12.html">Put</b><em> handle (local | -data "data") ?remote?</em></a></dd> + <dd><b>ftp::<a href="fhelp125.html">Append</b><em> handle (local | -data "data") ?remote?</em></a></dd> + <dd><b>ftp::<a href="fhelp13.html">Get</b><em> handle remote ?(local | -variable varname)?</em></a></dd> + <dd><b>ftp::<a href="fhelp14.html">Reget</b><em> handle remote ?local?</em></a></dd> + <dd><b>ftp::<a href="fhelp15.html">Newer</b><em> handle remote ?local?</em></a></dd> + <dd><b>ftp::<a href="fhelp16.html">MkDir</b><em> handle directory</em></a></dd> + <dd><b>ftp::<a href="fhelp17.html">RmDir</b><em> handle directory</em></a></dd> + <dd><b>ftp::<a href="fhelp18.html">Quote</b><em> handle arg1 arg2 ...</em></a></dd> + <dd><b>ftp::DisplayMsg</b><em> handle msg ?state? </em></dd> + <dd> </dd> + <dd>variable <b>ftp::VERBOSE</b></dd> + <dd>variable <b>ftp::DEBUG</b></dd> + </dl></dd> + <dd> </dd> + + <dd><font face="Arial,Helvetica" size="+1"><b>DESCRIPTION</b></font></dd> + <dd><dl> + <dd> + The ftp library package provides the client side of the ftp protocol. + The package implements active (default) and passive ftp sessions. + + <p>A new ftp session is started with the Open</b> command. Quitting an + existing ftp session is done by Close</b>. All other commands can + only be used in an opened ftp session else an error will occured. + The ftp package includes file and directory manipulating commands for + remote sites. To do the same stuff to the local site the built-in tcl + commands like "cd" or "file <em>command</em>" are the best choice.</p> + + Two state variables controls the output of ftp. Setting VERBOSE</b> + to "1" forces to show all responses from the remote server. The default value is "0". + Setting DEBUG</b> to "1" enables debugging to show all the return code, states + and "real" ftp commands. The default value is "0". + + <p>The procedure <b>DisplayMsg</b> is used to show the different messages from + the ftp session. It is simple declared in ftp and must be overwritten + by the programmer to make it more comfortable. A state variable for different + states assigned to different colors is recommended by the author. For + example:</p> + + <pre>.msg.text tag configure error -foreground red +.msg.text tag configure data -foreground brown +.msg.text tag configure control -foreground blue + +namespace ftp { + proc DisplayMsg {s msg {state ""}} { + switch $state { + data {.msg.text insert end "$msg\n" data} + control {.msg.text insert end "$msg\n" control} + error {.msg.f.text insert end "$msg\n" error} + } + } +}</pre> + </dd> + </dl></dd> + + <dd><font face="Arial,Helvetica" size="+1" color="##ff0000"><b>BUGS</b></font></dd> + <dd><dl> + <dd> + Correct execution of many commands depends upon proper behavior by the remote server, network + and router configuration.<p> + + An update command placed in the procedure DisplayMsg run into persistent errors or infinite loops. + The solution to this problem is to use "update idletasks", rather than a single update. + </dd> + </dl></dd> + +</dl> +</p> +<p align="left"><hr noshade size="1"><font face="Arial,Helvetica" size="-1">© 1999 <a href="mailto:Steffen.Traeger@t-online.de">Steffen Traeger</a></font></p> +</body> +</html> + + diff --git a/tcllib/modules/ftp/ftp.man b/tcllib/modules/ftp/ftp.man new file mode 100644 index 0000000..72118ec --- /dev/null +++ b/tcllib/modules/ftp/ftp.man @@ -0,0 +1,440 @@ +[comment {-*- tcl -*- doctools manpage}] +[vset PACKAGE_VERSION 2.4.13] +[manpage_begin ftp n [vset PACKAGE_VERSION]] +[see_also ftpd] +[see_also mime] +[see_also pop3] +[see_also smtp] +[keywords ftp] +[keywords internet] +[keywords net] +[keywords {rfc 959}] +[moddesc {ftp client}] +[titledesc {Client-side tcl implementation of the ftp protocol}] +[category Networking] +[require Tcl 8.2] +[require ftp [opt [vset PACKAGE_VERSION]]] +[description] + +[para] + +The ftp package provides the client side of the ftp protocol as +specified in RFC 959 ([uri http://www.rfc-editor.org/rfc/rfc959.txt]). +The package implements both active (default) and passive ftp sessions. + +[para] + +A new ftp session is started with the [cmd ::ftp::Open] command. To +shutdown an existing ftp session use [cmd ::ftp::Close]. All other +commands are restricted to usage in an an open ftp session. They will +generate errors if they are used out of context. The ftp package +includes file and directory manipulating commands for remote sites. To +perform the same operations on the local site use commands built into +the core, like [cmd cd] or [cmd file]. + +[para] + +The output of the package is controlled by two state variables, + +[var ::ftp::VERBOSE] and [var ::ftp::DEBUG]. Setting + +[var ::ftp::VERBOSE] to "1" forces the package to show all responses +from a remote server. The default value is "0". Setting + +[var ::ftp::DEBUG] to "1" enables debugging and forces the package to +show all return codes, states, state changes and "real" ftp +commands. The default value is "0". + +[para] + +The command [cmd ::ftp::DisplayMsg] is used to show the different +messages from the ftp session. The setting of [var ::ftp::VERBOSE] +determines if this command is called or not. The current +implementation of the command uses the [package log] package of tcllib +to write the messages to their final destination. This means that the +behaviour of [cmd ::ftp::DisplayMsg] can be customized without +changing its implementation. For more radical changes overwriting its +implementation by the application is of course still possible. Note +that the default implementation honors the option [option -output] to + +[cmd ::ftp::Open] for a session specific log command. + +[para] + +[emph Caution]: The default implementation logs error messages like +all other messages. If this behaviour is changed to throwing an error +instead all commands in the API will change their behaviour too. In +such a case they will not return a failure code as described below but +pass the thrown error to their caller. + +[section API] + +[list_begin definitions] + +[call [cmd ::ftp::Open] [arg server] [arg user] [arg passwd] [opt [arg options]]] + +This command is used to start a FTP session by establishing a control +connection to the FTP server. The defaults are used for any option not +specified by the caller. + +[para] + +The command takes a host name [arg server], a user name [arg user] and +a password [arg password] as its parameters and returns a session +handle that is an integer number greater than or equal to "0", if the +connection is successfully established. Otherwise it returns "-1". +The [arg server] parameter must be the name or internet address (in +dotted decimal notation) of the ftp server to connect to. The + +[arg user] and [arg passwd] parameters must contain a valid user name +and password to complete the login process. + +[para] + +The options overwrite some default values or set special abilities: + +[list_begin definitions] + +[def "[option -blocksize] [arg size]"] + +The blocksize is used during data transfer. At most [arg size] bytes +are transfered at once. The default value for this option is 4096. +The package will evaluate the [cmd {-progress callback}] for the +session after the transfer of each block. + +[def "[option -timeout] [arg seconds]"] + +If [arg seconds] is non-zero, then [cmd ::ftp::Open] sets up a timeout +which will occur after the specified number of seconds. The default +value is 600. + +[def "[option -port] [arg number]"] + +The port [arg number] specifies an alternative remote port on the ftp +server on which the ftp service resides. Most ftp services listen for +connection requests on the default port 21. Sometimes, usually for +security reasons, port numbers other than 21 are used for ftp +connections. + +[def "[option -mode] [arg mode]"] + +The transfer [arg mode] option determines if a file transfer occurs in +[const active] or [const passive] mode. In passive mode the client +will ask the ftp server to listen on a data port and wait for the +connection rather than to initiate the process by itself when a data +transfer request comes in. Passive mode is normally a requirement when +accessing sites via a firewall. The default mode is [const active]. + +[def "[option -progress] [arg callback]"] + +This [arg callback] is evaluated whenever a block of data was +transfered. See the option [option -blocksize] for how to specify the +size of the transfered blocks. + +[para] + +When evaluating the [arg callback] one argument is appended to the +callback script, the current accumulated number of bytes transferred +so far. + +[def "[option -command] [arg callback]"] + +Specifying this option places the connection into asynchronous +mode. The [arg callback] is evaluated after the completion of any +operation. When an operation is running no further operations must be +started until a callback has been received for the currently executing +operation. + +[para] + +When evaluating the [arg callback] several arguments are appended to +the callback script, namely the keyword of the operation that has +completed and any additional arguments specific to the operation. If +an error occurred during the execution of the operation the callback is +given the keyword [const error]. + +[def "[option -output] [arg callback]"] + +This option has no default. If it is set the default implementation of +[cmd ::ftp::DisplayMsg] will use its value as command prefix to log +all internal messages. The callback will have three arguments appended +to it before evaluation, the id of the session, the message itself, +and the connection state, in this order. + +[list_end] + +[call [cmd ::ftp::Close] [arg handle]] + +This command terminates the specified ftp session. If no file transfer +is in progress, the server will close the control connection +immediately. If a file transfer is in progress however, the control +connection will remain open until the transfers completes. When that +happens the server will write the result response for the transfer to +it and close the connection afterward. + +[call [cmd ::ftp::Cd] [arg handle] [arg directory]] + +This command changes the current working directory on the ftp server +to a specified target [arg directory]. The command returns 1 if the +current working directory was successfully changed to the specified +directory or 0 if it fails. The target directory can be + +[list_begin itemized] +[item] + +a subdirectory of the current directory, + +[item] + +Two dots, [const ..] (as an indicator for the parent directory of +the current directory) + +[item] + +or a fully qualified path to a new working directory. + +[list_end] + +[call [cmd ::ftp::Pwd] [arg handle]] + +This command returns the complete path of the current working +directory on the ftp server, or an empty string in case of an error. + +[call [cmd ::ftp::Type] [arg handle] [opt [const ascii|binary|tenex]]] + +This command sets the ftp file transfer type to either [const ascii], +[const binary], or [const tenex]. The command always returns the +currently set type. If called without type no change is made. + +[para] + +Currently only [const ascii] and [const binary] types are +supported. There is some early (alpha) support for Tenex mode. The +type [const ascii] is normally used to convert text files into a +format suitable for text editors on the platform of the destination +machine. This mainly affects end-of-line markers. The type + +[const binary] on the other hand allows the undisturbed transfer of +non-text files, such as compressed files, images and executables. + +[call [cmd ::ftp::List] [arg handle] [opt [arg pattern]]] + +This command returns a human-readable list of files. Wildcard +expressions such as [file *.tcl] are allowed. If [arg pattern] +refers to a specific directory, then the contents of that directory +are returned. If the [arg pattern] is not a fully-qualified path +name, the command lists entries relative to the current remote +directory. If no [arg pattern] is specified, the contents of the +current remote directory is returned. + +[para] + +The listing includes any system-dependent information that the server +chooses to include. For example most UNIX systems produce output from +the command [syscmd {ls -l}]. The command returns the retrieved +information as a tcl list with one item per entry. Empty lines and +UNIX's "total" lines are ignored and not included in the result as +reported by this command. + +[para] + +If the command fails an empty list is returned. + +[call [cmd ::ftp::NList] [arg handle] [opt [arg directory]]] + +This command has the same behavior as the [cmd ::ftp::List] command, +except that it only retrieves an abbreviated listing. This means only +file names are returned in a sorted list. + +[call [cmd ::ftp::FileSize] [arg handle] [arg file]] + +This command returns the size of the specified [arg file] on the ftp +server. If the command fails an empty string is returned. + +[para] + +[emph ATTENTION!] It will not work properly when in ascii mode and +is not supported by all ftp server implementations. + +[call [cmd ::ftp::ModTime] [arg handle] [arg file]] + +This command retrieves the time of the last modification of the + +[arg file] on the ftp server as a system dependent integer value in +seconds or an empty string if an error occurred. Use the built-in +command [cmd clock] to convert the retrieves value into other formats. + +[call [cmd ::ftp::Delete] [arg handle] [arg file]] + +This command deletes the specified [arg file] on the ftp server. The +command returns 1 if the specified file was successfully deleted or 0 +if it failed. + +[call [cmd ::ftp::Rename] [arg handle] [arg from] [arg to]] + +This command renames the file [arg from] in the current directory of +the ftp server to the specified new file name [arg to]. This new file +name must not be the same as any existing subdirectory or file name. +The command returns 1 if the specified file was successfully renamed +or 0 if it failed. + +[call [cmd ::ftp::Put] [arg handle] ([arg local] | -data [arg data] | -channel [arg chan]) [opt [arg remote]]] + +This command transfers a local file [arg local] to a remote file + +[arg remote] on the ftp server. If the file parameters passed to the +command do not fully qualified path names the command will use the +current directory on local and remote host. If the remote file name is +unspecified, the server will use the name of the local file as the +name of the remote file. The command returns 1 to indicate a successful +transfer and 0 in the case of a failure. + +[para] + +If [option -data] [arg data] is specified instead of a local file, the +system will not transfer a file, but the [arg data] passed into it. In +this case the name of the remote file has to be specified. + +[para] + +If [option -channel] [arg chan] is specified instead of a local file, +the system will not transfer a file, but read the contents of the +channel [arg chan] and write this to the remote file. In this case the +name of the remote file has to be specified. After the transfer + +[arg chan] will be closed. + +[call [cmd ::ftp::Append] [arg handle] ([arg local] | -data [arg data] | -channel [arg chan]) [opt [arg remote]]] + +This command behaves like [cmd ::ftp::Puts], but appends the +transfered information to the remote file. If the file did not exist +on the server it will be created. + +[call [cmd ::ftp::Get] [arg handle] [arg remote] [opt "([arg local] | -variable [arg varname] | -channel [arg chan])"]] + +This command retrieves a remote file [arg remote] on the ftp server +and stores its contents into the local file [arg local]. If the file +parameters passed to the command are not fully qualified path names +the command will use the current directory on local and remote +host. If the local file name is unspecified, the server will use the +name of the remote file as the name of the local file. The command +returns 1 to indicate a successful transfer and 0 in the case of a +failure. The command will throw an error if the directory the file +[arg local] is to be placed in does not exist. + +[para] + +If [option -variable] [arg varname] is specified, the system will +store the retrieved data into the variable [arg varname] instead of a +file. + +[para] + +If [option -channel] [arg chan] is specified, the system will write +the retrieved data into the channel [arg chan] instead of a file. The +system will [emph not] close [arg chan] after the transfer, this is +the responsibility of the caller to [cmd ::ftp::Get]. + +[call [cmd ::ftp::Reget] [arg handle] [arg remote] [opt [arg local]] [opt [arg from]] [opt [arg to]]] + +This command behaves like [cmd ::ftp::Get], except that if local file +[arg local] exists and is smaller than remote file [arg remote], the +local file is presumed to be a partially transferred copy of the +remote file and the transfer is continued from the apparent point of +failure. The command will throw an error if the directory the file +[arg local] is to be placed in does not exist. This command is useful +when transferring very large files over networks that tend to drop +connections. + +[para] + +Specifying the additional byte offsets [arg from] and [arg to] will +cause the command to change its behaviour and to download exactly the +specified slice of the remote file. This mode is possible only if a +local destination is explicitly provided. Omission of [arg to] leads +to downloading till the end of the file. + +[call [cmd ::ftp::Newer] [arg handle] [arg remote] [opt [arg local]]] + +This command behaves like [cmd ::ftp::Get], except that it retrieves +the remote file only if the modification time of the remote file is +more recent than the file on the local system. If the file does not +exist on the local system, the remote file is considered newer. The +command will throw an error if the directory the file [arg local] is +to be placed in does not exist. + +[call [cmd ::ftp::MkDir] [arg handle] [arg directory]] + +This command creates the specified [arg directory] on the ftp +server. If the specified path is relative the new directory will be +created as a subdirectory of the current working directory. Else the +created directory will have the specified path name. The command +returns 1 to indicate a successful creation of the directory and 0 in +the case of a failure. + +[call [cmd ::ftp::RmDir] [arg handle] [arg directory]] + +This command removes the specified directory on the ftp server. The +remote directory has to be empty or the command will fail. The command +returns 1 to indicate a successful removal of the directory and 0 in +the case of a failure. + +[call [cmd ::ftp::Quote] [arg handle] [arg arg1] [arg arg2] [arg ...]] + +This command is used to send an arbitrary ftp command to the +server. It cannot be used to obtain a directory listing or for +transferring files. It is included to allow an application to execute +commands on the ftp server which are not provided by this package. +The arguments are sent verbatim, i.e. as is, with no changes. + +[para] + +In contrast to the other commands in this package this command will +not parse the response it got from the ftp server but return it +verbatim to the caller. + +[call [cmd ::ftp::DisplayMsg] [arg handle] [arg msg] [opt [arg state]]] + +This command is used by the package itself to show the different +messages from the ftp sessions. The package itself declares this +command very simple, writing the messages to [const stdout] (if + +[var ::ftp::VERBOSE] was set, see below) and throwing tcl errors for +error messages. It is the responsibility of the application to +overwrite it as needed. A state variable for different states assigned +to different colors is recommended by the author. The package + +[package log] is useful for this. + +[def [var ::ftp::VERBOSE]] + +A state variable controlling the output of the package. Setting + +[var ::ftp::VERBOSE] to "1" forces the package to show all responses +from a remote server. The default value is "0". + +[def [var ::ftp::DEBUG]] + +A state variable controlling the output of ftp. Setting + +[var ::ftp::DEBUG] to "1" enables debugging and forces the package to +show all return codes, states, state changes and "real" ftp +commands. The default value is "0". + +[list_end] + +[section BUGS] +[para] + +The correct execution of many commands depends upon the proper +behavior by the remote server, network and router configuration. + +[para] + +An update command placed in the procedure [cmd ::ftp::DisplayMsg] may +run into persistent errors or infinite loops. The solution to this +problem is to use [cmd {update idletasks}] instead of [cmd update]. + +[vset CATEGORY ftp] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/ftp/ftp.tcl b/tcllib/modules/ftp/ftp.tcl new file mode 100644 index 0000000..f5f13c7 --- /dev/null +++ b/tcllib/modules/ftp/ftp.tcl @@ -0,0 +1,3159 @@ +# ftp.tcl -- +# +# FTP library package for Tcl 8.2+. Originally written by Steffen +# Traeger (Steffen.Traeger@t-online.de); modified by Peter MacDonald +# (peter@pdqi.com) to support multiple simultaneous FTP sessions; +# Modified by Steve Ball (Steve.Ball@zveno.com) to support +# asynchronous operation. +# +# Copyright (c) 1996-1999 by Steffen Traeger <Steffen.Traeger@t-online.de> +# Copyright (c) 2000 by Ajuba Solutions +# Copyright (c) 2000 by Zveno Pty Ltd +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: ftp.tcl,v 1.50 2011/08/09 20:57:01 andreas_kupries Exp $ +# +# core ftp support: ftp::Open <server> <user> <passwd> <?options?> +# ftp::Close <s> +# ftp::Cd <s> <directory> +# ftp::Pwd <s> +# ftp::Type <s> <?ascii|binary|tenex?> +# ftp::List <s> <?directory?> +# ftp::NList <s> <?directory?> +# ftp::FileSize <s> <file> +# ftp::ModTime <s> <file> <?newtime?> +# ftp::Delete <s> <file> +# ftp::Rename <s> <from> <to> +# ftp::Put <s> <(local | -data "data" -channel chan)> <?remote?> +# ftp::Append <s> <(local | -data "data" | -channel chan)> <?remote?> +# ftp::Get <s> <remote> <?(local | -variable varname | -channel chan)?> +# ftp::Reget <s> <remote> <?local?> +# ftp::Newer <s> <remote> <?local?> +# ftp::MkDir <s> <directory> +# ftp::RmDir <s> <directory> +# ftp::Quote <s> <arg1> <arg2> ... +# +# Internal documentation. Contents of a session state array. +# +# --------------------------------------------- +# key value +# --------------------------------------------- +# State Current state of the session and the currently executing command. +# RemoteFileName Name of the remote file, for put/get +# LocalFileName Name of local file, for put/get +# inline 1 - Put/Get is inline (from data, to variable) +# filebuffer +# PutData Data to move when inline +# SourceCI Channel to read from, "Put" +# --------------------------------------------- +# + +package require Tcl 8.2 +package require log ; # tcllib/log, general logging facility. + +namespace eval ::ftp { + namespace export DisplayMsg Open Close Cd Pwd Type List NList \ + FileSize ModTime Delete Rename Put Append Get Reget \ + Newer Quote MkDir RmDir + + variable serial 0 + variable VERBOSE 0 + variable DEBUG 0 +} + +############################################################################# +# +# DisplayMsg -- +# +# This is a simple procedure to display any messages on screen. +# Can be intercepted by the -output option to Open +# +# namespace ftp { +# proc DisplayMsg {msg} { +# ...... +# } +# } +# +# Arguments: +# msg - message string +# state - different states {normal, data, control, error} +# +proc ::ftp::DisplayMsg {s msg {state ""}} { + + upvar ::ftp::ftp$s ftp + + if { ([info exists ftp(Output)]) && ($ftp(Output) != "") } { + eval [concat $ftp(Output) {$s $msg $state}] + return + } + + # FIX #476729. Instead of changing the documentation this + # procedure is changed to enforce the documented + # behaviour. IOW, this procedure will not throw + # errors anymore. At the same time printing to stdout + # is exchanged against calls into the 'log' module + # tcllib, which is much easier to customize for the + # needs of any application using the ftp module. The + # variable VERBOSE is still relevant as it controls + # whether this procedure is called or not. + + global errorInfo + switch -exact -- $state { + error {log::log error "$state | $msg"} + default {log::log debug "$state | $msg"} + } + return +} + +############################################################################# +# +# Timeout -- +# +# Handle timeouts +# +# Arguments: +# - +# +proc ::ftp::Timeout {s} { + upvar ::ftp::ftp$s ftp + variable VERBOSE + + if {$VERBOSE} { DisplayMsg $s Waiting|Timeout! } + + after cancel $ftp(Wait) + set ftp(state.control) 1 + + DisplayMsg "" "Timeout of control connection after $ftp(Timeout) sec.!" error + Command $ftp(Command) timeout + return +} + +############################################################################# +# +# WaitOrTimeout -- +# +# Blocks the running procedure and waits for a variable of the transaction +# to complete. It continues processing procedure until a procedure or +# StateHandler sets the value of variable "finished". +# If a connection hangs the variable is setting instead of by this procedure after +# specified seconds in $ftp(Timeout). +# +# +# Arguments: +# - +# + +proc ::ftp::WaitOrTimeout {s} { + upvar ::ftp::ftp$s ftp + variable VERBOSE + + set retvar 1 + + if { ![string length $ftp(Command)] && [info exists ftp(state.control)] } { + + if {$VERBOSE} { DisplayMsg $s Waiting|$ftp(Timeout)|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# } + + set ftp(Wait) [after [expr {$ftp(Timeout) * 1000}] [list [namespace current]::Timeout $s]] + + vwait ::ftp::ftp${s}(state.control) + set retvar $ftp(state.control) + + if {$VERBOSE} { DisplayMsg $s Waiting|Done|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# } + } + + if {$ftp(Error) != ""} { + set errmsg $ftp(Error) + set ftp(Error) "" + DisplayMsg $s $errmsg error + } + + if {$VERBOSE} { DisplayMsg $s Waiting|OK|$retvar } + return $retvar +} + +############################################################################# +# +# WaitComplete -- +# +# Transaction completed. +# Cancel execution of the delayed command declared in procedure WaitOrTimeout. +# +# Arguments: +# value - result of the transaction +# 0 ... Error +# 1 ... OK +# + +proc ::ftp::WaitComplete {s value} { + variable VERBOSE + upvar ::ftp::ftp$s ftp + + if {$VERBOSE} { DisplayMsg $s Waiting|Complete|$s|$value|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# } + + if {![info exists ftp(Command)]} { + set ftp(state.control) $value + + if {$VERBOSE} { DisplayMsg $s Waiting|Complete|Done/Command|$value|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# } + return $value + } + if { ![string length $ftp(Command)] && [info exists ftp(state.data)] } { + + if {$VERBOSE} { DisplayMsg $s Waiting|State|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# } + + vwait ::ftp::ftp${s}(state.data) + + if {$VERBOSE} { DisplayMsg $s Waiting|State|Done|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# } + } + + catch {after cancel $ftp(Wait)} + set ftp(state.control) $value + + if {$VERBOSE} { DisplayMsg $s Waiting|OK|$ftp(state.control)|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# } + + return $ftp(state.control) +} + +############################################################################# +# +# PutsCtrlSocket -- +# +# Puts then specified command to control socket, +# if DEBUG is set than it logs via DisplayMsg +# +# Arguments: +# command - ftp command +# + +proc ::ftp::PutsCtrlSock {s {command ""}} { + upvar ::ftp::ftp$s ftp + variable DEBUG + + if { $DEBUG } { + DisplayMsg $s "---> $command" + } + + puts $ftp(CtrlSock) $command + flush $ftp(CtrlSock) + return +} + +############################################################################# +# +# StateHandler -- +# +# Implements a finite state handler and a fileevent handler +# for the control channel +# +# Arguments: +# sock - socket name +# If called from a procedure than this argument is empty. +# If called from a fileevent than this argument contains +# the socket channel identifier. + +proc ::ftp::StateHandler {s {sock ""}} { + upvar ::ftp::ftp$s ftp + variable DEBUG + variable VERBOSE + + if {$VERBOSE} { DisplayMsg $s StateHandler/$s/$sock/================================================ } + + # disable fileevent on control socket, enable it at the and of the state machine + # fileevent $ftp(CtrlSock) readable {} + + # there is no socket (and no channel to get) if called from a procedure + + set rc " " + set msgtext {} + + if { $sock != "" } { + + set number 0 ;# Error condition + catch {set number [gets $sock bufline]} + + if { $number > 0 } { + + # get return code, check for multi-line text + + if {![regexp -- "^-?(\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line msgtext]} { + set errmsg "C: Internal Error @ line 255.\ + Regex pattern not matching the input \"$bufline\"" + if {$VERBOSE} { + DisplayMsg $s $errmsg control + } + } else { + # multi-line format detected ("-"), get all the lines + # until the real return code + + set buffer $bufline + + while { [string equal $multi_line "-"] } { + set number [gets $sock bufline] + if { $number > 0 } { + append buffer \n "$bufline" + regexp -- "(^\[0-9\]+)( |-)?(.*)$" $bufline all rc multi_line + # multi_line is not set if the bufline does not match the regexp, + # I.e. this keeps the '-' which started this around until the + # closing line does match and sets it to space. + } elseif {$number == -1 && [eof $sock]} { + # The reply indicated a multi-line reply, but the + # socket was closed and there were no more lines. + # In that case, keep the current return values. + + # This means the server isn't speaking strict rfc959. + # see section on multi-line replies + break + } + } + + # Export the accumulated response. [Bug 1191607]. + set msgtext $buffer + } + } elseif { [eof $ftp(CtrlSock)] } { + # remote server has closed control connection. kill + # control socket, unset State to disable all following + # commands. Killing the socket is done before + # 'WaitComplete' to prevent it from recursively entering + # this code, overflowing the stack (socket still existing, + # still readable, still eof). [SF Tcllib Bug 15822535]. + + set rc 421 + catch {close $ftp(CtrlSock)} + catch {unset ftp(CtrlSock)} + catch {unset ftp(state.data)} + if { $VERBOSE } { + DisplayMsg $s "C: 421 Service not available, closing control connection." control + } + if {![string equal $ftp(State) "quit_sent"]} { + set ftp(Error) "Service not available!" + } + CloseDataConn $s + WaitComplete $s 0 + Command $ftp(Command) terminated + catch {unset ftp(State)} + + if {$VERBOSE} { DisplayMsg $s EOF/Control } + return + } else { + # Fix SF bug #466746: Incomplete line, do nothing. + if {$VERBOSE} { DisplayMsg $s Incomplete/Line } + return + } + } + + if { $DEBUG } { + DisplayMsg $s "-> rc=\"$rc\" -> msgtext=\"$msgtext\" -> state=\"$ftp(State)\"" + } + + # In asynchronous mode, should we move on to the next state? + set nextState 0 + + # system status replay + if { [string equal $rc "211"] } { + if {$VERBOSE} { DisplayMsg $s Ignore/211 } + return + } + + # use only the first digit + regexp -- "^\[0-9\]?" $rc rc + + if {$VERBOSE} { DisplayMsg $s StateBegin////////($ftp(State)) } + + switch -exact -- $ftp(State) { + user { + switch -exact -- $rc { + 2 { + PutsCtrlSock $s "USER $ftp(User)" + set ftp(State) passwd + Command $ftp(Command) user + } + default { + set errmsg "Error connecting! $msgtext" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + passwd { + switch -exact -- $rc { + 2 { + set complete_with 1 + Command $ftp(Command) password + } + 3 { + PutsCtrlSock $s "PASS $ftp(Passwd)" + set ftp(State) connect + Command $ftp(Command) password + } + default { + set errmsg "Error connecting! $msgtext" + set complete_with 0 + Command $ftp(Command) error $msgtext + } + } + } + connect { + switch -exact -- $rc { + 2 { + # The type is set after this, and we want to report + # that the connection is complete once the type is done + set nextState 1 + if {[info exists ftp(NextState)] && ![llength $ftp(NextState)]} { + Command $ftp(Command) connect $s + } else { + set complete_with 1 + } + } + default { + set errmsg "Error connecting! $msgtext" + set complete_with 0 + Command $ftp(Command) error $msgtext + } + } + } + connect_last { + Command $ftp(Command) connect $s + set complete_with 1 + } + quit { + PutsCtrlSock $s "QUIT" + set ftp(State) quit_sent + } + quit_sent { + switch -exact -- $rc { + 2 { + set complete_with 1 + set nextState 1 + Command $ftp(Command) quit + } + default { + set errmsg "Error disconnecting! $msgtext" + set complete_with 0 + Command $ftp(Command) error $msgtext + } + } + } + quote { + PutsCtrlSock $s $ftp(Cmd) + set ftp(State) quote_sent + } + quote_sent { + set complete_with 1 + set ftp(Quote) $buffer + set nextState 1 + Command $ftp(Command) quote $buffer + } + type { + if { [string equal $ftp(Type) "ascii"] } { + PutsCtrlSock $s "TYPE A" + } elseif { [string equal $ftp(Type) "binary"] } { + PutsCtrlSock $s "TYPE I" + } else { + PutsCtrlSock $s "TYPE L" + } + set ftp(State) type_sent + } + type_sent { + switch -exact -- $rc { + 2 { + set complete_with 1 + set nextState 1 + Command $ftp(Command) type $ftp(Type) + } + default { + set errmsg "Error setting type \"$ftp(Type)\"!" + set complete_with 0 + Command $ftp(Command) error "error setting type \"$ftp(Type)\"" + } + } + } + type_change { + set ftp(Type) $ftp(type:changeto) + set ftp(State) type + StateHandler $s + } + nlist_active { + if { [OpenActiveConn $s] } { + PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)" + set ftp(State) nlist_open + } else { + set errmsg "Error setting port!" + } + } + nlist_passive { + PutsCtrlSock $s "PASV" + set ftp(State) nlist_open + } + nlist_open { + switch -exact -- $rc { + 1 {} + 2 { + if { [string equal $ftp(Mode) "passive"] } { + if { ![OpenPassiveConn $s $buffer] } { + set errmsg "Error setting PASSIVE mode!" + set complete_with 0 + Command $ftp(Command) error "error setting passive mode" + } + } + PutsCtrlSock $s "NLST$ftp(Dir)" + set ftp(State) list_sent + } + default { + if { [string equal $ftp(Mode) "passive"] } { + set errmsg "Error setting PASSIVE mode!" + } else { + set errmsg "Error setting port!" + } + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + list_active { + if { [OpenActiveConn $s] } { + PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)" + set ftp(State) list_open + } else { + set errmsg "Error setting port!" + Command $ftp(Command) error $errmsg + } + } + list_passive { + PutsCtrlSock $s "PASV" + set ftp(State) list_open + } + list_open { + switch -exact -- $rc { + 1 {} + 2 { + if { [string equal $ftp(Mode) "passive"] } { + if { ![OpenPassiveConn $s $buffer] } { + set errmsg "Error setting PASSIVE mode!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + PutsCtrlSock $s "LIST$ftp(Dir)" + set ftp(State) list_sent + } + default { + if { [string equal $ftp(Mode) "passive"] } { + set errmsg "Error setting PASSIVE mode!" + } else { + set errmsg "Error setting port!" + } + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + list_sent { + switch -exact -- $rc { + 1 - + 2 { + set ftp(State) list_close + } + default { + if { [string equal $ftp(Mode) "passive"] } { + catch {unset ftp(state.data)} + } + set errmsg "Error getting directory listing!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + list_close { + switch -exact -- $rc { + 1 {} + 2 { + # Sync control sequencer to active data connection + # before stepping out + WaitDataConn $s + + set nextState 1 + if {[info exists ftp(NextState)] && ![llength $ftp(NextState)]} { + Command $ftp(Command) list [ListPostProcess $ftp(List)] + } else { + set complete_with 1 + } + } + default { + set errmsg "Error receiving list!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + list_last { + Command $ftp(Command) list [ListPostProcess $ftp(List)] + set complete_with 1 + } + size { + PutsCtrlSock $s "SIZE $ftp(File)" + set ftp(State) size_sent + } + size_sent { + switch -exact -- $rc { + 2 { + regexp -- "^\[0-9\]+ (.*)$" $buffer all ftp(FileSize) + set complete_with 1 + set nextState 1 + Command $ftp(Command) size $ftp(File) $ftp(FileSize) + } + default { + set errmsg "Error getting file size!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + modtime { + if {$ftp(DateTime) != ""} { + PutsCtrlSock $s "MDTM $ftp(DateTime) $ftp(File)" + } else { ;# No DateTime Specified + PutsCtrlSock $s "MDTM $ftp(File)" + } + set ftp(State) modtime_sent + } + modtime_sent { + switch -exact -- $rc { + 2 { + regexp -- "^\[0-9\]+ (.*)$" $buffer all ftp(DateTime) + set complete_with 1 + set nextState 1 + Command $ftp(Command) modtime $ftp(File) [ModTimePostProcess $ftp(DateTime)] + } + default { + if {$ftp(DateTime) != ""} { + set errmsg "Error setting modification time! No server MDTM support?" + } else { + set errmsg "Error getting modification time!" + } + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + pwd { + PutsCtrlSock $s "PWD" + set ftp(State) pwd_sent + } + pwd_sent { + switch -exact -- $rc { + 2 { + regexp -- "^.*\"(.*)\"" $buffer temp ftp(Dir) + set complete_with 1 + set nextState 1 + Command $ftp(Command) pwd $ftp(Dir) + } + default { + set errmsg "Error getting working dir!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + cd { + PutsCtrlSock $s "CWD$ftp(Dir)" + set ftp(State) cd_sent + } + cd_sent { + switch -exact -- $rc { + 1 {} + 2 { + set complete_with 1 + set nextState 1 + Command $ftp(Command) cd $ftp(Dir) + } + default { + set errmsg "Error changing directory to \"$ftp(Dir)\"" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + mkdir { + PutsCtrlSock $s "MKD $ftp(Dir)" + set ftp(State) mkdir_sent + } + mkdir_sent { + switch -exact -- $rc { + 2 { + set complete_with 1 + set nextState 1 + Command $ftp(Command) mkdir $ftp(Dir) + } + default { + set errmsg "Error making dir \"$ftp(Dir)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + rmdir { + PutsCtrlSock $s "RMD $ftp(Dir)" + set ftp(State) rmdir_sent + } + rmdir_sent { + switch -exact -- $rc { + 2 { + set complete_with 1 + set nextState 1 + Command $ftp(Command) rmdir $ftp(Dir) + } + default { + set errmsg "Error removing directory!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + delete { + PutsCtrlSock $s "DELE $ftp(File)" + set ftp(State) delete_sent + } + delete_sent { + switch -exact -- $rc { + 2 { + set complete_with 1 + set nextState 1 + Command $ftp(Command) delete $ftp(File) + } + default { + set errmsg "Error deleting file \"$ftp(File)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + rename { + PutsCtrlSock $s "RNFR $ftp(RenameFrom)" + set ftp(State) rename_to + } + rename_to { + switch -exact -- $rc { + 3 { + PutsCtrlSock $s "RNTO $ftp(RenameTo)" + set ftp(State) rename_sent + } + default { + set errmsg "Error renaming file \"$ftp(RenameFrom)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + rename_sent { + switch -exact -- $rc { + 2 { + set complete_with 1 + set nextState 1 + Command $ftp(Command) rename $ftp(RenameFrom) $ftp(RenameTo) + } + default { + set errmsg "Error renaming file \"$ftp(RenameFrom)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + put_active { + if { [OpenActiveConn $s] } { + PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)" + set ftp(State) put_open + } else { + set errmsg "Error setting port!" + Command $ftp(Command) error $errmsg + } + } + put_passive { + PutsCtrlSock $s "PASV" + set ftp(State) put_open + } + put_open { + switch -exact -- $rc { + 1 - + 2 { + if { [string equal $ftp(Mode) "passive"] } { + if { ![OpenPassiveConn $s $buffer] } { + set errmsg "Error setting PASSIVE mode!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + PutsCtrlSock $s "STOR $ftp(RemoteFilename)" + set ftp(State) put_sent + } + default { + if { [string equal $ftp(Mode) "passive"] } { + set errmsg "Error setting PASSIVE mode!" + } else { + set errmsg "Error setting port!" + } + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + put_sent { + switch -exact -- $rc { + 1 - + 2 { + set ftp(State) put_close + } + default { + if { [string equal $ftp(Mode) "passive"] } { + # close already opened DataConnection + catch {unset ftp(state.data)} + } + set errmsg "Error opening connection!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + put_close { + switch -exact -- $rc { + 1 { + # Keep going + if {$VERBOSE} { DisplayMsg $s put_close/1--continue } + return + } + 2 { + # Sync control sequencer to active data connection + # before stepping out + WaitDataConn $s + + set complete_with 1 + set nextState 1 + Command $ftp(Command) put $ftp(RemoteFilename) + } + default { + DisplayMsg $s "rc = $rc msgtext = \"$msgtext\"" + set errmsg "Error storing file \"$ftp(RemoteFilename)\" due to \"$msgtext\"" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + append_active { + if { [OpenActiveConn $s] } { + PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)" + set ftp(State) append_open + } else { + set errmsg "Error setting port!" + Command $ftp(Command) error $errmsg + } + } + append_passive { + PutsCtrlSock $s "PASV" + set ftp(State) append_open + } + append_open { + switch -exact -- $rc { + 1 - + 2 { + if { [string equal $ftp(Mode) "passive"] } { + if { ![OpenPassiveConn $s $buffer] } { + set errmsg "Error setting PASSIVE mode!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + PutsCtrlSock $s "APPE $ftp(RemoteFilename)" + set ftp(State) append_sent + } + default { + if { [string equal $ftp(Mode) "passive"] } { + set errmsg "Error setting PASSIVE mode!" + } else { + set errmsg "Error setting port!" + } + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + append_sent { + switch -exact -- $rc { + 1 { + set ftp(State) append_close + } + default { + if { [string equal $ftp(Mode) "passive"] } { + # close already opened DataConnection + catch {unset ftp(state.data)} + } + set errmsg "Error opening connection!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + append_close { + switch -exact -- $rc { + 2 { + # Sync control sequencer to active data connection + # before stepping out + WaitDataConn $s + + set complete_with 1 + set nextState 1 + Command $ftp(Command) append $ftp(RemoteFilename) + } + default { + set errmsg "Error storing file \"$ftp(RemoteFilename)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + reget_active { + if { [OpenActiveConn $s] } { + PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)" + set ftp(State) reget_restart + } else { + set errmsg "Error setting port!" + Command $ftp(Command) error $errmsg + } + } + reget_passive { + PutsCtrlSock $s "PASV" + set ftp(State) reget_restart + } + reget_restart { + switch -exact -- $rc { + 2 { + if { [string equal $ftp(Mode) "passive"] } { + if { ![OpenPassiveConn $s $buffer] } { + set errmsg "Error setting PASSIVE mode!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + if { $ftp(FileSize) != 0 } { + PutsCtrlSock $s "REST $ftp(FileSize)" + set ftp(State) reget_open + } else { + PutsCtrlSock $s "RETR $ftp(RemoteFilename)" + set ftp(State) reget_sent + } + } + default { + set errmsg "Error restarting filetransfer of \"$ftp(RemoteFilename)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + reget_open { + switch -exact -- $rc { + 2 - + 3 { + PutsCtrlSock $s "RETR $ftp(RemoteFilename)" + set ftp(State) reget_sent + } + default { + if { [string equal $ftp(Mode) "passive"] } { + set errmsg "Error setting PASSIVE mode!" + } else { + set errmsg "Error setting port!" + } + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + reget_sent { + switch -exact -- $rc { + 1 { + set ftp(State) reget_close + } + default { + if { [string equal $ftp(Mode) "passive"] } { + # close already opened DataConnection + catch {unset ftp(state.data)} + } + set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + reget_close { + switch -exact -- $rc { + 2 { + # Sync control sequencer to active data connection + # before stepping out + WaitDataConn $s + + set complete_with 1 + set nextState 1 + Command $ftp(Command) get $ftp(RemoteFilename):$ftp(From):$ftp(To) + unset ftp(From) ftp(To) + } + default { + set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + get_active { + if { [OpenActiveConn $s] } { + PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)" + set ftp(State) get_open + } else { + set errmsg "Error setting port!" + Command $ftp(Command) error $errmsg + } + } + get_passive { + PutsCtrlSock $s "PASV" + set ftp(State) get_open + } + get_open { + switch -exact -- $rc { + 1 - + 2 - + 3 { + if { [string equal $ftp(Mode) "passive"] } { + if { ![OpenPassiveConn $s $buffer] } { + set errmsg "Error setting PASSIVE mode!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + PutsCtrlSock $s "RETR $ftp(RemoteFilename)" + set ftp(State) get_sent + } + default { + if { [string equal $ftp(Mode) "passive"] } { + set errmsg "Error setting PASSIVE mode!" + } else { + set errmsg "Error setting port!" + } + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + get_sent { + switch -exact -- $rc { + 1 { + set ftp(State) get_close + } + default { + if { [string equal $ftp(Mode) "passive"] } { + # close already opened DataConnection + catch {unset ftp(state.data)} + } + set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + get_close { + switch -exact -- $rc { + 2 { + # Sync control sequencer to active data connection + # before stepping out + WaitDataConn $s + + set complete_with 1 + set nextState 1 + if {$ftp(inline)} { + upvar #0 $ftp(get:varname) returnData + set returnData $ftp(GetData) + Command $ftp(Command) get $ftp(GetData) + } else { + Command $ftp(Command) get $ftp(RemoteFilename) + } + } + default { + set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!" + set complete_with 0 + Command $ftp(Command) error $errmsg + } + } + } + default { + error "Unknown state \"$ftp(State)\"" + } + } + + if {$VERBOSE} { DisplayMsg $s ////////StateDone==>$ftp(State) } + + # finish waiting + if { [info exists complete_with] } { + if {$VERBOSE} { DisplayMsg $s WaitBegin////////($complete_with) } + + WaitComplete $s $complete_with + + if {$VERBOSE} { DisplayMsg $s ////////WaitDone } + } + + # display control channel message + if { [info exists buffer] } { + if { $VERBOSE } { + foreach line [split $buffer \n] { + DisplayMsg $s "C: $line" control + } + } + } + + # Rather than throwing an error in the event loop, set the ftp(Error) + # variable to hold the message so that it can later be thrown after the + # the StateHandler has completed. + + if { [info exists errmsg] } { + set ftp(Error) $errmsg + } + + # If operating asynchronously, commence next state + if {$VERBOSE} { + DisplayMsg $s "ns=$nextState, NS=[info exists ftp(NextState)], NSlen=[expr {[info exists ftp(NextState)] && [llength $ftp(NextState)]}]" + } + if {$nextState && [info exists ftp(NextState)] && [llength $ftp(NextState)]} { + # Pop the head of the NextState queue + if {$VERBOSE} { DisplayMsg $s Sequence=($ftp(NextState)) } + + set ftp(State) [lindex $ftp(NextState) 0] + set ftp(NextState) [lreplace $ftp(NextState) 0 0] + + if {$VERBOSE} { DisplayMsg $s Recurse/StateHandler } + StateHandler $s + } + + # enable fileevent on control socket again + #fileevent $ftp(CtrlSock) readable [list ::ftp::StateHandler $ftp(CtrlSock)] + + if {$VERBOSE} { DisplayMsg $s ======/HandlerDone } + return +} + +############################################################################# +# +# Type -- +# +# REPRESENTATION TYPE - Sets the file transfer type to ascii or binary. +# (exported) +# +# Arguments: +# type - specifies the representation type (ascii|binary) +# +# Returns: +# type - returns the current type or {} if an error occurs + +proc ::ftp::Type {s {type ""}} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + if { ![string is digit -strict $s] } { + DisplayMsg $s "Bad connection name \"$s\"" error + } else { + DisplayMsg $s "Not connected!" error + } + return {} + } + + # return current type + if { $type == "" } { + return $ftp(Type) + } + + # save current type + set old_type $ftp(Type) + + set ftp(Type) $type + set ftp(State) type + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + if { $rc } { + return $ftp(Type) + } else { + # restore old type + set ftp(Type) $old_type + return {} + } +} + +############################################################################# +# +# NList -- +# +# NAME LIST - This command causes a directory listing to be sent from +# server to user site. +# (exported) +# +# Arguments: +# dir - The $dir should specify a directory or other system +# specific file group descriptor; a null argument +# implies the current directory. +# +# Arguments: +# dir - directory to list +# +# Returns: +# sorted list of files or {} if listing fails + +proc ::ftp::NList {s { dir ""}} { + variable VERBOSE + upvar ::ftp::ftp$s ftp + + if {$VERBOSE} { DisplayMsg $s NList($s)($dir)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } + + if { ![info exists ftp(State)] } { + if { ![string is digit -strict $s] } { + DisplayMsg $s "Bad connection name \"$s\"" error + } else { + DisplayMsg $s "Not connected!" error + } + return {} + } + + set ftp(List) {} + if { $dir == "" } { + set ftp(Dir) "" + } else { + set ftp(Dir) " $dir" + } + + # save current type and force ascii mode + set old_type $ftp(Type) + if { $ftp(Type) != "ascii" } { + if {$VERBOSE} { DisplayMsg $s NList/ForceAscii } + + if {[string length $ftp(Command)]} { + set ftp(NextState) [list nlist_$ftp(Mode) type_change list_last] + set ftp(type:changeto) $old_type + Type $s ascii + return {} + } + Type $s ascii + } + + set ftp(State) nlist_$ftp(Mode) + + if {$VERBOSE} { DisplayMsg $s NList/Process~~~~~~~~~~~~~~~~~~~ } + StateHandler $s + + if {$VERBOSE} { DisplayMsg $s NList/Processed~~~~~~~~~~~~~~~~~ } + + # wait for synchronization + set rc [WaitOrTimeout $s] + + # restore old type + if {$VERBOSE} { DisplayMsg $s NList/RestoreType~~~~~~~~~~~~~~~~~~~~~ } + if { [Type $s] != $old_type } { + Type $s $old_type + } + + unset ftp(Dir) + if { $rc } { + if {$VERBOSE} { DisplayMsg $s NList/ReturnData~~~~~~~~~~~~~~~~~~~~~~~ } + + return [lsort [split [string trim $ftp(List) \n] \n]] + } else { + if {$VERBOSE} { DisplayMsg $s NList/CDC~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ } + + CloseDataConn $s + return {} + } + + if {$VERBOSE} { DisplayMsg $s ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~NList/Done } +} + +############################################################################# +# +# List -- +# +# LIST - This command causes a list to be sent from the server +# to user site. +# (exported) +# +# Arguments: +# dir - If the $dir specifies a directory or other group of +# files, the server should transfer a list of files in +# the specified directory. If the $dir specifies a file +# then the server should send current information on the +# file. A null argument implies the user's current +# working or default directory. +# +# Returns: +# list of files or {} if listing fails + +proc ::ftp::List {s {dir ""}} { + + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + if { ![string is digit -strict $s] } { + DisplayMsg $s "Bad connection name \"$s\"" error + } else { + DisplayMsg $s "Not connected!" error + } + return {} + } + + set ftp(List) {} + if { $dir == "" } { + set ftp(Dir) "" + } else { + set ftp(Dir) " $dir" + } + + # save current type and force ascii mode + + set old_type $ftp(Type) + if { ![string equal "$ftp(Type)" "ascii"] } { + if {[string length $ftp(Command)]} { + set ftp(NextState) [list list_$ftp(Mode) type_change list_last] + set ftp(type:changeto) $old_type + Type $s ascii + return {} + } + Type $s ascii + } + + set ftp(State) list_$ftp(Mode) + StateHandler $s + + # wait for synchronization + + set rc [WaitOrTimeout $s] + + # restore old type + + if { ![string equal "[Type $s]" "$old_type"] } { + Type $s $old_type + } + + unset ftp(Dir) + if { $rc } { + return [ListPostProcess $ftp(List)] + } else { + CloseDataConn $s + return {} + } +} + +proc ::ftp::ListPostProcess l { + + # clear "total"-line + + set l [split $l "\n"] + set index [lsearch -regexp $l "^total"] + if { $index != "-1" } { + set l [lreplace $l $index $index] + } + + # clear blank line + + set index [lsearch -regexp $l "^$"] + if { $index != "-1" } { + set l [lreplace $l $index $index] + } + + return $l +} + +############################################################################# +# +# FileSize -- +# +# REMOTE FILE SIZE - This command gets the file size of the +# file on the remote machine. +# ATTENTION! Doesn't work properly in ascii mode! +# (exported) +# +# Arguments: +# filename - specifies the remote file name +# +# Returns: +# size - files size in bytes or {} in error cases + +proc ::ftp::FileSize {s {filename ""}} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + if { ![string is digit -strict $s] } { + DisplayMsg $s "Bad connection name \"$s\"" error + } else { + DisplayMsg $s "Not connected!" error + } + return {} + } + + if { $filename == "" } { + return {} + } + + set ftp(File) $filename + set ftp(FileSize) 0 + + set ftp(State) size + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if {![string length $ftp(Command)]} { + unset ftp(File) + } + + if { $rc } { + return $ftp(FileSize) + } else { + return {} + } +} + + +############################################################################# +# +# ModTime -- +# +# MODIFICATION TIME - This command gets the last modification time of the +# file on the remote machine. +# (exported) +# +# Arguments: +# filename - specifies the remote file name +# datetime - optional new timestamp for file +# +# Returns: +# clock - files date and time as a system-depentend integer +# value in seconds (see tcls clock command) or {} in +# error cases +# if MDTM not supported on server, returns original timestamp + +proc ::ftp::ModTime {s {filename ""} {datetime ""}} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + if { ![string is digit -strict $s] } { + DisplayMsg $s "Bad connection name \"$s\"" error + } else { + DisplayMsg $s "Not connected!" error + } + return {} + } + + if { $filename == "" } { + return {} + } + + set ftp(File) $filename + + if {$datetime != ""} { + set datetime [clock format $datetime -format "%Y%m%d%H%M%S"] + } + set ftp(DateTime) $datetime + + set ftp(State) modtime + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if {![string length $ftp(Command)]} { + unset ftp(File) + } + if { ![string length $ftp(Command)] && $rc } { + return [ModTimePostProcess $ftp(DateTime)] + } else { + return {} + } +} + +proc ::ftp::ModTimePostProcess {clock} { + foreach {year month day hour min sec} {1 1 1 1 1 1} break + + # Bug #478478. Special code to detect ftp servers with a Y2K patch + # gone bad and delivering, hmmm, non-standard date information. + + if {[string length $clock] == 15} { + scan $clock "%2s%3s%2s%2s%2s%2s%2s" cent year month day hour min sec + set year [expr {($cent * 100) + $year}] + log::log warning "data | W: server with non-standard time, bad Y2K patch." + } else { + scan $clock "%4s%2s%2s%2s%2s%2s" year month day hour min sec + } + + set clock [clock scan "$month/$day/$year $hour:$min:$sec" -gmt 1] + return $clock +} + +############################################################################# +# +# Pwd -- +# +# PRINT WORKING DIRECTORY - Causes the name of the current working directory. +# (exported) +# +# Arguments: +# None. +# +# Returns: +# current directory name + +proc ::ftp::Pwd {s } { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + if { ![string is digit -strict $s] } { + DisplayMsg $s "Bad connection name \"$s\"" error + } else { + DisplayMsg $s "Not connected!" error + } + return {} + } + + set ftp(Dir) {} + + set ftp(State) pwd + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if { $rc } { + return $ftp(Dir) + } else { + return {} + } +} + +############################################################################# +# +# Cd -- +# +# CHANGE DIRECTORY - Sets the working directory on the server host. +# (exported) +# +# Arguments: +# dir - pathname specifying a directory +# +# Returns: +# 0 - ERROR +# 1 - OK + +proc ::ftp::Cd {s {dir ""}} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + if { ![string is digit -strict $s] } { + DisplayMsg $s "Bad connection name \"$s\"" error + } else { + DisplayMsg $s "Not connected!" error + } + return 0 + } + + if { $dir == "" } { + set ftp(Dir) "" + } else { + set ftp(Dir) " $dir" + } + + set ftp(State) cd + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if {![string length $ftp(Command)]} { + unset ftp(Dir) + } + + if { $rc } { + return 1 + } else { + return 0 + } +} + +############################################################################# +# +# MkDir -- +# +# MAKE DIRECTORY - This command causes the directory specified in the $dir +# to be created as a directory (if the $dir is absolute) or as a subdirectory +# of the current working directory (if the $dir is relative). +# (exported) +# +# Arguments: +# dir - new directory name +# +# Returns: +# 0 - ERROR +# 1 - OK + +proc ::ftp::MkDir {s dir} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + set ftp(Dir) $dir + + set ftp(State) mkdir + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if {![string length $ftp(Command)]} { + unset ftp(Dir) + } + + if { $rc } { + return 1 + } else { + return 0 + } +} + +############################################################################# +# +# RmDir -- +# +# REMOVE DIRECTORY - This command causes the directory specified in $dir to +# be removed as a directory (if the $dir is absolute) or as a +# subdirectory of the current working directory (if the $dir is relative). +# (exported) +# +# Arguments: +# dir - directory name +# +# Returns: +# 0 - ERROR +# 1 - OK + +proc ::ftp::RmDir {s dir} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + set ftp(Dir) $dir + + set ftp(State) rmdir + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if {![string length $ftp(Command)]} { + unset ftp(Dir) + } + + if { $rc } { + return 1 + } else { + return 0 + } +} + +############################################################################# +# +# Delete -- +# +# DELETE - This command causes the file specified in $file to be deleted at +# the server site. +# (exported) +# +# Arguments: +# file - file name +# +# Returns: +# 0 - ERROR +# 1 - OK + +proc ::ftp::Delete {s file} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + set ftp(File) $file + + set ftp(State) delete + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if {![string length $ftp(Command)]} { + unset ftp(File) + } + + if { $rc } { + return 1 + } else { + return 0 + } +} + +############################################################################# +# +# Rename -- +# +# RENAME FROM TO - This command causes the file specified in $from to be +# renamed at the server site. +# (exported) +# +# Arguments: +# from - specifies the old file name of the file which +# is to be renamed +# to - specifies the new file name of the file +# specified in the $from agument +# Returns: +# 0 - ERROR +# 1 - OK + +proc ::ftp::Rename {s from to} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + set ftp(RenameFrom) $from + set ftp(RenameTo) $to + + set ftp(State) rename + + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + if {![string length $ftp(Command)]} { + unset ftp(RenameFrom) + unset ftp(RenameTo) + } + + if { $rc } { + return 1 + } else { + return 0 + } +} + +############################################################################# +# +# ElapsedTime -- +# +# Gets the elapsed time for file transfer +# +# Arguments: +# stop_time - ending time + +proc ::ftp::ElapsedTime {s stop_time} { + variable VERBOSE + upvar ::ftp::ftp$s ftp + + set elapsed [expr {$stop_time - $ftp(Start_Time)}] + if { $elapsed == 0 } { + set elapsed 1 + } + set persec [expr {$ftp(Total) / $elapsed}] + if { $VERBOSE } { + DisplayMsg $s "$ftp(Total) bytes sent in $elapsed seconds ($persec Bytes/s)" + } + return +} + +############################################################################# +# +# PUT -- +# +# STORE DATA - Causes the server to accept the data transferred via the data +# connection and to store the data as a file at the server site. If the file +# exists at the server site, then its contents shall be replaced by the data +# being transferred. A new file is created at the server site if the file +# does not already exist. +# (exported) +# +# Arguments: +# source - local file name +# dest - remote file name, if unspecified, ftp assigns +# the local file name. +# Returns: +# 0 - file not stored +# 1 - OK + +proc ::ftp::Put {s args} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + if {([llength $args] < 1) || ([llength $args] > 4)} { + DisplayMsg $s \ + "wrong # args: should be \"ftp::Put handle (-data \"data\" | -channel chan | localFilename) remoteFilename\"" error + return 0 + } + + set ftp(inline) 0 + set flags 1 + set source "" + set dest "" + foreach arg $args { + if {[string equal $arg "--"]} { + set flags 0 + } elseif {($flags) && ([string equal $arg "-data"])} { + set ftp(inline) 1 + set ftp(filebuffer) "" + } elseif {($flags) && ([string equal $arg "-channel"])} { + set ftp(inline) 2 + } elseif {$source == ""} { + set source $arg + } elseif {$dest == ""} { + set dest $arg + } else { + DisplayMsg $s "wrong # args: should be \"ftp::Put handle (-data \"data\" | -channel chan | localFilename) remoteFilename\"" error + return 0 + } + } + + if {($source == "")} { + DisplayMsg $s "Must specify a valid data source to Put" error + return 0 + } + + set ftp(RemoteFilename) $dest + + if {$ftp(inline) == 1} { + set ftp(PutData) $source + if { $dest == "" } { + set dest ftp.tmp + } + set ftp(RemoteFilename) $dest + } else { + if {$ftp(inline) == 0} { + # File transfer + + set ftp(PutData) "" + if { ![file exists $source] } { + DisplayMsg $s "File \"$source\" not exist" error + return 0 + } + if { $dest == "" } { + set dest [file tail $source] + } + set ftp(LocalFilename) $source + set ftp(SourceCI) [open $ftp(LocalFilename) r] + } else { + # Channel transfer. We fake the rest of the system into + # believing that a file transfer is happening. This makes + # the handling easier. + + set ftp(SourceCI) $source + set ftp(inline) 0 + } + set ftp(RemoteFilename) $dest + + # TODO: read from source file asynchronously + if { [string equal $ftp(Type) "ascii"] } { + fconfigure $ftp(SourceCI) -buffering line -blocking 1 + } else { + fconfigure $ftp(SourceCI) -buffering line -translation binary -blocking 1 + } + } + + set ftp(State) put_$ftp(Mode) + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + if { $rc } { + if {![string length $ftp(Command)]} { + ElapsedTime $s [clock seconds] + } + return 1 + } else { + CloseDataConn $s + return 0 + } +} + +############################################################################# +# +# APPEND -- +# +# APPEND DATA - Causes the server to accept the data transferred via the data +# connection and to store the data as a file at the server site. If the file +# exists at the server site, then the data shall be appended to that file; +# otherwise the file specified in the pathname shall be created at the +# server site. +# (exported) +# +# Arguments: +# source - local file name +# dest - remote file name, if unspecified, ftp assigns +# the local file name. +# Returns: +# 0 - file not stored +# 1 - OK + +proc ::ftp::Append {s args} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + if {([llength $args] < 1) || ([llength $args] > 4)} { + DisplayMsg $s "wrong # args: should be \"ftp::Append handle (-data \"data\" | -channel chan | localFilename) remoteFilename\"" error + return 0 + } + + set ftp(inline) 0 + set flags 1 + set source "" + set dest "" + foreach arg $args { + if {[string equal $arg "--"]} { + set flags 0 + } elseif {($flags) && ([string equal $arg "-data"])} { + set ftp(inline) 1 + set ftp(filebuffer) "" + } elseif {($flags) && ([string equal $arg "-channel"])} { + set ftp(inline) 2 + } elseif {$source == ""} { + set source $arg + } elseif {$dest == ""} { + set dest $arg + } else { + DisplayMsg $s "wrong # args: should be \"ftp::Append handle (-data \"data\" | -channel chan | localFilename) remoteFilename\"" error + return 0 + } + } + + if {($source == "")} { + DisplayMsg $s "Must specify a valid data source to Append" error + return 0 + } + + set ftp(RemoteFilename) $dest + + if {$ftp(inline) == 1} { + set ftp(PutData) $source + if { $dest == "" } { + set dest ftp.tmp + } + set ftp(RemoteFilename) $dest + } else { + if {$ftp(inline) == 0} { + # File transfer + + set ftp(PutData) "" + if { ![file exists $source] } { + DisplayMsg $s "File \"$source\" not exist" error + return 0 + } + + if { $dest == "" } { + set dest [file tail $source] + } + + set ftp(LocalFilename) $source + set ftp(SourceCI) [open $ftp(LocalFilename) r] + } else { + # Channel transfer. We fake the rest of the system into + # believing that a file transfer is happening. This makes + # the handling easier. + + set ftp(SourceCI) $source + set ftp(inline) 0 + } + set ftp(RemoteFilename) $dest + + if { [string equal $ftp(Type) "ascii"] } { + fconfigure $ftp(SourceCI) -buffering line -blocking 1 + } else { + fconfigure $ftp(SourceCI) -buffering line -translation binary \ + -blocking 1 + } + } + + set ftp(State) append_$ftp(Mode) + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + if { $rc } { + if {![string length $ftp(Command)]} { + ElapsedTime $s [clock seconds] + } + return 1 + } else { + CloseDataConn $s + return 0 + } +} + + +############################################################################# +# +# Get -- +# +# RETRIEVE DATA - Causes the server to transfer a copy of the specified file +# to the local site at the other end of the data connection. +# (exported) +# +# Arguments: +# source - remote file name +# dest - local file name, if unspecified, ftp assigns +# the remote file name. +# Returns: +# 0 - file not retrieved +# 1 - OK + +proc ::ftp::Get {s args} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + if {([llength $args] < 1) || ([llength $args] > 4)} { + DisplayMsg $s "wrong # args: should be \"ftp::Get handle remoteFile ?(-variable varName | -channel chan | localFilename)?\"" error + return 0 + } + + set ftp(inline) 0 + set flags 1 + set source "" + set dest "" + set varname "**NONE**" + foreach arg $args { + if {[string equal $arg "--"]} { + set flags 0 + } elseif {($flags) && ([string equal $arg "-variable"])} { + set ftp(inline) 1 + set ftp(filebuffer) "" + } elseif {($flags) && ([string equal $arg "-channel"])} { + set ftp(inline) 2 + } elseif {($ftp(inline) == 1) && ([string equal $varname "**NONE**"])} { + set varname $arg + set ftp(get:varname) $varname + } elseif {($ftp(inline) == 2) && ([string equal $varname "**NONE**"])} { + set ftp(get:channel) $arg + } elseif {$source == ""} { + set source $arg + } elseif {$dest == ""} { + set dest $arg + } else { + DisplayMsg $s "wrong # args: should be \"ftp::Get handle remoteFile +?(-variable varName | -channel chan | localFilename)?\"" error + return 0 + } + } + + if {($ftp(inline) != 0) && ($dest != "")} { + DisplayMsg $s "Cannot return data in a variable or channel, and place it in destination file." error + return 0 + } + + if {$source == ""} { + DisplayMsg $s "Must specify a valid data source to Get" error + return 0 + } + + if {$ftp(inline) == 0} { + if { $dest == "" } { + set dest $source + } else { + if {[file isdirectory $dest]} { + set dest [file join $dest [file tail $source]] + } + } + if {![file exists [file dirname $dest]]} { + return -code error "ftp::Get, directory \"[file dirname $dest]\" for destination \"$dest\" does not exist" + } + set ftp(LocalFilename) $dest + } + + set ftp(RemoteFilename) $source + + if {$ftp(inline) == 2} { + set ftp(inline) 0 + } + set ftp(State) get_$ftp(Mode) + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + # It is important to unset 'get:channel' in all cases or it will + # interfere with any following ftp command (as its existence + # suppresses the closing of the destination channel identifier + # (DestCI). We cannot do it earlier than just before the 'return' + # or code depending on it for the current command may not execute + # correctly. + + if { $rc } { + if {![string length $ftp(Command)]} { + ElapsedTime $s [clock seconds] + if {$ftp(inline)} { + catch {unset ftp(get:channel)} + upvar $varname returnData + set returnData $ftp(GetData) + } + } + # catch {unset ftp(get:channel)} + # SF Bug 1708350. DISABLED. In async mode (Open -command) the + # unset here causes HandleData to blow up, see marker <@>. In + # essence in async mode HandleData can be entered multiple + # times, and unsetting get:channel here causes it to think + # that the data goes into a local file, not a channel, but the + # state does not contain local file information, so an error + # is thrown. Removing the catch here seems to fix it without + # adverse effects elsewhere. Maybe. We hope. + return 1 + } else { + if {$ftp(inline)} { + catch {unset ftp(get:channel)} + return "" + } + CloseDataConn $s + catch {unset ftp(get:channel)} + return 0 + } +} + +############################################################################# +# +# Reget -- +# +# RESTART RETRIEVING DATA - Causes the server to transfer a copy of the specified file +# to the local site at the other end of the data connection like get but skips over +# the file to the specified data checkpoint. +# (exported) +# +# Arguments: +# source - remote file name +# dest - local file name, if unspecified, ftp assigns +# the remote file name. +# Returns: +# 0 - file not retrieved +# 1 - OK + +proc ::ftp::Reget {s source {dest ""} {from_bytes 0} {till_bytes -1}} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + if { $dest == "" } { + set dest $source + } + if {![file exists [file dirname $dest]]} { + return -code error \ + "ftp::Reget, directory \"[file dirname $dest]\" for destination \"$dest\" does not exist" + } + + set ftp(RemoteFilename) $source + set ftp(LocalFilename) $dest + set ftp(From) $from_bytes + + + # Assumes that the local file has a starting offset of $from_bytes + # The following calculation ensures that the download starts from the + # correct offset + + if { [file exists $ftp(LocalFilename)] } { + set ftp(FileSize) [ expr {[file size $ftp(LocalFilename)] + $from_bytes }] + + if { $till_bytes != -1 } { + set ftp(To) $till_bytes + set ftp(Bytes_to_go) [ expr {$till_bytes - $ftp(FileSize)} ] + + if { $ftp(Bytes_to_go) <= 0 } {return 0} + + } else { + # till_bytes not set + set ftp(To) end + } + + } else { + # local file does not exist + set ftp(FileSize) $from_bytes + + if { $till_bytes != -1 } { + set ftp(Bytes_to_go) [ expr {$till_bytes - $from_bytes }] + set ftp(To) $till_bytes + } else { + #till_bytes not set + set ftp(To) end + } + } + + set ftp(State) reget_$ftp(Mode) + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + if { $rc } { + if {![string length $ftp(Command)]} { + ElapsedTime $s [clock seconds] + } + return 1 + } else { + CloseDataConn $s + return 0 + } +} + +############################################################################# +# +# Newer -- +# +# GET NEWER DATA - Get the file only if the modification time of the remote +# file is more recent that the file on the current system. If the file does +# not exist on the current system, the remote file is considered newer. +# Otherwise, this command is identical to get. +# (exported) +# +# Arguments: +# source - remote file name +# dest - local file name, if unspecified, ftp assigns +# the remote file name. +# +# Returns: +# 0 - file not retrieved +# 1 - OK + +proc ::ftp::Newer {s source {dest ""}} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + if {[string length $ftp(Command)]} { + return -code error "unable to retrieve file asynchronously (not implemented yet)" + } + + if { $dest == "" } { + set dest $source + } + if {![file exists [file dirname $dest]]} { + return -code error "ftp::Newer, directory \"[file dirname $dest]\" for destination \"$dest\" does not exist" + } + + set ftp(RemoteFilename) $source + set ftp(LocalFilename) $dest + + # get remote modification time + set rmt [ModTime $s $ftp(RemoteFilename)] + if { $rmt == "-1" } { + return 0 + } + + # get local modification time + if { [file exists $ftp(LocalFilename)] } { + set lmt [file mtime $ftp(LocalFilename)] + } else { + set lmt 0 + } + + # remote file is older than local file + if { $rmt < $lmt } { + return 0 + } + + # remote file is newer than local file or local file doesn't exist + # get it + set rc [Get $s $ftp(RemoteFilename) $ftp(LocalFilename)] + return $rc + +} + +############################################################################# +# +# Quote -- +# +# The arguments specified are sent, verbatim, to the remote ftp server. +# +# Arguments: +# arg1 arg2 ... +# +# Returns: +# string sent back by the remote ftp server or null string if any error +# + +proc ::ftp::Quote {s args} { + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + set ftp(Cmd) $args + set ftp(Quote) {} + + set ftp(State) quote + StateHandler $s + + # wait for synchronization + set rc [WaitOrTimeout $s] + + unset ftp(Cmd) + + if { $rc } { + return $ftp(Quote) + } else { + return {} + } +} + + +############################################################################# +# +# Abort -- +# +# ABORT - Tells the server to abort the previous ftp service command and +# any associated transfer of data. The control connection is not to be +# closed by the server, but the data connection must be closed. +# +# NOTE: This procedure doesn't work properly. Thus the ftp::Abort command +# is no longer available! +# +# Arguments: +# None. +# +# Returns: +# 0 - ERROR +# 1 - OK +# +# proc Abort {} { +# +# } + +############################################################################# +# +# Close -- +# +# Terminates a ftp session and if file transfer is not in progress, the server +# closes the control connection. If file transfer is in progress, the +# connection will remain open for result response and the server will then +# close it. +# (exported) +# +# Arguments: +# None. +# +# Returns: +# 0 - ERROR +# 1 - OK + +proc ::ftp::Close {s } { + variable connections + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + if {[info exists \ + connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid)]} { + unset connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid) + unset connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost)) + } + + set ftp(State) quit + StateHandler $s + + # wait for synchronization + WaitOrTimeout $s + + catch {close $ftp(CtrlSock)} + catch {unset ftp} + return 1 +} + +proc ::ftp::LazyClose {s } { + variable connections + upvar ::ftp::ftp$s ftp + + if { ![info exists ftp(State)] } { + DisplayMsg $s "Not connected!" error + return 0 + } + + if {[info exists connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost))]} { + set connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid) \ + [after 5000 [list ftp::Close $s]] + } + return 1 +} + +############################################################################# +# +# Open -- +# +# Starts the ftp session and sets up a ftp control connection. +# (exported) +# +# Arguments: +# server - The ftp server hostname. +# user - A string identifying the user. The user identification +# is that which is required by the server for access to +# its file system. +# passwd - A string specifying the user's password. +# options - -blocksize size writes "size" bytes at once +# (default 4096) +# -timeout seconds if non-zero, sets up timeout to +# occur after specified number of +# seconds (default 120) +# -progress proc procedure name that handles callbacks +# (no default) +# -output proc procedure name that handles output +# (no default) +# -mode mode switch active or passive file transfer +# (default active) +# -port number alternative port (default 21) +# -command proc callback for completion notification +# (no default) +# +# Returns: +# 0 - Not logged in +# 1 - User logged in + +proc ::ftp::Open {server user passwd args} { + variable DEBUG + variable VERBOSE + variable serial + variable connections + + set s $serial + incr serial + upvar ::ftp::ftp$s ftp +# if { [info exists ftp(State)] } { +# DisplayMsg $s "Mmh, another attempt to open a new connection? There is already a hot wire!" error +# return 0 +# } + + # default NO DEBUG + if { ![info exists DEBUG] } { + set DEBUG 0 + } + + # default NO VERBOSE + if { ![info exists VERBOSE] } { + set VERBOSE 0 + } + + if { $DEBUG } { + DisplayMsg $s "Starting new connection with: " + } + + set ftp(inline) 0 + set ftp(User) $user + set ftp(Passwd) $passwd + set ftp(RemoteHost) $server + set ftp(LocalHost) [info hostname] + set ftp(DataPort) 0 + set ftp(Type) {} + set ftp(Error) "" + set ftp(Progress) {} + set ftp(Command) {} + set ftp(Output) {} + set ftp(Blocksize) 4096 + set ftp(Timeout) 600 + set ftp(Mode) active + set ftp(Port) 21 + + set ftp(State) user + + # set state var + set ftp(state.control) "" + + # Get and set possible options + set options {-blocksize -timeout -mode -port -progress -output -command} + foreach {option value} $args { + if { [lsearch -exact $options $option] != "-1" } { + if { $DEBUG } { + DisplayMsg $s " $option = $value" + } + regexp -- {^-(.?)(.*)$} $option all first rest + set option "[string toupper $first]$rest" + set ftp($option) $value + } + } + if { $DEBUG && ([llength $args] == 0) } { + DisplayMsg $s " no option" + } + + if {[info exists \ + connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid)]} { + after cancel $connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost),afterid) + Command $ftp(Command) connect $connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost)) + return $connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost)) + } + + + # No call of StateHandler is required at this time. + # StateHandler at first time is called automatically + # by a fileevent for the control channel. + + # Try to open a control connection + if { ![OpenControlConn $s [expr {[string length $ftp(Command)] > 0}]] } { + return -1 + } + + # waits for synchronization + # 0 ... Not logged in + # 1 ... User logged in + if {[string length $ftp(Command)]} { + # Don't wait - asynchronous operation + set ftp(NextState) {type connect_last} + set connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost)) $s + return $s + } elseif { [WaitOrTimeout $s] } { + # default type is binary + Type $s binary + set connections($ftp(User),$ftp(Passwd),$ftp(RemoteHost)) $s + Command $ftp(Command) connect $s + return $s + } else { + # close connection if not logged in + Close $s + return -1 + } +} + +############################################################################# +# +# CopyNext -- +# +# recursive background copy procedure for ascii/binary file I/O +# +# Arguments: +# bytes - indicates how many bytes were written on $ftp(DestCI) + +proc ::ftp::CopyNext {s bytes {error {}}} { + upvar ::ftp::ftp$s ftp + variable DEBUG + variable VERBOSE + + # summary bytes + + incr ftp(Total) $bytes + + # update bytes_to_go and blocksize + + if { [info exists ftp(Bytes_to_go)] } { + set ftp(Bytes_to_go) [expr {$ftp(Bytes_to_go) - $bytes}] + + if { $ftp(Blocksize) <= $ftp(Bytes_to_go) } { + set blocksize $ftp(Blocksize) + } else { + set blocksize $ftp(Bytes_to_go) + } + } else { + set blocksize $ftp(Blocksize) + } + + # callback for progress bar procedure + + if { ([info exists ftp(Progress)]) && \ + [string length $ftp(Progress)] && \ + ([info commands [lindex $ftp(Progress) 0]] != "") } { + eval $ftp(Progress) $ftp(Total) + } + + # setup new timeout handler + + catch {after cancel $ftp(Wait)} + set ftp(Wait) [after [expr {$ftp(Timeout) * 1000}] [namespace current]::Timeout $s] + + if { $DEBUG } { + DisplayMsg $s "-> $ftp(Total) bytes $ftp(SourceCI) -> $ftp(DestCI)" + } + + if { $error != "" } { + # Protect the destination channel from destruction if it came + # from the caller. Closing it is not our responsibility in that case. + + if {![info exists ftp(get:channel)]} { + catch {close $ftp(DestCI)} + } + catch {close $ftp(SourceCI)} + catch {unset ftp(state.data)} + DisplayMsg $s $error error + + } elseif { ([eof $ftp(SourceCI)] || ($blocksize <= 0)) } { + # Protect the destination channel from destruction if it came + # from the caller. Closing it is not our responsibility in that case. + + if {![info exists ftp(get:channel)]} { + close $ftp(DestCI) + } + close $ftp(SourceCI) + catch {unset ftp(state.data)} + if { $VERBOSE } { + DisplayMsg $s "D: Port closed" data + } + + } else { + fcopy $ftp(SourceCI) $ftp(DestCI) \ + -command [list [namespace current]::CopyNext $s] \ + -size $blocksize + } + return +} + +############################################################################# +# +# HandleData -- +# +# Handles ascii/binary data transfer for Put and Get +# +# Arguments: +# sock - socket name (data channel) + +proc ::ftp::HandleData {s sock} { + upvar ::ftp::ftp$s ftp + + # Turn off any fileevent handlers + + fileevent $sock writable {} + fileevent $sock readable {} + + # create local file for ftp::Get + + if { [string match "get*" $ftp(State)] && (!$ftp(inline))} { + + # A channel was specified by the caller. Use that instead of a + # file. + + # SF Bug 1708350 <@> + if {[info exists ftp(get:channel)]} { + set ftp(DestCI) $ftp(get:channel) + set rc 0 + } else { + set rc [catch {set ftp(DestCI) [open $ftp(LocalFilename) w]} msg] + } + if { $rc != 0 } { + DisplayMsg $s "$msg" error + return 0 + } + # TODO: Use non-blocking I/O + if { [string equal $ftp(Type) "ascii"] } { + fconfigure $ftp(DestCI) -buffering line -blocking 1 + } else { + fconfigure $ftp(DestCI) -buffering line -translation binary -blocking 1 + } + } + + # append local file for ftp::Reget + + if { [string match "reget*" $ftp(State)] } { + set rc [catch {set ftp(DestCI) [open $ftp(LocalFilename) a]} msg] + if { $rc != 0 } { + DisplayMsg $s "$msg" error + return 0 + } + # TODO: Use non-blocking I/O + if { [string equal $ftp(Type) "ascii"] } { + fconfigure $ftp(DestCI) -buffering line -blocking 1 + } else { + fconfigure $ftp(DestCI) -buffering line -translation binary -blocking 1 + } + } + + + set ftp(Total) 0 + set ftp(Start_Time) [clock seconds] + + # calculate blocksize + + if { [ info exists ftp(Bytes_to_go) ] } { + + if { $ftp(Blocksize) <= $ftp(Bytes_to_go) } { + set Blocksize $ftp(Blocksize) + } else { + set Blocksize $ftp(Bytes_to_go) + } + + } else { + set Blocksize $ftp(Blocksize) + } + + # perform fcopy + fcopy $ftp(SourceCI) $ftp(DestCI) \ + -command [list [namespace current]::CopyNext $s ] \ + -size $Blocksize + return 1 +} + +############################################################################# +# +# HandleList -- +# +# Handles ascii data transfer for list commands +# +# Arguments: +# sock - socket name (data channel) + +proc ::ftp::HandleList {s sock} { + upvar ::ftp::ftp$s ftp + variable VERBOSE + + if { ![eof $sock] } { + set buffer [read $sock] + if { $buffer != "" } { + set ftp(List) [append ftp(List) $buffer] + } + } else { + close $sock + catch {unset ftp(state.data)} + if { $VERBOSE } { + DisplayMsg $s "D: Port closed" data + } + } + return +} + +############################################################################# +# +# HandleVar -- +# +# Handles data transfer for get/put commands that use buffers instead +# of files. +# +# Arguments: +# sock - socket name (data channel) + +proc ::ftp::HandleVar {s sock} { + upvar ::ftp::ftp$s ftp + variable VERBOSE + + if {$ftp(Start_Time) == -1} { + set ftp(Start_Time) [clock seconds] + } + + if { ![eof $sock] } { + set buffer [read $sock] + if { $buffer != "" } { + append ftp(GetData) $buffer + incr ftp(Total) [string length $buffer] + } + } else { + close $sock + catch {unset ftp(state.data)} + if { $VERBOSE } { + DisplayMsg $s "D: Port closed" data + } + } + return +} + +############################################################################# +# +# HandleOutput -- +# +# Handles data transfer for get/put commands that use buffers instead +# of files. +# +# Arguments: +# sock - socket name (data channel) + +proc ::ftp::HandleOutput {s sock} { + upvar ::ftp::ftp$s ftp + variable VERBOSE + + if {$ftp(Start_Time) == -1} { + set ftp(Start_Time) [clock seconds] + } + + if { $ftp(Total) < [string length $ftp(PutData)] } { + set substr [string range $ftp(PutData) $ftp(Total) \ + [expr {$ftp(Total) + $ftp(Blocksize)}]] + if {[catch {puts -nonewline $sock "$substr"} result]} { + close $sock + catch {unset ftp(state.data)} + if { $VERBOSE } { + DisplayMsg $s "D: Port closed" data + } + } else { + incr ftp(Total) [string length $substr] + } + } else { + fileevent $sock writable {} + close $sock + catch {unset ftp(state.data)} + if { $VERBOSE } { + DisplayMsg $s "D: Port closed" data + } + } + return +} + +############################################################################ +# +# CloseDataConn -- +# +# Closes all sockets and files used by the data conection +# +# Arguments: +# None. +# +# Returns: +# None. +# +proc ::ftp::CloseDataConn {s } { + upvar ::ftp::ftp$s ftp + + # Protect the destination channel from destruction if it came + # from the caller. Closing it is not our responsibility. + + if {[info exists ftp(get:channel)]} { + catch {unset ftp(get:channel)} + catch {unset ftp(DestCI)} + } + + catch { unset ftp(AC) } + catch {after cancel $ftp(Wait)} + catch {fileevent $ftp(DataSock) readable {}} + catch {close $ftp(DataSock); unset ftp(DataSock)} + catch {close $ftp(DestCI); unset ftp(DestCI)} + catch {close $ftp(SourceCI); unset ftp(SourceCI)} + catch {close $ftp(DummySock); unset ftp(DummySock)} + return +} + +############################################################################# +# +# InitDataConn -- +# +# Configures new data channel for connection to ftp server +# ATTENTION! The new data channel "sock" is not the same as the +# server channel, it's a dummy. +# +# Arguments: +# sock - the name of the new channel +# addr - the address, in network address notation, +# of the client's host, +# port - the client's port number + +proc ::ftp::InitDataConn {s sock addr port} { + upvar ::ftp::ftp$s ftp + variable VERBOSE + + if { $VERBOSE } { + DisplayMsg $s "D: New Connection from $addr:$port" data + DisplayMsg $s "D: Sequencer state $ftp(State)" data + } + + # If the new channel is accepted, the dummy channel will be closed + + catch {close $ftp(DummySock); unset ftp(DummySock)} + + set ftp(state.data) 0 + + # Configure translation and blocking modes + + set blocking 1 + if {[string length $ftp(Command)]} { + set blocking 0 + } + + if { [string equal $ftp(Type) "ascii"] } { + fconfigure $sock -buffering line -blocking $blocking + } else { + fconfigure $sock -buffering line -translation binary -blocking $blocking + } + + # assign fileevent handlers, source and destination CI (Channel Identifier) + + # NB: this really does need to be -regexp [PT] 18Mar03 + switch -regexp -- $ftp(State) { + list { + fileevent $sock readable [list [namespace current]::HandleList $s $sock] + set ftp(SourceCI) $sock + } + get { + if {$ftp(inline)} { + set ftp(GetData) "" + set ftp(Start_Time) -1 + set ftp(Total) 0 + fileevent $sock readable [list [namespace current]::HandleVar $s $sock] + } else { + fileevent $sock readable [list [namespace current]::HandleData $s $sock] + set ftp(SourceCI) $sock + } + } + append - + put { + if {$ftp(inline)} { + set ftp(Start_Time) -1 + set ftp(Total) 0 + fileevent $sock writable [list [namespace current]::HandleOutput $s $sock] + } else { + fileevent $sock writable [list [namespace current]::HandleData $s $sock] + set ftp(DestCI) $sock + } + } + default { + error "Unknown state \"$ftp(State)\"" + } + } + + if { $VERBOSE } { + DisplayMsg $s "D: ... Connection from $addr:$port ... initialized" data + } + + # Marker for WaitDataConn + set ftp(AC) 1 + return +} + +############################################################################# +# +# WaitDataConn -- +# Arguments: The ftp connection handle +# Returns: None +# +# Synchronizes the control sequencer to the data connection (active +# mode). This must be placed at the end of all state sequences, +# i.e. the last state of each sequence, dealing with a data +# connection. Without the sync the control sequencer may step to the +# next command causing a very late-coming data connection to encounter +# an unknown state, and failing to establish what to do. +# +# Sync is achieved through the state field AC, in cooperation with the +# procedures OpenActiveConn and InitDataConn. +# +# Missing field => Not an active connection - Ignore +# AC == 0 => OAC has run, IDC not - Wait for IDC, then cleanup +# AC == 1 => OAC has run, IDC as well - No waiting, just cleanup. + +proc ::ftp::WaitDataConn {s} { + variable VERBOSE + upvar ::ftp::ftp$s ftp + + if {$VERBOSE} { DisplayMsg $s WDC|$s|Begin|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ } + + # Passive connection, nothing to do + if {![info exists ftp(AC)]} { + if {$VERBOSE} { DisplayMsg $s WDC|$s|Passive|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ } + return + } + + # InitDataConn has not run yet. Wait! + if {!$ftp(AC)} { + if {$VERBOSE} { DisplayMsg $s WDC|$s|Sync|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ } + vwait ::ftp::ftp${s}(AC) + # assert ftp(AC) == 1 + if {$VERBOSE} { DisplayMsg $s WDC|$s|Synced|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ } + } ; # else: Was run already + + if {$VERBOSE} { DisplayMsg $s WDC|$s|Cleanup|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ } + # InitDataConn has run, clean up and continue + unset ftp(AC) + return +} + +############################################################################# +# +# OpenActiveConn -- +# +# Opens a ftp data connection +# +# Arguments: +# None. +# +# Returns: +# 0 - no connection +# 1 - connection established + +proc ::ftp::OpenActiveConn {s } { + upvar ::ftp::ftp$s ftp + variable VERBOSE + + # Port address 0 is a dummy used to give the server the responsibility + # of getting free new port addresses for every data transfer. + + set rc [catch {set ftp(DummySock) [socket -server [list [namespace current]::InitDataConn $s] 0]} msg] + if { $rc != 0 } { + DisplayMsg $s "$msg" error + return 0 + } + + # prepare local ip address for PORT command (convert pointed format + # to comma format) + + set ftp(LocalAddr) [lindex [fconfigure $ftp(CtrlSock) -sockname] 0] + set ftp(LocalAddr) [string map {. ,} $ftp(LocalAddr)] + + # get a new local port address for data transfer and convert it to a format + # which is useable by the PORT command + + set p [lindex [fconfigure $ftp(DummySock) -sockname] 2] + if { $VERBOSE } { + DisplayMsg $s "D: Port is $p" data + } + set ftp(DataPort) "[expr {$p / 256}],[expr {$p % 256}]" + + # Marker for WaitDataConn + set ftp(AC) 0 + return 1 +} + +############################################################################# +# +# OpenPassiveConn -- +# +# Opens a ftp data connection +# +# Arguments: +# buffer - returned line from server control connection +# +# Returns: +# 0 - no connection +# 1 - connection established + +proc ::ftp::OpenPassiveConn {s buffer} { + upvar ::ftp::ftp$s ftp + + if { [regexp -- {([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)} $buffer all a1 a2 a3 a4 p1 p2] } { + set ftp(LocalAddr) "$a1.$a2.$a3.$a4" + set ftp(DataPort) "[expr {$p1 * 256 + $p2}]" + + # establish data connection for passive mode + + set rc [catch {set ftp(DataSock) [socket $ftp(LocalAddr) $ftp(DataPort)]} msg] + if { $rc != 0 } { + DisplayMsg $s "$msg" error + return 0 + } + + InitDataConn $s $ftp(DataSock) $ftp(LocalAddr) $ftp(DataPort) + return 1 + } else { + return 0 + } +} + +############################################################################# +# +# OpenControlConn -- +# +# Opens a ftp control connection +# +# Arguments: +# s connection id +# block blocking or non-blocking mode +# +# Returns: +# 0 - no connection +# 1 - connection established + +proc ::ftp::OpenControlConn {s {block 1}} { + upvar ::ftp::ftp$s ftp + variable DEBUG + variable VERBOSE + + # open a control channel + + set rc [catch {set ftp(CtrlSock) [socket $ftp(RemoteHost) $ftp(Port)]} msg] + if { $rc != 0 } { + if { $VERBOSE } { + DisplayMsg $s "C: No connection to server!" error + } + if { $DEBUG } { + DisplayMsg $s "[list $msg]" error + } + unset ftp(State) + return 0 + } + + # configure control channel + + fconfigure $ftp(CtrlSock) -buffering line -blocking $block -translation {auto crlf} + fileevent $ftp(CtrlSock) readable [list [namespace current]::StateHandler $s $ftp(CtrlSock)] + + # report ready message + + if { $VERBOSE } { + DisplayMsg $s "C: Connection to $ftp(RemoteHost):$ftp(Port)" control + } + + return 1 +} + +# ::ftp::Command -- +# +# Wrapper for evaluated user-supplied command callback +# +# Arguments: +# cb callback script +# msg what happened +# args additional info +# +# Results: +# Depends on callback script + +proc ::ftp::Command {cb msg args} { + if {[string length $cb]} { + uplevel #0 $cb [list $msg] $args + } +} + +# ================================================================== +# ?????? Hmm, how to do multithreaded for tkcon? +# added TkCon support +# TkCon is (c) 1995-2001 Jeffrey Hobbs, http://tkcon.sourceforge.net/ +# started with: tkcon -load ftp +if { [string equal [uplevel "#0" {info commands tkcon}] "tkcon"] } { + + # new ftp::List proc makes the output more readable + proc ::ftp::__ftp_ls {args} { + set rc [eval [linsert $args 0 ::ftp::List_org]] + foreach i $rc { + puts $i + } + return $rc + } + + # rename the original ftp::List procedure + rename ::ftp::List ::ftp::List_org + + alias ::ftp::List ::ftp::__ftp_ls + alias bye catch {::ftp::Close; exit} + + set ::ftp::VERBOSE 1 + set ::ftp::DEBUG 0 +} + +# ================================================================== +# At last, everything is fine, we can provide the package. + +package provide ftp [lindex {Revision: 2.4.13} 1] diff --git a/tcllib/modules/ftp/ftp_geturl.man b/tcllib/modules/ftp/ftp_geturl.man new file mode 100644 index 0000000..f3cbc06 --- /dev/null +++ b/tcllib/modules/ftp/ftp_geturl.man @@ -0,0 +1,57 @@ +[vset VERSION 0.2.2] +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin ftp::geturl n [vset VERSION]] +[see_also ftpd] +[see_also mime] +[see_also pop3] +[see_also smtp] +[keywords ftp] +[keywords internet] +[keywords net] +[keywords {rfc 959}] +[moddesc {ftp client}] +[titledesc {Uri handler for ftp urls}] +[category Networking] +[require Tcl 8.2] +[require ftp::geturl [opt [vset VERSION]]] +[description] + +This package provides a command which wraps around the client side of +the [term ftp] protocol provided by package [package ftp] to allow the +retrieval of urls using the [term ftp] schema. + +[section API] + +[list_begin definitions] +[call [cmd ::ftp::geturl] [arg url]] + +This command can be used by the generic command [cmd ::uri::geturl] +(See package [package uri]) to retrieve the contents of ftp +urls. Internally it uses the commands of the package [package ftp] to +fulfill the request. + +[para] + +The contents of a [term ftp] url are defined as follows: + +[list_begin definitions] + +[def [term file]] + +The contents of the specified file itself. + +[def [term directory]] + +A listing of the contents of the directory in key value notation where +the file name is the key and its attributes the associated value. + +[def [term link]] + +The attributes of the link, including the path it refers to. + +[list_end] +[list_end] + +[vset CATEGORY ftp] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/ftp/ftp_geturl.tcl b/tcllib/modules/ftp/ftp_geturl.tcl new file mode 100644 index 0000000..d909d4b --- /dev/null +++ b/tcllib/modules/ftp/ftp_geturl.tcl @@ -0,0 +1,135 @@ +# ftp_geturl.tcl -- +# +# Copyright (c) 2001 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# ftp::geturl url + +package require ftp +package require uri + +namespace eval ::ftp { + namespace export geturl +} + +# ::ftp::geturl +# +# Command useable by uri to retrieve the contents of an ftp url. +# Returns the contents of the requested url. + +proc ::ftp::geturl {url} { + # FUTURE: -validate to validate existence of url, but no download + # of contents. + + array set urlparts [uri::split $url] + + if {$urlparts(user) == {}} { + set urlparts(user) "anonymous" + } + if {$urlparts(pwd) == {}} { + set urlparts(pwd) "user@localhost.localdomain" + } + if {$urlparts(port) == {}} { + set urlparts(port) 21 + } + + set fdc [ftp::Open $urlparts(host) $urlparts(user) $urlparts(pwd) \ + -port $urlparts(port)] + if {$fdc < 0} { + return -code error "Cannot reach host for url \"$url\"" + } + + # We have reached the host, now get on to retrieve the item. + # We are very careful in accessing the item because we don't know + # if it is a file, directory or link. So we change into the + # directory containing the item, get a list of all entries and + # then determine if the item actually exists and what type it is, + # and what actions to perform. + + set ftp_dir [file dirname $urlparts(path)] + set ftp_file [file tail $urlparts(path)] + + set result [ftp::Cd $fdc $ftp_dir] + if { $result == 0 } { + ftp::Close $fdc + return -code error "Cannot reach directory of url \"$url\"" + } + + # Fix for the tkcon List enhancements in ftp.tcl + set List ::ftp::List_org + if {[info commands $List] == {}} { + set List ::ftp::List + } + + # The result of List is a list of entries in the given directory. + # Note that it is in 'ls -l format. We parse that into a more + # readable array. + + #array set flist [ftp::ParseList [$List $fdc ""]] + #if {![info exists flist($ftp_file)]} {} + set flist [$List $fdc $ftp_file] + if {$flist == {}} { + ftp::Close $fdc + return -code error "Cannot reach item of url \"$url\"" + } + + # The item exists, what is it ? + # File : Download the contents. + # Directory: Download a listing, this is its contents. + # Link : For now we do not follow the link but return the + # meta information, i.e. the path it is pointing to. + + #switch -exact -- [lindex $flist($ftp_file) 0] {} + switch -exact -- [string index [lindex $flist 0] 0] { + - { + if {[string equal $ftp_file {}]} { + set contents [ftp::NList $fdc $ftp_file] + } else { + ftp::Get $fdc $ftp_file -variable contents + } + } + d { + set contents [ftp::NList $fdc $ftp_file] + } + l { + set contents $flist + } + default { + ftp::Close $fdc + return -code error "File information \"$flist\" not recognised" + } + } + + ftp::Close $fdc + return $contents +} + +# Internal helper to parse a directory listing into something which +# can be better handled by tcl than raw ls -l format. + +proc ::ftp::ParseList {flist} { + array set data {} + foreach item $flist { + foreach {mode dummy owner group size month day yrtime name} $item break + + if {[string first : $yrtime] >=0} { + set date "$month/$day/[clock format [clock seconds] -format %Y] $yrtime" + } else { + set date "$month/$day/$yrtime 00:00" + } + set info [list owner $owner group $group size $size date $date] + + switch -exact -- [string index $mode 0] { + - {set type file} + d {set type dir} + l {set type link ; lappend info link [lindex $item end]} + } + + set data($name) [list $type $info] + } + array get data +} + +# ================================================================== +# At last, everything is fine, we can provide the package. + +package provide ftp::geturl [lindex {Revision: 0.2.2} 1] diff --git a/tcllib/modules/ftp/pkgIndex.tcl b/tcllib/modules/ftp/pkgIndex.tcl new file mode 100644 index 0000000..0155103 --- /dev/null +++ b/tcllib/modules/ftp/pkgIndex.tcl @@ -0,0 +1,3 @@ +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded ftp 2.4.13 [list source [file join $dir ftp.tcl]] +package ifneeded ftp::geturl 0.2.2 [list source [file join $dir ftp_geturl.tcl]] |