Artifact
7115298a0b299956d3ccbf3439f0ff7c41b9ea07:
Attachment "client.tcl" to
ticket [1758a0b603]
added by
a3a3el
2014-03-21 15:11:30.
(unpublished)
#!/bin/sh
#\
exec tclsh "$0" "$@"
package require Tcl 8.5
set MAX_CONNS 300
set CONN_DELAY 900
set CLOSE_DELAY 100
proc connect {} {
global host port
if { ![catch { set sock [socket $host $port] } err] } {
after $::CONN_DELAY
incr ::nr_conns
set end [expr { [clock milliseconds] + $::CLOSE_DELAY }]
chan configure $sock -blocking 0
chan configure $sock -buffering line
chan event $sock readable [list read_lines $sock $end]
return 1
} else {
puts stderr $err
return 0
}
}
proc read_lines { sock end } {
global done
if { $end < [clock milliseconds] } {
chan close $sock
if { $::nr_conns < $::MAX_CONNS } {
if { ![connect] } {
set done 1
}
} else {
set done 1
}
} else {
chan gets $sock line
if { [chan eof $sock] } {
chan close $sock
set done 1
}
}
}
proc bgerror msg {
puts stderr "bgerror: $::errorInfo - $msg"
exit 1
}
if { [llength $argv] == 2 } {
lassign $argv ::host ::port
connect
vwait ::done
} else {
exit 1
}
