Artifact
99b6e4fd6f024cbcc889601a8d5088ced3f13978:
Attachment "server.tcl" to
ticket [1758a0b603]
added by
a3a3el
2014-03-21 15:11:39.
(unpublished)
#!/bin/sh
#\
exec tclsh "$0" "$@"
package require Tcl 8.5
set LINE [string repeat . 1048573]
set WRITE_DELAY 10
proc start port {
set server [socket -server accept_client $port]
chan configure $server -buffering line
}
proc accept_client { client host port } {
chan configure $client -blocking 0
chan configure $client -buffering line
write_line $client
}
proc write_line client {
if { [catch { chan puts $client $::LINE }] } {
chan close $client
} else {
after $::WRITE_DELAY write_line $client
}
}
proc bgerror msg {
puts stderr "bgerror: $::errorInfo - $msg"
exit 1
}
if { [llength $argv] == 1 } {
start {*}$argv
vwait forever
} else {
exit 1
}
