? modules/ftp/test_ftpchan.tcl
? modules/ftp/example
? modules/ftpd/examples
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.85
diff -u -r1.85 ChangeLog
--- ChangeLog	2001/11/17 00:13:00	1.85
+++ ChangeLog	2001/11/19 20:23:25
@@ -6,7 +15,7 @@
 
 	* ftp, uri: Implemented FR #476804.
 
-	* ftp: Applied patch #428053.
+	* ftp: Applied patch #428053. Implemented FR #481161.
 
 2001-11-12  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
 
Index: examples/ftpd/ftpd.test
===================================================================
RCS file: ftpd.test
diff -N ftpd.test
--- /dev/null	Thu May 24 22:33:05 2001
+++ ftpd.test	Mon Nov 19 12:23:25 2001
@@ -0,0 +1,36 @@
+#!/bin/sh 
+# FTP daemon for testing the ftp client (modules/ftp).
+# -*- tcl -*- \
+exec tclsh8.3 "$0" ${1+"$@"}
+
+package require ftpd
+package require log
+
+proc bgerror {args} {
+    global errorInfo
+    puts stderr "bgerror: [join $args]"
+    puts stderr $errorInfo
+}
+
+proc ftplog {level text} {
+    if {[string equal $level note]} {set level notice}
+    log::log $level $text
+}
+
+proc noauth {args} {
+    return 1
+}
+
+proc fakefs {cmd path args} {
+    # Use the standard unix fs, i.e. "::ftpd::fsFile::fs", but rewrite the incoming path
+    # to stay in the /tmp directory.
+
+    set path [file join / tmp [file tail $path]]
+    eval [linsert $args 0 ::ftpd::fsFile::fs $cmd $path]
+}
+
+::ftpd::config -logCmd ftplog -authUsrCmd noauth -authFileCmd noauth -fsCmd fakefs
+set ::ftpd::port 7777 ; # Listen on user port
+
+::ftpd::server
+vwait forever
Index: modules/ftp/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftp/ChangeLog,v
retrieving revision 1.20
diff -u -r1.20 ChangeLog
--- modules/ftp/ChangeLog	2001/11/17 00:13:00	1.20
+++ modules/ftp/ChangeLog	2001/11/19 20:23:25
@@ -1,4 +1,12 @@
+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
Index: modules/ftp/ftp.n
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftp/ftp.n,v
retrieving revision 1.5
diff -u -r1.5 ftp.n
--- modules/ftp/ftp.n	2001/11/17 00:13:00	1.5
+++ modules/ftp/ftp.n	2001/11/19 20:23:25
@@ -39,11 +39,11 @@
 .sp
 \fBftp::Rename\fR \fIhandle\fR \fIfrom\fR \fIto\fR\fR
 .sp
-\fBftp::Put\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR) ?\fIremote\fR?\fR
+\fBftp::Put\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR | -channel \fIchan\fR) ?\fIremote\fR?\fR
 .sp
-\fBftp::Append\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR) ?\fIremote\fR?\fR
+\fBftp::Append\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR | -channel \fIchan\fR) ?\fIremote\fR?\fR
 .sp
-\fBftp::Get\fR \fIhandle\fR \fIremote\fR ?(\fIlocal\fR | -variable \fIvarname\fR)?\fR
+\fBftp::Get\fR \fIhandle\fR \fIremote\fR ?(\fIlocal\fR | -variable \fIvarname\fR | -channel \fIchan\fR)?\fR
 .sp
 \fBftp::Reget\fR \fIhandle\fR \fIremote\fR ?\fIlocal\fR? ?\fIfrom\fR? ?\fIto\fR?\fR
 .sp
@@ -282,7 +282,7 @@
 The command returns 1 if the specified file was successfully renamed
 or 0 if it failed.
 .TP
-\fBftp::Put\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR) ?\fIremote\fR?\fR
+\fBftp::Put\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR | -channel \fIchan\fR) ?\fIremote\fR?\fR
 This command transfers a local file \fIlocal\fR to a remote file
 \fIremote\fR on the ftp server. If the file parameters passed to the
 command do not fully qualified path names the command will use the
@@ -294,13 +294,19 @@
 If \fB-data \fIdata\fR\fR is specified instead of a local file,
 the system will not transfer a file, but the \fIdata\fR passed into
 it. In this case the name of the remote file has to be specified.
