URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [expect/] [example/] [rftp] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log


#!../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
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [expect/] [example/] [rftp] - Blame information for rev 1774

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