Updated 2014-11-30 12:11:05 by ente

rmax wrote this server during his presentation at FOSDEM 2004 while the audience wrote chat clients.
 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