Attachment "481161.diff.2" to
ticket [481161ffff]
added by
andreas_kupries
2001-11-20 03:54:03.
? 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 <[email protected]>
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 <[email protected]>
+
+ * 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 <[email protected]>
+
+ * ftp.tcl, ftp.n: Implemented and documented FR #481161.
* ftp.tcl: Applied patch #428053 provided by Sreangsu Acharyya
<[email protected]>. 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 {}}
