#!../expect -f
# rftp - ftp a directory hierarchy (i.e. recursive ftp)
# Version 2.10
# Don Libes, NIST
exp_version -exit 5.0

# 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
# as text.

# set default_type ascii
# set binary {*.Z *.tar}

# 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
proc getname {line} {
	# if it's a symbolic link, return local name
	set i [lsearch $line "->"]
	if {-1==$i} {
	     # not a sym link, return last token of line as name
	     return [lindex $line [expr [llength $line]-1]]
	} else {
	     # sym link, return "a" of "a -> b"
	     return [lindex $line [expr $i-1]]
	}
}

proc putfile {name} {
	global current_type default_type
	global binary ascii tenex
	global file_timeout

	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} {
		settype $new_type
	}

	set timeout $file_timeout
	send "put $name\r"
	expect timeout {
		send_user "ftp timed out in response to \"put $name\"\n"
		exit
	} "ftp>*"
}

proc getfile {name} {
	global current_type default_type
	global binary ascii tenex
	global file_timeout

	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} {
		settype $new_type
	}

	set timeout $file_timeout
	send "get $name\r"
	expect timeout {
		send_user "ftp timed out in response to \"get $name\"\n"
		exit
	} "ftp>*"
}

# returns 1 if successful, 0 otherwise
proc putdirectory {name} {
	send "mkdir $name\r"
	expect "550*denied*ftp>*" {
		send_user "failed to make remote directory $name\n"
		return 0
	} timeout {
		send_user "timed out on make remote directory $name\n"
		return 0
	} -re "(257|550.*exists).*ftp>.*"
	# 550 is returned if directory already exists

	send "cd $name\r"
	expect "550*ftp>*" {
		send_user "failed to cd to remote directory $name\n"
		return 0
	} timeout {
		send_user "timed out on cd to remote directory $name\n"
		return 0
	} -re "2(5|0)0.*ftp>.*"
	# some ftp's return 200, some return 250

	send "lcd $name\r"
	# hard to know what to look for, since my ftp doesn't return status
	# codes.  It is evidentally very locale-dependent.
	# So, assume success.
	expect "ftp>*"
	putcurdirectory
	send "lcd ..\r"
	expect "ftp>*"
	send "cd ..\r"
	expect timeout {
		send_user "failed to cd to remote directory ..\n"
		return 0
	} -re "2(5|0)0.*ftp>.*"

	return 1
}

# returns 1 if successful, 0 otherwise
proc getdirectory {name transfer} {
	send "cd $name\r"
	# this can fail normally if it's a symbolic link, and we are just
	# experimenting
	expect "550*ftp>*" {
		send_user "failed to cd to remote directory $name\n"
		return 0
	} timeout {
		send_user "timed out on cd to remote directory $name\n"
		return 0
	} -re "2(5|0)0.*ftp>.*"
	# some ftp's return 200, some return 250

	if $transfer {
		send "!mkdir $name\r"
		expect "denied*" return timeout return "ftp>"
		send "lcd $name\r"
		# hard to know what to look for, since my ftp doesn't return
		# status codes.  It is evidentally very locale-dependent.
		# So, assume success.
		expect "ftp>*"
	}
	getcurdirectory $transfer
	if $transfer {
		send "lcd ..\r"
		expect "ftp>*"
	}
	send "cd ..\r"
	expect timeout {
		send_user "failed to cd to remote directory ..\n"
		return 0
	} -re "2(5|0)0.*ftp>.*"

	return 1
}

proc putentry {name type} {
	switch -- $type \
	d {
		# directory
		if {$name=="." || $name==".."} return
		putdirectory $name
	} - {
		# file
		putfile $name
	} l {
		# symlink, could be either file or directory
		# first assume it's a directory
		if [putdirectory $name] return
		putfile $name
	} default {
		send_user "can't figure out what $name is, skipping\n"
	}
}

proc getentry {name type transfer} {
	switch -- $type \
	d {
		# directory
		getdirectory $name $transfer
	} - {
		# file
		if !$transfer return
		getfile $name
	} l {
		# symlink, could be either file or directory
		# first assume it's a directory
		if [getdirectory $name $transfer] return
		if !$transfer return
		getfile $name
	} default {
		send_user "can't figure out what $name is, skipping\n"
	}
}

proc putcurdirectory {} {
	send "!/bin/ls -alg\r"
	expect timeout {
		send_user "failed to get directory listing\n"
		return
	} "ftp>*"

	set buf $expect_out(buffer)

	for {} 1 {} {
		# if end of listing, succeeded!
		if 0==[regexp "(\[^\n]*)\n(.*)" $buf dummy line buf] return

		set token [lindex $line 0]
		switch -- $token \
		!/bin/ls {
			# original command
		} total {
			# directory header
		} . {
			# unreadable
		} default {
			# either file or directory
			set name [getname $line]
			set type [string index $line 0]
			putentry $name $type
		}
	}
}


# look at result of "dir".  If transfer==1, get all files and directories
proc getcurdirectory {transfer} {
	send "dir\r"
	expect timeout {
		send_user "failed to get directory listing\n"
		return
	} "ftp>*"

	set buf $expect_out(buffer)

	for {} 1 {} {
		regexp "(\[^\n]*)\n(.*)" $buf dummy line buf

		set token [lindex $line 0]
		switch -- $token \
		dir {
			# original command
		} 200 {
			# command successful
		} 150 {
			# opening data connection
		} total {
			# directory header
		} 226 {
			# transfer complete, succeeded!
			return
		} ftp>* {
			# next prompt, failed!
			return
		} . {
			# unreadable
		} default {
			# either file or directory
			set name [getname $line]
			set type [string index $line 0]
			getentry $name $type $transfer
		}
	}
}

proc settype {t} {
	global current_type

	send "type $t\r"
	set current_type $t
	expect "200*ftp>*"
}

proc final_msg {} {
	# write over the previous prompt with our message
	send_user "\rQuit ftp or cd to another directory and press ~g, ~p, or ~l\n"
	# and then reprompt
	send_user "ftp> "
}

if [file readable ~/.rftprc] {source ~/.rftprc}
set first_time 1

if $argc>1 {
	send_user "usage: rftp [host]
	exit
}

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}
interact -echo ~g {
		if $first_time {
			set first_time 0
			settype $default_type
		}
		getcurdirectory 1
		final_msg
} -echo ~p {
		if $first_time {
			set first_time 0
			settype $default_type
		}
		putcurdirectory
		final_msg
} -echo ~l {
		getcurdirectory 0
		final_msg
}