Artifact
9c1a869ab02f11094e24bc4d6dfd5c1421b943a3:
Attachment "echoserv3.tcl" to
ticket [718045ffff]
added by
kenj
2003-04-09 14:34:14.
# ----------------------------------------------------------------------
# FILE: echoserv2.tcl
# DESCRIPTION: A simple example of a multi-threaded server. Accept
# a client connection, then echo back all lines sent by
# the client until EOF or until receiving a line with
# only the string "quit".
#
# The server starts a separate thread for each client that
# connects. Communication with the client in each thread
# continues to be event-driven using fileevent handlers.
# ======================================================================
# Copyright (c) 2000-2002 Kenneth Jones
# ======================================================================
package require Tcl 8.4
package require Thread 2.5
socket -server _ClientConnect 9001
proc _ClientConnect {sock host port} {
# Tcl 8.4 holds a reference to the client socket during this
# callback, so we can't transfer the channel to our worker
# thread immediately. Instead, we'll schedule an after event
# to transfer the channel once we've re-entered the event loop.
after idle [list ClientConnect $sock $host $port]
}
proc ClientConnect {sock host port} {
fconfigure $sock -buffering none -blocking 0
set thread [thread::create {
# Work around bug in Tcl's channel initialization when
# transfering sockets between threads.
close [socket -server {} 0]
thread::wait
}]
thread::send $thread {
proc ReadLine {sock} {
if {[catch {gets $sock line} len] || [eof $sock]} {
catch {close $sock}
thread::release
} elseif {$len >= 0} {
EchoLine $sock $line
}
}
proc EchoLine {sock line} {
if {[string equal -nocase $line quit]} {
SendMessage $sock "Closing connection to Echo server"
catch {close $sock}
thread::release
} else {
SendMessage $sock $line
}
}
proc SendMessage {sock msg} {
if {[catch {puts $sock $msg} error]} {
puts "Error writing to socket: $error"
catch {close $sock}
thread::release
}
}
}
# Transfer the channel to the client's thread
thread::transfer $thread $sock
# Copy the value of the socket ID into the client's thread
thread::send $thread [list set sock $sock]
# Finish the socket setup
thread::send $thread {
fileevent $sock readable {ReadLine $sock}
}
# thread::send -async $thread {
# SendMessage $sock "Welcome to the Echo Server"
#}
}
vwait forever
