1#! /bin/sh
2# -*- tcl -*- \
3exec tclsh "$0" ${1+"$@"}
4
5package require Tcl 8.3
6package require ftp 2.0
7
8# user configuration
9set server noname
10set username anonymous
11set passwd xxxxxx
12
13# simple progress display
14proc ProgressBar {bytes} {
15    puts -nonewline stdout "."; flush stdout
16}
17
18# recursive file transfer
19proc GetTree {conn {dir ""}} {
20    catch {file mkdir $dir}
21    foreach line [ftp::List $conn $dir] {
22    	set rc [scan $line "%s %s %s %s %s %s %s %s %s %s %s" \
23            perm l u g size d1 d2 d3 name link linksource]
24	if { ($name == ".") || ($name == "..") } {continue}
25        set type [string range $perm 0 0]
26        set name [file join $dir $name]
27        switch -- $type {
28            d {GetTree $name}
29            l {catch {exec ln -s $linksource $name} msg}
30            - {ftp::Get $conn $name}
31        }
32    }
33}
34
35# main
36if {[set conn [ftp::Open $server $username $passwd -progress ProgressBar]] != -1} {
37    GetTree $conn
38    ftp::Close $conn
39    puts "OK!"
40}
41
42