exec expect
-f "$0" ${1+"$@"}
# rftp - ftp a directory hierarchy (i.e. recursive ftp)
# rftp is much like ftp except that the command ~g copies everything in
# the remote current working directory to the local current working
# directory. Similarly ~p copies in the reverse direction. ~l just
# lists the remote directories.
# rftp takes an argument of the host to ftp to. Username and password
# are prompted for. Other ftp options can be set interactively at that
# time. If your local ftp understands .netrc, that is also used.
# ~/.rftprc is sourced after the user has logged in to the remote site
# and other ftp commands may be sent at that time. .rftprc may also be
# used to override the following rftp defaults. The lines should use
# the same syntax as these:
set file_timeout
3600 ;# timeout (seconds) for retrieving files
set timeout
1000000 ;# timeout (seconds) for other ftp dialogue
set default_type binary
;# default type, i.e., ascii, binary, tenex
set binary
{} ;# files matching are transferred as binary
set ascii
{} ;# as above, but as ascii
set tenex
{} ;# as above, but as tenex
# The values of binary, ascii and tenex should be a list of (Tcl) regular
# expressions. For example, the following definitions would force files
# ending in *.Z and *.tar to be transferred as binaries and everything else
# If you are on a UNIX machine, you can probably safely ignore all of this
# and transfer everything as "binary".
# The current implementation requires that the source host be able to
# provide directory listings in UNIX format. Hence, you cannot copy
# from a VMS host (although you can copy to it). In fact, there is no
# standard for the output that ftp produces, and thus, ftps that differ
# significantly from the ubiquitous UNIX implementation may not work
# with rftp (at least, not without changing the scanning and parsing).
####################end of documentation###############################
match_max
-d 100000 ;# max size of a directory listing
# return name of file from one line of directory listing
# if it's a symbolic link, return local name
set i
[lsearch
$line "->"]
# not a sym link, return last token of line as name
return [lindex
$line [expr [llength
$line]-1]]
# sym link, return "a" of "a -> b"
return [lindex
$line [expr $i-1]]
global current_type default_type
global binary ascii tenex
switch
-- $name $binary {set new_type binary
} \
$ascii {set new_type ascii
} \
$tenex {set new_type tenex
} \
default
{set new_type
$default_type}
if {$current_type != $new_type} {
set timeout
$file_timeout
send_user
"ftp timed out in response to \"put $name\"\n"
global current_type default_type
global binary ascii tenex
switch
-- $name $binary {set new_type binary
} \
$ascii {set new_type ascii
} \
$tenex {set new_type tenex
} \
default
{set new_type
$default_type}
if {$current_type != $new_type} {
set timeout
$file_timeout
send_user
"ftp timed out in response to \"get $name\"\n"
# returns 1 if successful, 0 otherwise
proc putdirectory
{name
} {
expect
"550*denied*ftp>*" {
send_user
"failed to make remote directory $name\n"
send_user
"timed out on make remote directory $name\n"
} -re "(257|550.*exists).*ftp>.*"
# 550 is returned if directory already exists
send_user
"failed to cd to remote directory $name\n"
send_user
"timed out on cd to remote directory $name\n"
# some ftp's return 200, some return 250
# hard to know what to look for, since my ftp doesn't return status
# codes. It is evidentally very locale-dependent.
send_user
"failed to cd to remote directory ..\n"
# returns 1 if successful, 0 otherwise
proc getdirectory
{name transfer
} {
# this can fail normally if it's a symbolic link, and we are just
expect
"550*$name*ftp>*" {
send_user
"failed to cd to remote directory $name\n"
send_user
"timed out on cd to remote directory $name\n"
# some ftp's return 200, some return 250
expect
"denied*" return timeout
return "ftp>"
# hard to know what to look for, since my ftp doesn't return
# status codes. It is evidentally very locale-dependent.
getcurdirectory
$transfer
send_user
"failed to cd to remote directory ..\n"
proc putentry
{name
type} {
if {$name=="." ||
$name==".."} return
# symlink, could be either file or directory
# first assume it's a directory
if {[putdirectory
$name]} return
send_user
"can't figure out what $name is, skipping\n"
proc getentry
{name
type transfer
} {
if {$name=="." ||
$name==".."} return
getdirectory
$name $transfer
# symlink, could be either file or directory
# first assume it's a directory
if {[getdirectory
$name $transfer]} return
send_user
"can't figure out what $name is, skipping\n"
proc putcurdirectory
{} {
send_user
"failed to get directory listing\n"
set buf
$expect_out(buffer
)
# if end of listing, succeeded!
if 0==[regexp
"(\[^\n]*)\n(.*)" $buf dummy line buf
] return
set token
[lindex
$line 0]
switch
-- $token !/bin
/ls {
# either file or directory
set type [string index
$line 0]
# look at result of "dir". If transfer==1, get all files and directories
proc getcurdirectory
{transfer
} {
send_user
"failed to get directory listing\n"
set buf
$expect_out(buffer
)
regexp
"(\[^\n]*)\n(.*)" $buf dummy line buf
set token
[lindex
$line 0]
# opening data connection
# transfer complete, succeeded!
# either file or directory
set type [string index
$line 0]
getentry
$name $type $transfer
# write over the previous prompt with our message
send_user
"\rQuit ftp or cd to another directory and press ~g, ~p, or ~l\n"
if {[file readable ~
/.rftprc
]} {source ~
/.rftprc
}
send_user
"usage: rftp [host]"
send_user
"Once logged in, cd to the directory to be transferred and press:\n"
send_user
"~p to put the current directory from the local to the remote host\n"
send_user
"~g to get the current directory from the remote host to the local host\n"
send_user
"~l to list the current directory from the remote host\n"
if {$argc==0} {spawn
ftp} else {spawn
ftp $argv}