#!/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