Posted to tcl by aspect at Sun Jun 26 04:35:18 GMT 2011view pretty
namespace eval echo { proc gets {args} { if {[info coroutine] == ""} { return [::gets {*}$args] } else { set sock [lindex $args end] after cancel [info coroutine] timeout after 2000 [info coroutine] timeout while {[set data [::gets $sock]] == ""} { if {[eof $sock]} { return {} #return -code error "EOF on $sock" } switch -exact [yield] { timeout { return -code error "timeout" } close { return -code error "forced close" } } } return $data } } proc echo {sock host port} { puts "echo starting" while {![eof $sock]} { puts $sock [gets $sock] puts "echoing" } } } namespace eval clients {} proc handle {sock host port} { puts "new connection from $host:$port" after 2000 [info coroutine] timeout yield if {[catch {echo::echo $sock $host $port} result]} { puts "Error handling $host:$port: $result" } catch {close $sock} puts "connection closed $host:$port" } proc accept {sock host port} { coroutine clients::$host:$port handle $sock $host $port chan configure $sock -blocking 0 -buffering line chan event $sock readable clients::$host:$port } socket -server accept 1234 if {!$::tcl_interactive} {vwait forever}