#!/usr/bin/tclsh
proc server_handle {cid addr} {
global eventloop
global socketlist
global nicklist
if {[gets $cid requeststring] < 0} {
set cidposition [lsearch $socketlist $cid]
if {$cidposition >= 0} {
set socketlist [lreplace $socketlist $cidposition $cidposition]
set nicklist [lreplace $nicklist $cidposition $cidposition]
}
close $cid
puts "Connection brocken on $cid"
} else {
puts "Request from $addr\($cid\): $requeststring"
if {[regexp "^(DOWN|SHUT|LIST|CONN|DCON|MESG) *(.*)$" $requeststring requeststring request mesg] == 1} {
puts "Executing $request\($mesg\)"
switch $request {
DOWN {
if {[llength $socketlist] == 0} {
set eventloop "done"
}
}
SHUT {
set eventloop "done"
}
LIST {
foreach element $nicklist {
puts $cid $element
}
}
CONN {
if {[lsearch $socketlist $cid] == -1} {
lappend socketlist $cid
lappend nicklist $mesg
}
}
DCON {
set cidposition [lsearch $socketlist $cid]
if {$cidposition >= 0} {
set socketlist [lreplace $socketlist $cidposition $cidposition]
set nicklist [lreplace $nicklist $cidposition $cidposition]
}
}
MESG {
set cidposition [lsearch $socketlist $cid]
if {$cidposition >= 0} {
foreach element $socketlist {
puts $element "\[[lindex $nicklist $cidposition]\] $mesg"
}
}
}
}
}
}
}
proc server_accept {cid addr port} {
fileevent $cid readable "server_handle $cid $addr"
fconfigure $cid -buffering line
puts "Connection from $addr\($port\) established on $cid"
}
socket -server server_accept 9020
set socketlist [list]
set nicklist [list]
puts "Server started"
vwait eventloop
puts "Server stopped"