Tcl Source Code: Artifact [d7b4be29da]

Artifact d7b4be29da04e7e25ab067a29050ee5c4cc69c3a:

Attachment "server" to ticket [413100ffff] added by lewandowski 2001-04-03 14:43:20.

#!/usr/local/bin/tclsh8.4
#
# Server
#

load /usr/local/lib/libthread2.1.so

set Stop 1
set Port 25

set q [open script r]
set script [read $q]
close $q

proc serverOpen {channel addr Port} {
    
    fileevent $channel readable "NewThread $channel $addr"
    puts $channel "Server OK"
    flush $channel
}


proc NewThread {channel addr} {
    global script
    set Skrypt "set channel $channel"
    append Skrypt "\n$script"

    set thread [thread::create]
    thread::transfer $thread $channel
    thread::send -async $thread $Skrypt
}

#
# MAIN
#
socket -server serverOpen $Port

puts "Server port: $Port"
vwait Stop