+.sp
+If \fB-channel \fIchan\fR\fR is specified instead of a local file, the
+system will not transfer a file, but read the contents of the channel
+\fIchan\fR and write this to the remote file. In this case the name of
+the remote file has to be specified. After the transfer \fIchan\fR
+will be closed.
 .TP
-\fBftp::Append\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR) ?\fIremote\fR?\fR
+\fBftp::Append\fR \fIhandle\fR (\fIlocal\fR | -data \fIdata\fR | -channel \fIchan\fR) ?\fIremote\fR?\fR
 This command behaves like \fBftp::Puts\fR, but appends the transfered
 information to the remote file. If the file did not exist on the
 server it will be created.
 .TP
-\fBftp::Get\fR \fIhandle\fR \fIremote\fR ?(\fIlocal\fR | -variable \fIvarname\fR)?\fR
+\fBftp::Get\fR \fIhandle\fR \fIremote\fR ?(\fIlocal\fR | -variable \fIvarname\fR | -channel \fIchan\fR)?\fR
 This command retrieves a remote file \fIremote\fR on the ftp server
 and stores its contents into the local file \fIlocal\fR. If the file
 parameters passed to the command do not fully qualified path names the
@@ -312,6 +318,11 @@
 If \fB-variable \fIvarname\fR\fR is specified, the system will
 store the retrieved data into the variable \fIvarname\fR instead of a
 file.
+.sp
+If \fB-channel \fIchan\fR\fR is specified, the system will write the
+retrieved data into the channel \fIchan\fR instead of a file. The
+system will \fBnot\fR close \fIchan\fR after the transfer, this is the
+responsibility of the caller to \fBGet\fR.
 .TP
 \fBftp::Reget\fR \fIhandle\fR \fIremote\fR ?\fIlocal\fR? ?\fIfrom\fR? ?\fIto\fR?\fR
 This command behaves like \fBftp::Get\fR, except that if local file
Index: modules/ftp/ftp.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/ftp/ftp.tcl,v
retrieving revision 1.20
diff -u -r1.20 ftp.tcl
--- modules/ftp/ftp.tcl	2001/11/17 00:13:00	1.20
+++ modules/ftp/ftp.tcl	2001/11/19 20:23:25
@@ -26,15 +26,29 @@
 #			ftp::ModTime <s> <from> <to>
 #			ftp::Delete <s> <file>
 #			ftp::Rename <s> <from> <to>
-#			ftp::Put <s> <(local | -data "data"> <?remote?>
-#			ftp::Append <s> <(local | -data "data"> <?remote?>
-#			ftp::Get <s> <remote> <?(local | -variable varname)?>
+#			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.
@@ -1664,7 +1678,8 @@
         return 0
     }
     if {([llength $args] < 1) || ([llength $args] > 4)} {
-        DisplayMsg $s "wrong # args: should be \"ftp::Put handle (-data \"data\" | localFilename) remoteFilename\"" error
+        DisplayMsg $s \
+		"wrong # args: should be \"ftp::Put handle (-data \"data\" | -channel chan | localFilename) remoteFilename\"" error
 	return 0    
     }
 
@@ -1678,43 +1693,56 @@
         } 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\" | localFilename) remoteFilename\"" error
+            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 file to Put" error
+        DisplayMsg $s "Must specify a valid data source to Put" error
         return 0
     }        
 
     set ftp(RemoteFilename) $dest
 
-    if {$ftp(inline)} {
+    if {$ftp(inline) == 1} {
         set ftp(PutData) $source
         if { $dest == "" } {
             set dest ftp.tmp
         }
         set ftp(RemoteFilename) $dest
     } else {
-        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
+	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
-        set ftp(SourceCI) [open $ftp(LocalFilename) r]
         if { [string equal $ftp(Type) "ascii"] } {
             fconfigure $ftp(SourceCI) -buffering line -blocking 1
         } else {
@@ -1766,7 +1794,7 @@
     }
 
     if {([llength $args] < 1) || ([llength $args] > 4)} {
-        DisplayMsg $s "wrong # args: should be \"ftp::Append handle (-data \"data\" | localFilename) remoteFilename\"" error
+        DisplayMsg $s "wrong # args: should be \"ftp::Append handle (-data \"data\" | -channel chan | localFilename) remoteFilename\"" error
         return 0
     }
 
@@ -1780,44 +1808,57 @@
         } 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\" | localFilename) remoteFilename\"" error
+            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 file to Append" error
+        DisplayMsg $s "Must specify a valid data source to Append" error
         return 0
     }   
 
     set ftp(RemoteFilename) $dest
 
