diff -r 000000000000 -r 2b3e5ec03512 emulab/simple-ftp.tcl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/emulab/simple-ftp.tcl	Thu Apr 21 14:57:45 2011 +0100
@@ -0,0 +1,328 @@
+#!/usr/bin/tclsh
+
+#
+#    Copyright 2005-2008 Intel Corporation
+# 
+#    Licensed under the Apache License, Version 2.0 (the "License");
+#    you may not use this file except in compliance with the License.
+#    You may obtain a copy of the License at
+# 
+#        http://www.apache.org/licenses/LICENSE-2.0
+# 
+#    Unless required by applicable law or agreed to in writing, software
+#    distributed under the License is distributed on an "AS IS" BASIS,
+#    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#    See the License for the specific language governing permissions and
+#    limitations under the License.
+#
+
+#
+# Simple client/server file transfer protocol
+#
+
+proc usage {} {
+    puts "usage: simple_ftp server [opts]"
+    puts "usage: simple_ftp client <file> <copies> <host> [opts]"
+    exit 1
+}
+
+set port 17600
+set blocksz 1024
+set delay 1000
+set data_timeout 10000
+
+set debug 0
+proc log {msg} {
+    global debug
+    if {$debug} {
+        puts "[clock seconds]: $msg"
+    }
+}
+
+proc start_file {} {
+    global file sent copies
+    if {$sent == $copies} {
+        log "start_file: $sent copies already sent..."
+        return
+    }
+
+    global fd
+    if [info exists fd] {
+        catch {close $fd}
+    }
+    if [catch {
+        set fd [open $file r]
+    } err] {
+        puts "error opening file $file: $err"
+        exit 1
+    }
+
+    global sock host port delay
+    if {! [info exists sock]} {
+	if { [catch {
+            set sock [socket $host $port]
+        } err] } {
+	    puts "[clock seconds]: failed to connect... will try again after $delay ms"
+	    after $delay start_file
+            return
+	}
+        
+	log "connected..."
+	fconfigure $sock -translation binary
+	fconfigure $sock -encoding binary
+        fconfigure $sock -buffering none
+	fconfigure $sock -blocking false
+    }
+
+    # send the header
+    set length [file size $file]
+    puts $sock "[file tail $file] [expr $sent + 1] $length"
+
+    fileevent $sock writable send_data
+    fileevent $sock readable handle_data
+
+    global data_timeout no_data_timer
+    if {$data_timeout != 0 && ![info exists no_data_timer]} {
+        set no_data_timer [after $data_timeout handle_data_timeout]
+    }
+}
+
+proc send_data {} {
+    global sock fd blocksz sent delay
+
+    set data [read $fd $blocksz]
+
+    if {[string length $data] != 0} {
+        log "sending [string length $data] byte chunk"
+        puts -nonewline $sock $data
+    }
+    
+    if [eof $fd] {
+        puts "[clock seconds]: file $sent transmitted"
+        close $fd
+        fileevent $sock writable ""
+        incr sent
+        after $delay start_file
+        return
+    }
+    
+}
+
+proc handle_data {} {
+    global sock
+    if [catch {
+	set data [gets $sock]
+    } err] {
+	log "data arrived but error reading from socket!"
+        close_and_restart
+        return
+    }
+    
+    if {[eof $sock]} {
+	puts "[clock seconds] EOF on socket"
+        close_and_restart
+	return
+    }
+    
+    global data_timeout no_data_timer
+    if {$data_timeout != 0} {
+        after cancel $no_data_timer
+        set no_data_timer [after $data_timeout handle_data_timeout]
+    }
+
+    if {$data == ""} {
+        log "warning: got empty data"
+        return
+    }
+
+    if {$data == "."} {
+        log "KEEPALIVE"
+        return
+    }
+    
+    if {[lindex $data 0] != "ack"} {
+	log "ERROR in ack_arrived: got '$data', expected ack"
+        exit 1
+    }
+    
+    set num [lindex $data 1]
+    puts "[clock seconds]: file $num acked"
+
+    global acked copies
+    if {$num != [expr $acked + 1]} {
+        log "sync error... ack for $num but acked == $acked"
+    }
+
+    set acked $num
+    
+    if {$acked == $copies} {
+        puts "[clock seconds]: all $copies copies sent and acked"
+        exit 0
+    }
+}
+
+
+proc handle_data_timeout {} {
+    puts "[clock seconds]: timeout waiting for incoming data"
+    close_and_restart
+}
+
+proc cleanup_sock {sock} {
+    catch {
+        fileevent $sock writable ""
+        fileevent $sock readable ""
+        close $sock
+    }
+}
+
+proc close_and_restart {} {
+    global sock sent acked no_data_timer delay
+
+    if [info exists sock] {
+        cleanup_sock $sock
+        unset sock
+    }
+    
+    # be careful... at this point we need to change the sent
+    # marker to equal the acked marker so that we properly re-send
+    # the files
+    set sent $acked
+
+    if [info exists no_data_timer] {
+        after cancel $no_data_timer
+        unset no_data_timer
+    }
+
+    after $delay start_file
+}
+
+proc start_server {} {
+    global port
+    puts "[clock seconds]: starting server om port $port..."
+    socket -server "new_client" $port
+}
+
+proc new_client {sock addr port} {
+    puts "[clock seconds]: new client from $addr port $port"
+    
+    fconfigure $sock -translation binary
+    fconfigure $sock -encoding binary
+    fconfigure $sock -blocking false
+    fconfigure $sock -buffering none
+    
+    fileevent $sock readable "header_arrived $sock"
+}
+
+proc header_arrived {sock} {
+    set l [gets $sock]
+    if [eof $sock] {
+        log "eof on socket $sock"
+        fileevent $sock readable ""
+        close $sock
+        return
+    }
+
+    if {$l == ""} {
+        log "warning: got empty line..."
+        return
+    }
+        
+    if {[llength $l] != 3} {
+        log "protocol error: got header line $l"
+        exit 1
+    }
+
+    log "incoming file $l"
+    set file   [lindex $l 0]
+    set num    [lindex $l 1]
+    set length [lindex $l 2]
+
+    set fd [open "$file.$num" w]
+    global todo
+    set todo($sock) $length
+    fileevent $sock readable "data_arrived $sock $file $fd $num $length"
+}
+
+proc data_arrived {sock file fd num length} {
+    global todo
+
+    if [catch {
+        set data [read $sock $todo($sock)]
+    } err] {
+        log "error reading from $sock: $err"
+        cleanup_sock $sock
+        return
+    }
+    
+    if {[eof $sock]} {
+	puts "[clock seconds]: eof on $sock"
+        cleanup_sock $sock
+	return
+    } 
+
+    set rcvd [string length $data]
+    puts -nonewline $fd $data
+
+    incr todo($sock) -$rcvd
+    log "got ${rcvd}/${length} bytes ($todo($sock) todo)"
+
+    if {$todo($sock) < 0} {
+	error "negative todo"
+    }
+    
+    if {$todo($sock) == 0} {
+	puts "[clock seconds] got complete file '$file' copy $num... sending ack"
+	close $fd
+	puts $sock "ack $num"
+	fileevent $sock readable "header_arrived $sock"
+    }
+}
+
+# Define a bgerror proc to print the error stack when errors occur in
+# event handlers
+proc bgerror {err} {
+    global errorInfo
+    puts "tcl error: $err\n$errorInfo"
+}
+
+# ARGS
+set argc [llength $argv]
+if {$argc < 1} {
+    usage
+}
+
+proc parse_opts {opts} {
+    foreach {var val} $opts {
+        if {$var == "-port"} {
+            global port
+            set port $val
+
+        } elseif {$var == "-timeout"} {
+            global data_timeout
+            set data_timeout $val
+
+        } else {
+            error "invalid option $var"
+        }
+    }
+}
+
+set mode [lindex $argv 0]
+if {$mode == "server"} {
+    parse_opts [lrange $argv 1 end]
+    start_server
+} elseif {$mode == "client"} {
+    set file   [lindex $argv 1]
+    set copies [lindex $argv 2]
+    set host   [lindex $argv 3]
+    parse_opts [lrange $argv 4 end]
+
+    set sent  0
+    set acked 0
+    puts "[clock seconds]: client sending $copies copies of $file to $host:$port"
+    start_file
+} else {
+    error "unknown mode $mode"
+}
+
+vwait forever