archie/tcl-dp/examples/ftp/client.tcl

##########################################################
# 
# A trivial file transfer layer on top of DP.
#	mperham 3/97
# 
# Assumes a server has been started with "fserver"
# and a client connected to that server via "fconnect"
#
# The user interface:
#
#    fconnect $host {$port} - open an RPC connection to host:port
#			    and a data connection to host:port-1
#			    port is optional
#    fget $filename - copy remote file, $filename, to local machine.
#    fput $filename - copy local file, $filename, to remote machine.
#    fdel $filename - delete a remote file named $filename
#    fdir - remote directory listing
#    fpwd - print current remote directory
#    fcd - change remote directory
#
# Problems:
#
#    Minimal error handling at best.  Need to catch more.
#

package require dp 4.0

#//////////////////////////////////////

proc oops {errMsg} {
    puts stdout "Remote server returned error:"
    puts stdout "$errMsg"
}

#//////////////////////////////////////

proc fget {filename} {
    global f_chan dataPort host 

# Make data channel
# On server side

    if [catch {
        dp_RPC $f_chan eval {set dataServ [dp_connect tcp -server 1 -myport} $dataPort {]}
        dp_RDO $f_chan eval {set dataSC [dp_accept $dataServ]}
    } msg] {
        puts stdout "Error opening dataServer socket (fget): $msg"
        close $f_chan
        return
    }

# And on Client side
    
    if [catch {
        set dataClient [dp_connect tcp -host $host -port $dataPort]
    } msg] {
        puts stdout "Error connecting to dataServer socket: $msg"
        close $f_chan
        return
    }

# Tell server to send file

    dp_RPC $f_chan eval {set srcFile [open} $filename {r]}
    dp_RPC $f_chan eval {dp_send [lindex $dataSC 0] [dp_recv $srcFile]}

# Open output file on client
    set destfile [open $filename {CREAT WRONLY}]
	
	puts stdout "Getting $filename from remote host."

# Put all coming stuff to $newfile and close it

    dp_send $destfile [dp_recv $dataClient]
    close $destfile

# First close the Client, before you close the server !!

    close $dataClient

# Close Server now 
    dp_RPC $f_chan eval {close $srcFile}
    dp_RPC $f_chan eval {close [lindex $dataSC 0]}
    dp_RPC $f_chan eval {close $dataServ}
}

#//////////////////////////////////////

proc fput {filename} {
    global f_chan dataPort host

# Make data channel
# On server side

    if [catch {
        dp_RPC $f_chan eval {set dataServ [dp_connect tcp -server 1 -myport} $dataPort {]}
        dp_RDO $f_chan eval {set dataSC [dp_accept $dataServ]}
    } msg] {
        puts stdout "Error opening dataServer socket (fput): $msg"
        close $f_chan
        return
    }

# And on client side

    if [catch {
        set dataClient [dp_connect tcp -host $host -port $dataPort]
    } msg] {
        puts stdout "Error connecting to dataServer socket: $msg"
        close $f_chan
        return
    }

# Sending on client side (local) 
    set srcfile [open $filename r]
    puts stdout "Putting $filename to remote host."
    dp_send $dataClient [dp_recv $srcfile]

# Tell server to recv file

    dp_RPC $f_chan eval {set destFile [open} $filename {w]}
    dp_RPC $f_chan eval {dp_send $destFile [dp_recv [lindex $dataSC 0]]}

#Close client BEFORE you close Server !!

    close $dataClient
    close $srcfile

# Now close Server
    dp_RPC $f_chan eval {close $destFile}
    dp_RPC $f_chan eval {close [lindex $dataSC 0]}
    dp_RPC $f_chan eval {close $dataServ}

}

#//////////////////////////////////////

proc fpwd {} {
    global f_chan

    dp_RPC $f_chan if {$tcl_platform(platform) == "windows"} {cmd.exe /c cd} else { pwd }
}

#//////////////////////////////////////

proc fdir {} {
    global f_chan

# I think this will be broken for filenames with spaces.
# The foreach will think they are different files.

    foreach a [dp_RPC $f_chan glob \*] {
	puts $a
    }
}

#//////////////////////////////////////

proc fdel {filename} {
    global f_chan

    dp_RPC $f_chan file delete $filename
}

#//////////////////////////////////////

proc fcd {dir} {
    global f_chan

    dp_RDO $f_chan -onerror oops cd $dir
}

#//////////////////////////////////////

proc fquit {} {
    global f_chan

    close $f_chan
}

#//////////////////////////////////////
# We need to open one channel on each side; the
# the data channel - $dataClient here, $dataSC on the server -
# will be created each time we send or recv a file
# since we can't send normal data over an RPC channel.

proc fconnect {host_add {port 19743}} {
    global f_chan dataPort host

	set host $host_add
    set f_chan [dp_MakeRPCClient $host $port]
    puts stdout "Connected to $host..."
    puts stdout "Channel: $f_chan"
    set dataPort [incr port -1]
    
    puts stdout "--------- Directory Listing ----------"
    fdir
    puts stdout "--------- Remote Directory -----------"
    fpwd
}