Artifact
7178de1207f9a0c06fd6a33f7299a16e3ff7434a:
Attachment "server2.tcl" to
ticket [1758a0b603]
added by
a3a3el
2014-03-24 10:18:58.
(unpublished)
#!/bin/sh
#\
exec tclsh "$0" "$@"
package require Tcl 8.5
set LINE [string repeat . 1048573]
set WRITE_DELAY 10
set CLOSE_DELAY 850
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
set end [expr { [clock milliseconds] + $::CLOSE_DELAY }]
write_line $client $end
}
proc write_line { client end } {
if { $end < [clock milliseconds] } {
chan close $client
} else {
if { [catch { chan puts $client $::LINE }] } {
chan close $client
} else {
after $::WRITE_DELAY write_line $client $end
}
}
}
proc bgerror msg {
puts stderr "bgerror: $::errorInfo - $msg"
exit 1
}
if { [llength $argv] == 1 } {
start {*}$argv
vwait forever
} else {
exit 1
}