-    if {$ftp(inline)} {
+    if {$ftp(inline) == 1} {
         set ftp(PutData) $source
         if { $dest == "" } {
             set dest ftp.tmp
         }
         set ftp(RemoteFilename) $dest
     } else {
-        set ftp(PutData) ""
-        if { ![file exists $source] } {
-            DisplayMsg $s "File \"$source\" not exist" error
-            return 0
-        }
+	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]
-        }
+	    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(LocalFilename) $source
+	    set ftp(SourceCI) $source
+	    set ftp(inline) 0
+	}
         set ftp(RemoteFilename) $dest
 
-        set ftp(SourceCI) [open $ftp(LocalFilename) r]
         if { [string equal $ftp(Type) "ascii"] } {
             fconfigure $ftp(SourceCI) -buffering line -blocking 1
         } else {
@@ -1868,7 +1909,7 @@
     }
 
     if {([llength $args] < 1) || ([llength $args] > 4)} {
-        DisplayMsg $s "wrong # args: should be \"ftp::Get handle remoteFile ?(-variable varName | localFilename)?\"" error
+        DisplayMsg $s "wrong # args: should be \"ftp::Get handle remoteFile ?(-variable varName | -channel chan | localFilename)?\"" error
 	return 0    
     }
 
@@ -1883,60 +1924,81 @@
         } elseif {($flags) && ([string equal $arg "-variable"])} {
             set ftp(inline) 1
             set ftp(filebuffer) ""
-	} elseif {($ftp(inline)) && ([string equal $varname "**NONE**"])} {
+        } 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 | localFilename)?\"" error
+?(-variable varName | -channel chan | localFilename)?\"" error
 	    return 0
         }
     }
 
-    if {($ftp(inline)) && ($dest != "")} {
+    if {($ftp(inline) != 0) && ($dest != "")} {
         DisplayMsg $s "Cannot return data in a variable, and place it in destination file." error
         return 0
     }
 
     if {$source == ""} {
-        DisplayMsg $s "Must specify a valid file to Get" error
+        DisplayMsg $s "Must specify a valid data source to Get" error
         return 0
     }
 
-    if { $dest == "" } {
-        set dest $source
-    } else {
-        if {[file isdirectory $dest]} {
-            set dest [file join $dest [file tail $source]]
-        }
+    if {$ftp(inline) != 2} {
+	if { $dest == "" } {
+	    set dest $source
+	} else {
+	    if {[file isdirectory $dest]} {
+		set dest [file join $dest [file tail $source]]
+	    }
+	}
+	set ftp(LocalFilename) $dest
     }
 
     set ftp(RemoteFilename) $source
-    set ftp(LocalFilename) $dest
 
+    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)}
         return 1
     } else {
         if {$ftp(inline)} {
+	    catch {unset ftp(get:channel)}
             return ""
 	}
         CloseDataConn $s
+	catch {unset ftp(get:channel)}
         return 0
     }
 }
@@ -2391,13 +2453,23 @@
     }
 
     if { $error != "" } {
-        catch {close $ftp(DestCI)}
+	# 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)}
         unset ftp(state.data)
         DisplayMsg $s $error error
 
     } elseif { ([eof $ftp(SourceCI)] || ($blocksize <= 0)) } {
-        close $ftp(DestCI)
+	# 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)
         unset ftp(state.data)
         if { $VERBOSE } {
@@ -2432,7 +2504,16 @@
     # create local file for ftp::Get 
 
     if { [regexp -- "^get" $ftp(State)]  && (!$ftp(inline))} {
-        set rc [catch {set ftp(DestCI) [open $ftp(LocalFilename) w]} msg]
+
+	# A channel was specified by the caller. Use that instead of a
+	# file.
+
+	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
@@ -2603,6 +2684,14 @@
 #
 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 {after cancel $ftp(Wait)}
     catch {fileevent $ftp(DataSock) readable {}}
