[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

----
[n0nsense] 
----
I made it a bit better...
Perhaps it will be a concurrent of IRC (some years later) xD

 # constants
 set PORT 5555
 set fname ./Hellomsg.txt
 # reading hello message (file must exist)

 set fHello [open $fname r]; set Hellomsg [read $fHello]; close $fHello; unset fname fHello
 # set Hellomsg "Hello everybody welcome to this chat network" would be altenative but the other thing is more professional... :-)
 # IRC MOTD style :D

 if {![info exists sock]} {
    set sock [socket -server connect $PORT]
  }

...

 # kick is like disconnect but says instead of "left the chat" "kicked from chat"
  proc kick {sock args} {
    set nick $::socks($sock)
    unset ::socks($sock)
    close $sock
    sendText "* $nick has been kicked from chat: [join $args]"
 }

...
 proc handleSocket {sock} {
    gets $sock line
    if {[eof $sock]} {
        sendText "* [set ::socks($sock)] has left the chat: client exited"
        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 /nick {sock args} {
    if {[llength $args] != 1} {
        puts $sock "* usage: /nick newnick"
    } else {
        set newnick [lindex $args 0]
        sendText "* [set ::socks($sock)] is now known as $newnick"
        set ::socks($sock) $newnick
    }
 }

...

  proc /part {sock args} {
     disconnect $sock $args
     }

download here []


----
See also: [A little Chat Server]
----
[[[Category Internet]]]