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

  1. proc callback {sock ai} {
  2. global socktest
  3. after cancel $ai
  4. set socktest [chan configure $sock -error]
  5. fileevent $sock writable ""
  6. }
  7.  
  8. proc socktest {host port timeout} {
  9. global socktest
  10. set sock [socket -async $host $port]
  11. chan configure $sock -buffering none -blocking 0
  12. set socktest error
  13. set ai [after $timeout [list set socktest timeout]]
  14. fileevent $sock writable [list callback $sock $ai]
  15. vwait socktest
  16. close $sock
  17. return [expr {$socktest eq ""}]
  18. }
  19.