source: data/Media/tcl/irk/lib/irkreceive.tcl @ 5065

# irkreceive.tcl:
#
# Various commands invoked in response to input received from the server:

namespace eval irk {

    # This procedure deals with the PING special action:

    proc RECV,PING {token nick user comm dest rest} {
        variable state

        if {[catch {set sock $state($token,socket)}]} {
            error "$token: not a valid IRK connection"
        }
        puts $sock "PONG :$comm $rest"

        return ""
    }

    # This procedure deals with the NOTICE special action:

    proc RECV,NOTICE {token nick user comm dest rest} {
        variable state

        append state($token,GLOBALNOTICES) "$rest\n"

        return ""
    }


    # This procedure deals with the ERROR special action:

    proc RECV,ERROR {token nick user comm dest rest} {
        variable state

        set rest [eval concat $rest]
        append state($token,ERRORS) "$nick $dest $rest\n"
        puts "Got ERROR: $token $nick ---> $dest: $rest"

        return ""
    }

    # This procedure deals with the AWAY response:

    proc RECV,AWAY {token nick user comm dest rest} {
        set id [lindex $rest 0]
        set rest [lrange $rest 1 end]
        set rest [lreplace $rest 0 0 [string range [lindex $rest 0] 1 end]]
        set rest [eval concat $rest]
        puts "$id is away: $rest"

        return ""
    }
    
    # This procedure deals with the WHOIS USER message:

    proc RECV,WHOIS,NICK,USER {token nick user comm dest rest} {
        variable state

        # Split the rest of the line on space:

        foreach {unick uuser uhost ustar urnm} [split $rest " "] break

        # If the WHOIS information is about this user, save it specially:

        if {[isus $token $unick]} {
            set state($token,uuser)     $uuser
            set state($token,uhost)     $uhost
            set state($token,urnm)      $urnm
        }

        # Save the information for a regular user:

        set state($token,ident,$unick,uuser)    $uuser
        set state($token,ident,$unick,uhost)    $uhost
        set state($token,ident,$unick,urnm)     $urnm
    }

    # This procedure deals with the WHOIS SERVER message:

    proc RECV,WHOIS,NICK,SERVER {token nick user comm dest rest} {
        variable state

        # Split the rest of the line on space:

        foreach {unick userv} [split $rest " "] break

        # If the WHOIS information is about this user, save it specially:

        if {[isus $token $unick]} {
            set state($token,userv) $userv
        }

        # Save the information for a regular user:

        set state($token,ident,$unick,userv) $userv
    }

    # This procedure deals with the WHOIS IDENT message

    proc RECV,WHOIS,NICK,IDENT {token nick user comm dest rest} {
        variable state

        # Extract the nick of the user who has identified

        set unick [lindex [split $rest " "] 0]

        # If the WHOIS information is about this user, save it specially:

        if {[isus $token $unick]} {
            set state($token,ident) 1
        }

        # Save the information for a regular user:

        set state($token,ident,$unick,ident) 1
    }   

    # This procedure deals with the WHOIS CONNECTTIME message:

    proc RECV,WHOIS,NICK,CONNECTTIME {token nick user comm dest rest} {
        variable state

        # Split the rest of the input on space:

        foreach {unick idle connecttime} [split $rest " "] break

        # Format the connect time for this user:

        set connecttime [clock format $connecttime]

        # If the WHOIS information is about this user, save it specially:

        if {[isus $token $unick]} {
            set state($token,connecttime) $connecttime
        }

        # Save the information for a regular user:

        set state($token,ident,$unick,connecttime) $connecttime
    }

    # Handle the WHOIS CHANNELS message:

    proc RECV,WHOIS,NICK,CHANNELS {token nick user comm dest rest} {
        variable state

        # Split the rest on space.

        set rest [split $rest " "]

        # Get the nick for which this is the channel list:

        set unick [lindex $rest 0]
        set rest [lrange $rest 1 end]

        # The first channel may have an extra ":", if it does get rid of it.

        set firstchan [lindex $rest 0]
        if {[string match ":*" $firstchan]} {
            set rest [lreplace $rest 0 0 [string range $firstchan 1 end]]
        }

        # If the WHOIS information is about this user, save it specially:

        if {[isus $token $unick]} {
            set state($token,channels) $channels
        }

        # Save the information for a regular user:

        set state($token,ident,$unick,channels) $rest
    }

