💾 Archived View for thrig.me › blog › 2023 › 05 › 10 › slow-echo-server.tcl captured on 2024-07-09 at 00:56:42.

View Raw

More Information

⬅️ Previous capture (2023-05-24)

-=-=-=-=-=-=-

#!/usr/bin/env expect
#
# slow echo server, for when one needs to trickle data slowly to a
# client (possibly to see if that client makes rash assumptions about
# what a read buffer will contain)

package require Tcl 8.5

set host [lindex $argv 0]
set port [lindex $argv 1]
set echo [lindex $argv 2]
set wait [lindex $argv 3]

if {$port eq ""} { set port 7777 }

if {$host eq ""} {
    set sockargs [list handling $port]
} else {
    set sockargs [list handling -myaddr $host $port]
}

if {$echo eq ""} {
    set echo "echo\n"
}

if {$wait eq ""} {
    set wait 1000
}

proc send_char {args} {
    global wait
    set args [lassign $args fh c]
    if {[catch {puts -nonewline $fh $c}]} {
        close $fh
        return
    }
    if {[llength $args] == 0} {
        close $fh
        return
    }
    after $wait send_char $fh $args
}

proc handling {fh host port} {
    global wait echo
    # NOTE this uses the "default system encoding", see chan(n)
    chan configure $fh -buffering none
    after $wait send_char $fh [split $echo ""]
}

if {[catch {socket -server {*}$sockargs} msg]} {
    puts stderr "slow-echo-server: $msg"
    exit 1
}
vwait godot