exec tclsh "$0" "$@"
set state(wait) 1
set state(openSock) {}
source setopt.tcl
source message.tcl
proc evalOptions args {
global state
setopt port 4242
setopt trace 2
setopt chat 0
set state(port) $port
set state(trace) $trace
set state(chat) $chat
message 2 "port: $state(port)"
message 2 "chat: $state(chat)"
}
proc echoData {socket req} {
sendAnswer $socket $req
}
proc chatData {socket req} {
global state
foreach soc $state(openSock) {
sendAnswer $soc $req
}
}
proc sendAnswer {socket ans} {
if {[catch \
{
puts $socket $ans
flush $socket
} err]} {
message 1 "sendAnswer($socket): error: $err"
closeServer $socket
return
}
message 3 "sendAnswer($socket): message written: $ans"
}
proc processRequest {socket} {
if {[catch \
{
set cnt [gets $socket req]
} err]} {
message 1 "processRequest($socket): $err"
set cnt -1
}
if {$cnt == -1} {
closeServer $socket
return
}
message 3 "processRequest($socket): message read: $req"
processData $socket $req
global state
set state(wait) 1
}
proc openServer {socket args} {
global state
message 2 "openServer: install file event on $socket"
lappend state(openSock) $socket
fileevent $socket readable "processRequest $socket"
}
proc closeServer {socket} {
global state
message 2 "closeServer: close socket $socket"
close $socket
set i [lsearch -exact $state(openSock) $socket]
set state(openSock) [lreplace $state(openSock) $i $i]
if {"$state(openSock)" == ""} {
message 2 "closeServer: server idle, no open connections"
}
}
proc initServer {} {
global state
message 2 "initServer: port is $state(port)"
if {[catch {socket -server openServer $state(port)} err]} {
message 1 "initServer failed: $err"
exit
}
}
proc eventLoop {} {
global state
while {1} {
vwait state(wait)
message 3 "eventLoop: do one event"
update
}
}
proc init {} {
global argv state
eval evalOptions $argv
if {$state(chat) == 1} {
rename chatData processData
} else {
rename echoData processData
}
initServer
eventLoop
}
init
