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}