socket-in-thread

package require Thread

proc go {args} {coroutine go#[info cmdcount] {*}$args}
proc yieldm {val} {yieldto string cat $val}

proc asocket {args} {
    set t [thread::create]

    thread::send $t [list set args $args]
    thread::send $t [list set tid [thread::id]]
    thread::send $t [list set callback [info coroutine]]

    thread::send -async $t {
        set rc [catch {socket {*}$args} res opts]
        if {$rc == 0} {thread::transfer $tid $res}              ;# on success, pass the chan back
        thread::send $tid [list {*}$callback $rc $res $opts]    ;# send back the result, including error code
        thread::exit
    }

    lassign [yieldto string cat] rc res opts    ;# wait for a result
    return -code $rc {*}$opts $res              ;# return a socket or error
}

proc connect {args} {
    puts "connecting to $args"
    try {
        set sock [asocket {*}$args]
        puts "connected to $args: $sock"
        close $sock
    } on error {e} {
        puts "connect error $args: $e"
    }
}

proc main {args} {
    foreach {host port} $args {
        go connect $host $port          ;# spawn a coro for each connection
    }
}

proc watch {ms args} {
    set threads {}
    while 1 {
        set r [{*}$args]
        if {$r ne $threads} {
            set threads $r
            puts "Threads: $threads"
        }
        after $ms [info coroutine]
        yield
    }
}

go watch idle thread::names
coroutine Main main {*}$::argv
vwait forever

# $ tclsh sockinthread.tcl abc.net.au 80 www.tcl.tk 80 localhost 80 ghhg.deokde 123
# Threads: tid0x7f8b1734f680
# connecting to abc.net.au 80
# connecting to www.tcl.tk 80
# connecting to localhost 80
# connecting to ghhg.deokde 123
# connect error localhost 80: couldn't open socket: connection refused
# Threads: tid0x7f8b029dc700 tid0x7f8b031dd700 tid0x7f8b03fff700 tid0x7f8b091fd700 tid0x7f8b1734f680
# Threads: tid0x7f8b029dc700 tid0x7f8b03fff700 tid0x7f8b091fd700 tid0x7f8b1734f680
# connect error ghhg.deokde 123: couldn't open socket: Name or service not known
# Threads: tid0x7f8b03fff700 tid0x7f8b091fd700 tid0x7f8b1734f680
# connected to www.tcl.tk 80: sock7f8afc065fb0
# Threads: tid0x7f8b091fd700 tid0x7f8b1734f680
# connected to abc.net.au 80: sock7f8b0405c010
# Threads: tid0x7f8b1734f680