if {![info exists sock]} { set sock [socket -server connect 7654] } proc connect {sock host port} { fconfigure $sock -blocking 0 -buffering line fileevent $sock readable [list handleSocket $sock] set ::socks($sock) $sock } #disconnect IS NOT BEING USED ANYWHERE proc disconnect {sock args} { set nick $::socks($sock) unset ::socks($sock) close $sock sendText "* $nick has left the chat: [join $args]" } proc handleSocket {sock} { gets $sock line if {[eof $sock]} { unset ::socks($sock) ;#Before closing socket, it needs to be unset. close $sock return } if {$line eq ""} return if {[string index $line 0] eq "/"} { set cmd [split $line] set cmd [linsert $cmd 1 $sock] if {[catch {eval $cmd} error] != 0} { puts $sock "* $error" return } } else { sendText "$::socks($sock): $line" } } proc sendText {text} { foreach s [array names ::socks] { puts $s $text } } proc /msg {sock args} { set found 0 if {[llength $args] < 2} { puts $sock "* usage: /msg nick message" return } set nick [lindex $args 0] set message [join [lrange $args 1 end]] foreach {s n} [array get ::socks] { if {$n eq $nick} { set found 1 break } } if {$found} { puts $s "$::socks($sock) whispers $message" } } proc /nick {sock args} { if {[llength $args] != 1} { puts $sock "* usage: /nick newnick" } else { set newnick [lindex $args 0] set ::socks($sock) $newnick } } proc /who {sock args} { if {[llength $args]} { puts $sock "* usage: /who" } else { set nicks "* nicks:" foreach {_ nick} [array get ::socks] { append nicks " $nick" } } puts $sock $nicks } vwait forever
See also: A little Chat Server