[Shootout-list] Tcl: tcp-echo

[Robert Seeger]

Below is my submission for the tcp-echo test for Tcl.

Robert Seeger

proc main {argv} {
    if { [llength $argv] == 2} {
        doChild [lindex $argv 1]
    } else {
        socket -server Server 9900

        set fd [open "|[info script] Child [lindex $argv 0]" r]
        vwait ::forever

        while { [gets $fd line] >= 0 } {
            puts $line
        }
        exit
    }
}

proc Server {channel clientaddr clientport} {
    set reply [string repeat x 64]
    fconfigure $channel -buffering none

    while { ![eof $channel] } {
        read $channel 64
        puts -nonewline $channel $reply
    }
    set ::forever 1
}

proc doChild {num} {
    set request [string repeat x 64]

    set bytes 0
    set replies 0

    set fd [socket localhost 9900]
    fconfigure $fd -buffering none
    
    set num [expr {$num * 6400}]
    while { [incr num -1] >= 0 } {
        puts -nonewline $fd $request
        incr bytes [string length [read $fd 64]]
        incr replies
    }
    
    close $fd
    puts "replies: $replies\tbytes: $bytes"
    exit
}

main $argv