Purpose: demonstrate use of uri and ftp in a tcl script.
Goal: when provided a series of ftp based URLs on the command line, return info to the user as to whether the URLs exist or not.
This might be useful for someone maintaining a database of web resources for instance!
One problem was in the default definition of DisplayMsg. It is used to display state information (if ftp::VERBOSE is set). It also causes the system to throw errors if there are connection errors, instead of reporting them back as defined.
use
set ftp::VERBOSE
after the package require ftp to get a tracing of what the internal engine does. To disable the handling of errors redefine ftp::DisplayMsg' with your own code.
New Problem: the following code generates this output:
$ tclsh ~/xyz/tstftp.tcl ftp://ftp.neosoft.com/languages/tcl/alcatel/code/calc.tk.gz C: Connection from 206.138.231.4:21 C: 220 shockwave2.neosoft.com FTP server (Version wu-2.6.1(1) Mon Jul 31 10:44:05 CDT 2000) ready. C: 331 Guest login ok, send your complete e-mail address as password. C: 230 User ftp logged in. Access restrictions apply. C: 200 Type set to I. C: 550 languages/tcl/alcatel/code: No such file or directory. Error changing directory to " languages/tcl/alcatel/code"
unable to enter languages/tcl/alcatel/code
What I was expecting was the very last line - the previous output from the ftp server I was not expecting.
AK: change the DisplayMsg to supress the output of error messages (error branch in the switch), or set VERBOSE to 0 to supress all the output.
Here is the code I now have
#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}
# Author: [Larry W. Virden] [LV], modified Andreas Kupries [AK]
# Modified again by [LV]
package require uri
package require ftp
set ftp::VERBOSE 1
proc ftp::DisplayMsg {s msg {state ""}} {
upvar ::ftp::ftp$s ftp
variable VERBOSE
switch -exact -- $state {
data {
if { $VERBOSE } { puts $msg }
}
control {
if { $VERBOSE } { puts $msg }
}
error {
if { $VERBOSE } { puts $msg }
#error "ERROR: $msg"
}
default {
if { $VERBOSE } { puts $msg }
}
}
return
}
foreach arg $argv {
array set current [uri::split $arg]
# parray current
if { [ catch { set fdc [ftp::Open $current(host) anonymous [email protected]] } returncode ] } {
puts stderr [format "unable to open %s\n" $$current(host)]
continue
}
set ftp_dir [file dirname $current(path)]
set ftp_file [file tail $current(path)]
if { [ catch { set result [ftp::Cd $fdc $ftp_dir] } return ] } {
puts stderr [format "unable to enter %s\n" $ftp_dir]
continue
}
if { $result == 0 } {
puts stderr [format "unable to enter %s\n" $ftp_dir]
continue
}
ftp::NList $fdc "${ftp_file}*"
ftp::Close $fdc
}
exit