    # This procedure deals with the WHOIS END message:

    proc RECV,WHOIS,NICK,END {token nick user comm dest rest} {
        variable state

        set state($token,whois,done) 1
    }

    # This procedure deals with various MOTD actions:

    proc RECV,MOTD {token nick user comm dest rest} {
        variable state

        append state($token,MOTD) "${rest}\n"

        return ""
    }

    # This procedure deals with PONG actions:

    proc RECV,PONG {token nick user comm dest rest} {
        variable state

        if {[info exists state($token,PINGSTART)]} {
            set elapsed \
                [expr [clock clicks -millis] - $state($token,PINGSTART)]
            puts "$nick: $elapsed msecs"
            unset state($token,PINGSTART)
        }

        return ""
    }

    # This procedure deals with NOTICE received from a regular user:

    proc RECV,NOTICE,USER {token nick user comm dest rest} {
        if {[string match "\001*" [lindex $rest 0]]} {
            set rest [ctcpcleanup $rest]
            RECV,NOTICE,CTCP,USER $token $nick $user $comm $dest \
                    [lindex $rest 0] [lrange $rest 1 end]
        } else {
            set rest [eval concat $rest]
            puts "$nick sends $dest a notice: $rest"
        }

        return ""
    }

    # This procedure helps with CTCP notice actions:

    proc RECV,NOTICE,CTCP,USER {token nick user comm dest action rest} {
        variable state

        if {[info exists state($token,response,ctcp,$action)]} {
            $state($token,response,ctcp,$action) \
                                        $token $nick $user $comm $dest \
                                        $action $rest
        } else {
            $state($token,response,ctcp,error) \
                                        $token $nick $user $comm $dest \
                                        $action $rest
        }

        return ""
    }

    # This procedure deals with JOIN actions:

    proc RECV,JOIN {token nick user comm dest rest} {
        variable state

        # Check if it's us that joined the channel or someone else.

        if {[isus $token $nick]} {
            puts "You joined $dest"

            addChannel $token $dest
        } else {
            puts "$nick joined $dest"

            addToChannel $token $nick $dest
        }

        return ""
    }

    # This procedure deals with PART actions:

    proc RECV,PART {token nick user comm dest rest} {
        variable state

        set chan [string tolower $dest]

        if {[isus $token $nick]} {
            puts "You left channel $chan"
        } else {
            puts "$nick left [string tolower $dest]"
        }           
        removeFromChannel $token $nick $chan
        removeFromChannel $token @$nick $chan

        return ""
    }

    # This procedure deals with MODE actions:

    proc RECV,MODE {token nick user comm dest rest} {
        set rest [eval concat $rest]
        puts "$nick sets mode $dest $rest"

        return ""
    }

    # This procedure deals with NICK actions:

    proc RECV,NICK {token nick user comm dest rest} {
        variable state

        set newnick [string range $dest 1 end]

        # If our nick changed, remember it as the nick associated with
        # this connection:

        if {[isus $token $nick]} {
            set state($token,nick) $newnick
            set state($token,$newnick,PRIVMSG)  $state(PRIVMSG,unsolicited)
            catch {unset state($token,$nick,PRIVMSG)}
        }

        # Replace the old nick with the new in all channels that we're on:

        replaceAllChannels $token $nick $newnick

        puts "$nick ${user} ($token) changes his/her nickname to $newnick"

        return ""
    }

    # This procedure deals with QUIT actions:

    proc RECV,QUIT {token nick user comm dest rest} {
        variable state

        set rest [eval concat $rest]
        puts "Received QUIT $token $nick $rest"

        if {[string match ":*" $dest]} {
            set dest [string range $dest 1 end]
        }
        if {[isus $token $nick]} {
            puts "You left the server $state($token,host) ($dest $rest)"
            forgetConnection $token
        } else {
            puts "$nick quits IRK ($dest $rest)"
            removeFromAllChannels $token $nick
            removeFromAllChannels $token @$nick
        }

        return ""
    }

