Posted to tcl by aspect at Sun Jun 26 08:25:19 GMT 2011view pretty
package require Tcl 8.6 proc nbsock {args} { set args [lassign $args chan cmd] puts "nbsock $chan $cmd $args" switch -exact $cmd { initialize { return {initialize finalize read write watch} } read { lassign $args id count chan read $chan $count } write { lassign $args id data chan puts -nonewline $chan $data string length $data } finalize { close $chan } default { error "Unsupported subcommand: $cmd" } } } proc echo {sock host port} { while {![chan eof $sock]} { chan puts $sock [chan gets $sock] } } namespace eval clients {} proc handle {sock host port} { puts "Connect: $host:$port" set sock [chan create [list read write] [list nbsock $sock]] yield if {[catch {echo $sock $host $port} result]} { puts "Error: $host:$port: $result" } puts "Closing: $host:$port" if {[catch {close $sock} res]} { puts "Error closing $host:$port: $res" } } 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}