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.
Here is the code I now have
#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}
# Author: [Larry W. Virden] [LV], modified Andreas Kupries [AK]
# Version: 3
package require uri
package require ftp
# Should eventually add a command line argument to toggle verbose
# 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 "error 1: 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] } returncode ] } {
puts stderr [format "error 2: unable to enter directory %s:%s\n" $current(host) $ftp_dir]
continue
}
if { $result == 0 } {
puts stderr [format "error 3: failure to enter %s:%s\n" $current(host) $ftp_dir]
continue
}
ftp::NList $fdc "${ftp_file}*"
ftp::Close $fdc
}
exit