Posted to tcl by schelte at Sat May 10 13:57:18 GMT 2014view raw

  1. proc cosocket {args} {
  2. set coro [info coroutine]
  3. if {$coro eq ""} {tailcall socket {*}$args}
  4. set sock [socket -async {*}$args]
  5. fileevent $sock writable [list [info coroutine] cosock]
  6. while {[yield] ne "cosock"} {}
  7. fileevent $sock writable {}
  8. set err [fconfigure $sock -error]
  9. if {$err eq ""} {
  10. # Success
  11. return $sock
  12. }
  13. switch -- $err {
  14. "connection refused" {
  15. set perror ECONNREFUSED
  16. }
  17. "host is unreachable" {
  18. set perror EHOSTUNREACH
  19. }
  20. default {
  21. set perror EUNKNOWN
  22. }
  23. }
  24. close $sock
  25. throw [list POSIX $perror $err] "couldn't open socket: $err"
  26. }
  27.  
  28. ::http::register http 80 cosocket
  29.