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