[OpenSPARC-T2-SAM] / sam-t2 / devtools / amd64 / bin / rftp

#!/bin/sh
# \
exec expect -f "$0" ${1+"$@"}
# 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*$name*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
	if {$name=="." || $name==".."} return
	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)

    while {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)

    while {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
}
Commit	Line	Data
920dae64 AT	1	#!/bin/sh
	2	# \
	3	exec expect -f "$0" ${1+"$@"}
	4	# rftp - ftp a directory hierarchy (i.e. recursive ftp)
	5	# Version 2.10
	6	# Don Libes, NIST
	7	exp_version -exit 5.0
	8
	9	# rftp is much like ftp except that the command ~g copies everything in
	10	# the remote current working directory to the local current working
	11	# directory. Similarly ~p copies in the reverse direction. ~l just
	12	# lists the remote directories.
	13
	14	# rftp takes an argument of the host to ftp to. Username and password
	15	# are prompted for. Other ftp options can be set interactively at that
	16	# time. If your local ftp understands .netrc, that is also used.
	17
	18	# ~/.rftprc is sourced after the user has logged in to the remote site
	19	# and other ftp commands may be sent at that time. .rftprc may also be
	20	# used to override the following rftp defaults. The lines should use
	21	# the same syntax as these:
	22
	23	set file_timeout 3600 ;# timeout (seconds) for retrieving files
	24	set timeout 1000000 ;# timeout (seconds) for other ftp dialogue
	25	set default_type binary ;# default type, i.e., ascii, binary, tenex
	26	set binary {} ;# files matching are transferred as binary
	27	set ascii {} ;# as above, but as ascii
	28	set tenex {} ;# as above, but as tenex
	29
	30	# The values of binary, ascii and tenex should be a list of (Tcl) regular
	31	# expressions. For example, the following definitions would force files
	32	# ending in .Z and .tar to be transferred as binaries and everything else
	33	# as text.
	34
	35	# set default_type ascii
	36	# set binary {.Z .tar}
	37
	38	# If you are on a UNIX machine, you can probably safely ignore all of this
	39	# and transfer everything as "binary".
	40
	41	# The current implementation requires that the source host be able to
	42	# provide directory listings in UNIX format. Hence, you cannot copy
	43	# from a VMS host (although you can copy to it). In fact, there is no
	44	# standard for the output that ftp produces, and thus, ftps that differ
	45	# significantly from the ubiquitous UNIX implementation may not work
	46	# with rftp (at least, not without changing the scanning and parsing).
	47
	48	####################end of documentation###############################
	49
	50	match_max -d 100000 ;# max size of a directory listing
	51
	52	# return name of file from one line of directory listing
	53	proc getname {line} {
	54	# if it's a symbolic link, return local name
	55	set i [lsearch $line "->"]
	56	if {-1==$i} {
	57	# not a sym link, return last token of line as name
	58	return [lindex $line [expr [llength $line]-1]]
	59	} else {
	60	# sym link, return "a" of "a -> b"
	61	return [lindex $line [expr $i-1]]
	62	}
	63	}
	64