    # This procedure deals with expected PRIVMSG actions:

    proc RECV,PRIVMSG {token nick user comm dest rest} {
        if {[string match "\001*" [lindex $rest 0]]} {
            set rest [ctcpcleanup $rest]
            RECV,PRIVMSG,CTCP,CHANNEL $token $nick $user $comm $dest \
                    [lindex $rest 0] [lrange $rest 1 end]
        } else {
            puts "$nick$dest: [eval concat $rest]"
        }

        return ""
    }

    # This procedure handles CTCP actions on the channel:

    proc RECV,PRIVMSG,CTCP,CHANNEL {token nick user comm dest action rest} {
        variable state

        if {[info exists state($token,channel,ctcp,$action)]} {
            $state($token,channel,ctcp,$action) \
                                        $token $nick $user $comm $dest \
                                        $action $rest
        } else {
            $state($token,channel,ctcp,error) \
                                        $token $nick $user $comm $dest \
                                        $action $rest
        }

        return ""
    }

    # This procedure stores the result of USERHOST actions:

    proc RECV,USERHOST {token nick user comm dest rest} {
        return ""
    }

    # This procedure stores the channel topic:

    proc RECV,CHANNEL,TOPIC {token nick user comm dest rest} {
        variable state

        set chan [lindex $rest 0]
        set rest [lrange $rest 1 end]
        if {[string match ":*" [lindex $rest 0]]} {
            set rest [lreplace $rest 0 0 \
                               [string range [lindex $rest 0] 1 end]]
        }
        set state($token,$chan,TOPIC) $rest
        set state($token,$chan,TOPIC,SETBY) $nick
        set state($token,$chan,TOPIC,SETAT) [clock format [clock seconds]]

        return ""
    }

    # This procedure stores the channel byline:

    proc RECV,CHANNEL,SETBY {token nick user comm dest rest} {
        variable state

        set chan [lindex $rest 0]
        set rest [lrange $rest 1 end]
        if {[string match ":*" [lindex $rest 0]]} {
            set rest [lreplace $rest 0 0 \
                               [string range [lindex $rest 0] 1 end]]
        }
        set state($token,$chan,TOPIC,SETBY) [lindex $rest 0]
        set state($token,$chan,TOPIC,SETAT) [clock format [lindex $rest 1]]

        return ""
    }

    # This procedure deals with unsolicited PRIVMSG actions:

    proc RECV,PRIVMSG,unsolicited {token nick user comm dest rest} {
        if {[string match "\001*" [lindex $rest 0]]} {
            set rest [ctcpcleanup $rest]
            RECV,PRIVMSG,CTCP,USER $token $nick $user $comm $dest \
                    [lindex $rest 0] [lrange $rest 1 end]
        } else {
            puts "$nick: [eval concat $rest]"
        }

        return ""
    }

    # This procedure helps with CTCP private messages:

    proc RECV,PRIVMSG,CTCP,USER {token nick user comm dest action rest} {
        variable state

        if {[info exists state($token,cmd,ctcp,$action)]} {
            $state($token,cmd,ctcp,$action) \
                                        $token $nick $user $comm $dest \
                                        $action $rest
        } else {
            $state($token,cmd,ctcp,error) \
                                        $token $nick $user $comm $dest \
                                        $action $rest
        }

        return ""
    }

    # This procedure deals with a KICK action:

    proc RECV,KICK {token nick user comm dest rest} {
        set kicked [lindex $rest 0]
        if {[string match ":*" $kicked]} {
            set kicked [string range $kicked 1 end]
        }
        set reason [eval concat [lrange $rest 1 end]]
        if {[string match ":*" $reason]} {
            set reason [string range $reason 1 end]
        }

        if {[isus $token $kicked]} {
            puts "$nick kicked you from $dest because $reason"

            removeChannel $token $dest
        } else {
            puts "$nick kicks $kicked from $dest because $reason"

            removeFromChannel $token $kicked $dest
            removeFromChannel $token @$kicked $dest
        }

        return ""
    }

