#/bin/sh
 # \
 exec tclsh "$0" ${1+"$@"}
 
 # --- server.tcl --- A server that does not do much
 
 # Configure a socket for use with a relay link
 
 proc ConfigureSocket { fd } {
 
        global Connections
 
        fconfigure $fd -blocking 0 -buffering $Connections(Buffering) -buffersize $Connections(BufSize) -translation binary
        return $fd
        }
 
 # Handle a new client connection
 
 proc HandleClientConnect { client address port } {
 
        global Connections
 
        ConfigureSocket $client
        fileevent $client readable "CopyClientData $client"
 
        puts stdout "server: Connected from $address on $port\n"
 
        set Connections($client,Start) [clock clicks -milliseconds]
        set Connections($client,Count) 0
        }
 
 
 # Disconnect a link
 
 proc Disconnect { fd } {
 
        global Connections
 
        if { ![catch { fileevent $fd readable {} }] } {
                close $fd
                }
        }
 
 # Handle a disconnection
 
 proc HandleClientDisconnect { fd } {
 
        global Connections
 
        set Connections($fd,End) [clock clicks -milliseconds]
 
        set time [expr $Connections($fd,End) - $Connections($fd,Start)]
 
        set speed [expr $Connections($fd,Count)/$time]
 
        puts "Transferred $Connections($fd,Count) bytes in [expr $Connections($fd,End) - $Connections($fd,Start)] milliseconds."
        puts "Transfer rate is $speed KBytes/sec"
 
        Disconnect $fd
        }
 
 # Copy data between the source and destination channels
 
 proc CopyClientData { from } {
 
        global Connections
 
        set line [read $from 1500]
        if { ! [eof $from] } {
                if { [string range $line 0 3] == "mode" } {
                        puts stdout [string range $line 0 32]
                        }
 #              puts stdout "server: $line"
                incr Connections($from,Count) [string length $line]
        } else {
                if [eof $from] {
                        puts "server: $from Client disconnected!"
                        HandleClientDisconnect $from
                        }
                }
        }
 
 if { 0 } {
        wm title . "Server ..."
 
        catch { destroy .f }
 
        set f [frame .f]
        button $f.b -width 8 -text Quit -command exit
 
        pack $f.b -side left
        pack $f
 
 }
 
 # Some default options
 
 set Connections(Port) 14210
 set Connections(Buffering) full
 set Connections(BufSize) 10000
 
 # Process the parameter list
 
 foreach { key opt } $argv {
        switch -exact -- [string tolower $key] {
 
 
 "-p"                   -
 "-port"                        {       set Connections(Port) $opt      }
 
 "-b"                   -
 "-buffering"           {       set Connections(Buffering) $opt }
 
 "-s"                   -       set Connections(Buffering) $opt }
 "-size"                        {       set Connections(BufSize) $opt   }
 
 default                        {       puts stderr "Keyword $key is not supported!"     $Connections($fd,Start)] milliseconds."
                                exit
                                }
                        }       }
        }
 
 catch { close $Connections(Server) }
 
 set Connections(Server) [socket -server HandleClientConnect $Connections(Port)]
 
 set forever 1
 
 vwait forever
 
 exit

----
[rdt] There appears to be an error in the above script.  Probably a transcription error.  There is no opening brace on the '''-s''' line of the '''foreach'''.  Also appears to be an error in the '''default''' code section.
----
[Category Networking] |
[Category Performance]