65	proc putfile {name} {
66	global current_type default_type
67	global binary ascii tenex
68	global file_timeout
69
70	switch -- $name $binary {set new_type binary} \
71	$ascii {set new_type ascii} \
72	$tenex {set new_type tenex} \
73	default {set new_type $default_type}
74
75	if {$current_type != $new_type} {
76	settype $new_type
77	}
78
79	set timeout $file_timeout
80	send "put $name\r"
81	expect timeout {
82	send_user "ftp timed out in response to \"put $name\"\n"
83	exit
84	} "ftp>*"
85	}
86
87	proc getfile {name} {
88	global current_type default_type
89	global binary ascii tenex
90	global file_timeout
91
92	switch -- $name $binary {set new_type binary} \
93	$ascii {set new_type ascii} \
94	$tenex {set new_type tenex} \
95	default {set new_type $default_type}
96
97	if {$current_type != $new_type} {
98	settype $new_type
99	}
100
101	set timeout $file_timeout
102	send "get $name\r"
103	expect timeout {
104	send_user "ftp timed out in response to \"get $name\"\n"
105	exit
106	} "ftp>*"
107	}
108
109	# returns 1 if successful, 0 otherwise
110	proc putdirectory {name} {
111	send "mkdir $name\r"
112	expect "550deniedftp>*" {
113	send_user "failed to make remote directory $name\n"
114	return 0
115	} timeout {
116	send_user "timed out on make remote directory $name\n"
117	return 0
118	} -re "(257\|550.exists).ftp>.*"
119	# 550 is returned if directory already exists
120
121	send "cd $name\r"
122	expect "550ftp>" {
123	send_user "failed to cd to remote directory $name\n"
124	return 0
125	} timeout {
126	send_user "timed out on cd to remote directory $name\n"
127	return 0
128	} -re "2(5\|0)0.ftp>."
129	# some ftp's return 200, some return 250
130
131	send "lcd $name\r"
132	# hard to know what to look for, since my ftp doesn't return status
133	# codes. It is evidentally very locale-dependent.
134	# So, assume success.
135	expect "ftp>*"
136	putcurdirectory
137	send "lcd ..\r"
138	expect "ftp>*"
139	send "cd ..\r"
140	expect timeout {
141	send_user "failed to cd to remote directory ..\n"
142	return 0
143	} -re "2(5\|0)0.ftp>."
144
145	return 1
146	}
147
148	# returns 1 if successful, 0 otherwise
149	proc getdirectory {name transfer} {
150	send "cd $name\r"
151	# this can fail normally if it's a symbolic link, and we are just
152	# experimenting
153	expect "550$nameftp>*" {
154	send_user "failed to cd to remote directory $name\n"
155	return 0
156	} timeout {
157	send_user "timed out on cd to remote directory $name\n"
158	return 0
159	} -re "2(5\|0)0.ftp>."
160	# some ftp's return 200, some return 250
161
162	if {$transfer} {
163	send "!mkdir $name\r"
164	expect "denied*" return timeout return "ftp>"
165	send "lcd $name\r"
166	# hard to know what to look for, since my ftp doesn't return
167	# status codes. It is evidentally very locale-dependent.
168	# So, assume success.
169	expect "ftp>*"
170	}
171	getcurdirectory $transfer
172	if {$transfer} {
173	send "lcd ..\r"
174	expect "ftp>*"
175	}
176	send "cd ..\r"
177	expect timeout {
178	send_user "failed to cd to remote directory ..\n"
179	return 0
180	} -re "2(5\|0)0.ftp>."
181
182	return 1
183	}
184
185	proc putentry {name type} {
186	switch -- $type d {
187	# directory
188	if {$name=="." \|\| $name==".."} return
189	putdirectory $name
190	} - {
191	# file
192	putfile $name
193	} l {
194	# symlink, could be either file or directory
195	# first assume it's a directory
196	if {[putdirectory $name]} return
197	putfile $name
198	} default {
199	send_user "can't figure out what $name is, skipping\n"
200	}
201	}
202
203	proc getentry {name type transfer} {
204	switch -- $type d {
205	# directory
206	if {$name=="." \|\| $name==".."} return
207	getdirectory $name $transfer
208	} - {
209	# file
210	if {!$transfer} return
211	getfile $name
212	} l {
213	# symlink, could be either file or directory
214	# first assume it's a directory
215	if {[getdirectory $name $transfer]} return
216	if {!$transfer} return
217	getfile $name
218	} default {
219	send_user "can't figure out what $name is, skipping\n"
220	}
221	}
222
223	proc putcurdirectory {} {
224	send "!/bin/ls -alg\r"
225	expect timeout {
226	send_user "failed to get directory listing\n"
227	return
228	} "ftp>*"
229
230	set buf $expect_out(buffer)
231
232	while {1} {
233	# if end of listing, succeeded!
234	if 0==[regexp "(\[^\n])\n(.)" $buf dummy line buf] return
235
236	set token [lindex $line 0]
237	switch -- $token !/bin/ls {
238	# original command
239	} total {
240	# directory header
241	} . {
242	# unreadable
243	} default {
244	# either file or directory
245	set name [getname $line]
246	set type [string index $line 0]
247	putentry $name $type
248	}
249	}
250	}
251
252	# look at result of "dir". If transfer==1, get all files and directories
253	proc getcurdirectory {transfer} {
254	send "dir\r"
255	expect timeout {
256	send_user "failed to get directory listing\n"
257	return
258	} "ftp>*"
259
260	set buf $expect_out(buffer)
261
262	while {1} {
263	regexp "(\[^\n])\n(.)" $buf dummy line buf
264
265	set token [lindex $line 0]
266	switch -- $token dir {
267	# original command
268	} 200 {
269	# command successful
270	} 150 {
271	# opening data connection
272	} total {
273	# directory header
274	} 226 {
275	# transfer complete, succeeded!
276	return
277	} ftp>* {
278	# next prompt, failed!
279	return
280	} . {
281	# unreadable
282	} default {
283	# either file or directory
284	set name [getname $line]
285	set type [string index $line 0]
286	getentry $name $type $transfer
287	}
288	}
289	}
290
291	proc settype {t} {
292	global current_type
293
294	send "type $t\r"
295	set current_type $t
296	expect "200ftp>"
297	}
298
299	proc final_msg {} {
300	# write over the previous prompt with our message
301	send_user "\rQuit ftp or cd to another directory and press ~g, ~p, or ~l\n"
302	# and then reprompt
303	send_user "ftp> "
304	}
305
306	if {[file readable ~/.rftprc]} {source ~/.rftprc}
307	set first_time 1
308
309	if {$argc>1} {
310	send_user "usage: rftp [host]"
311	exit
312	}
313
314	send_user "Once logged in, cd to the directory to be transferred and press:\n"
315	send_user "~p to put the current directory from the local to the remote host\n"
316	send_user "~g to get the current directory from the remote host to the local host\n"
317	send_user "~l to list the current directory from the remote host\n"
318
319	if {$argc==0} {spawn ftp} else {spawn ftp $argv}
320	interact -echo ~g {
321	if {$first_time} {
322	set first_time 0
323	settype $default_type
324	}
325	getcurdirectory 1
326	final_msg
327	} -echo ~p {
328	if {$first_time} {
329	set first_time 0
330	settype $default_type
331	}
332	putcurdirectory
333	final_msg
334	} -echo ~l {
335	getcurdirectory 0
336	final_msg
337	}