Posted to tcl by rmax at Mon Nov 29 17:47:25 GMT 2010view pretty

proc callback {sock ai} {
    global socktest
    after cancel $ai
    set socktest [chan configure $sock -error]
    fileevent $sock writable ""
}

proc socktest {host port timeout} {
    global socktest
    set sock [socket -async $host $port]
    chan configure $sock -buffering none -blocking 0
    set socktest error
    set ai [after $timeout [list set socktest timeout]]
    fileevent $sock writable [list callback $sock $ai]
    vwait socktest
    close $sock
    return [expr {$socktest eq ""}]
}