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