mirror.tcl

Go to the documentation of this file.
00001 /* ! /bin/sh*/
00002 /*  -*- tcl -*- \*/
00003 exec tclsh "$0" ${1+"$@"}
00004 
00005 package require Tcl 8.3
00006 package require ftp 2.0
00007 
00008 /*  user configuration*/
00009  server =  noname
00010  username =  anonymous
00011  passwd =  xxxxxx 
00012 
00013 /*  simple progress display*/
00014 ret  ProgressBar (type bytes) {
00015     puts -nonewline stdout "."; flush stdout
00016 }
00017 
00018 /*  recursive file transfer */
00019 ret  GetTree (type conn , optional dir ="") {
00020     catch {file mkdir $dir}
00021     foreach line [ftp::List $conn $dir] {
00022         set rc [scan $line "%s %s %s %s %s %s %s %s %s %s %s" \
00023             perm l u g size d1 d2 d3 name link linksource]
00024     if { ($name == ".") || ($name == "..") } {continue}
00025         set type [string range $perm 0 0]
00026         set name [file join $dir $name]
00027         switch -- $type {
00028             d {GetTree $name}
00029             l {catch {exec ln -s $linksource $name} msg}
00030             - {ftp::Get $conn $name}
00031         }
00032     }
00033 }
00034 
00035 /*  main    */
00036 if {[ conn =  [ftp::Open $server $username $passwd -progress ProgressBar]] != -1} {
00037     GetTree $conn
00038     ftp::Close $conn
00039     puts "OK!"
00040 }
00041 
00042