    # These procedures collect the name list for a channel:

    proc RECV,CHANNEL,NAMELIST {token nick user comm dest rest} {
        variable state

        # Scan forward in $rest for the channel name:

        for {set i 0; set l [llength $rest]} {$i < $l} {incr i} {
            if {[string match "#*" [lindex $rest $i]]} {
                break
            }
        }

        # Didn't find it?

        if {$i == $l} {
            return
        }

        # Extract the channel name and the rest of the input:

        set chan [lindex $rest $i]
        set rest [lrange $rest [expr $i + 1] end]
        set rest [lreplace $rest 0 0 [string range [lindex $rest 0] 1 end]]
        set rest [eval concat $rest]

        if {![info exists state($token,$chan,NAMES)]} {
            set state($token,$chan,NAMES) ""
        }
        set state($token,$chan,NAMES) [concat $state($token,$chan,NAMES) $rest]

        return ""
    }

    proc RECV,CHANNEL,NAMELIST,END {token nick user comm dest rest} {
        variable state

        set chan [lindex $rest 0]
        set $state($token,$chan,NAMES) [split $state($token,$chan,NAMES) " "]
    }

    # This procedure deals with a request from the server to send a PONG
    # with a given code.

    proc RECV,PONG,REQUEST {token nick user comm dest rest} {
        set pongcode [lindex $rest [expr [llength $rest] - 1]]
        puts $token "PONG $pongcode"

        return ""
    }

    # This procedure deals with a CTCP PING request:

    proc RECV,CTCP,PING {token nick user comm dest action rest} {
        variable state

        if {[catch {set sock $state($token,socket)}]} {
            error "$token: not a valid IRK connection"
        }
        puts $sock "NOTICE $nick :\001PING ${rest}\001"

        return ""
    }

    # This procedure deals with a CTCP TIME request:

    proc RECV,CTCP,TIME {token nick user comm dest action rest} {
        variable state

        if {[catch {set sock $state($token,socket)}]} {
            error "$token: not a valid IRK connection"
        }
        puts $sock \
            "NOTICE $nick :\001TIME :[clock format [clock seconds]]\001"

        return ""
    }

    # This procedure deals with a CTCP VERSION request:

    proc RECV,CTCP,VERSION {token nick user comm dest action rest} {
        variable state
        global tcl_platform

        if {[catch {set sock $state($token,socket)}]} {
            error "$token: not a valid IRK connection"
        }
        set version "$state(-useragent):$state(-version):$tcl_platform(os)"
        puts $sock "NOTICE $nick :\001VERSION ${version}\001"
    }

    # This procedure deals with a CTCP USERINFO request:

    proc RECV,CTCP,USERINFO {token nick user comm dest action rest} {
        variable state

        if {[catch {set sock $state($token,socket)}]} {
            error "$token: not a valid IRK connection"
        }
        puts $sock "NOTICE $nick :\001USERINFO $state(-$token,user)\001"
    }

    # This procedure deals with CTCP ACTION messages:

    proc RECV,CTCP,ACTION {token nick user comm dest action rest} {
        puts "$nick $rest"

        return ""
    }

    # This procedure is a catch all for CTCP actions that we do not
    # understand:

    proc RECV,CTCP,ERROR {token nick user comm dest action rest} {
        variable state

        if {[catch {set sock $state($token,socket)}]} {
            error "$token: not a valid IRC connection"
        }
        if {[llength $rest] > 0} {
            puts $sock \
                "NOTICE $nick :\001ERRMSG $action $rest: unknown CTCP\001"
        } else {
            puts $sock "NOTICE $nick :\001ERRMSG $action: unknown CTCP\001"
        }
    }

    # This is the default action, used by the default dispatcher
    # when no action can be found for the given $token, $nick, $user,
    # $comm, and $dest.

    proc defaultAction {token nick user comm dest rest} {
        puts "$token: $nick $user: $comm -> $dest ... [eval concat $rest]"

        return ""
    }
}