Posted to tcl by schelte at Sat May 10 13:57:18 GMT 2014view raw
- proc cosocket {args} {
- set coro [info coroutine]
- if {$coro eq ""} {tailcall socket {*}$args}
- set sock [socket -async {*}$args]
- fileevent $sock writable [list [info coroutine] cosock]
- while {[yield] ne "cosock"} {}
- fileevent $sock writable {}
- set err [fconfigure $sock -error]
- if {$err eq ""} {
- # Success
- return $sock
- }
- switch -- $err {
- "connection refused" {
- set perror ECONNREFUSED
- }
- "host is unreachable" {
- set perror EHOSTUNREACH
- }
- default {
- set perror EUNKNOWN
- }
- }
- close $sock
- throw [list POSIX $perror $err] "couldn't open socket: $err"
- }
- ::http::register http 80 cosocket