chiark / gitweb /
Add people to the relevant chan_nicks when they join. New leave channel manager...
[ircbot] / bot.tcl
diff --git a/bot.tcl b/bot.tcl
index 9d5457b6590e2a34deda62602c4a9a52ec1979a4..5bbaeb02ae224e51e29ab24c00421f4ddeb61574 100755 (executable)
--- a/bot.tcl
+++ b/bot.tcl
@@ -90,7 +90,7 @@ proc out_runqueue {now} {
        set out_queue [lrange $out_queue 1 end]
        if {[llength $out_queue]} {
            append orgwhen "+[expr {$now - $orgwhen}]"
-           append orgwhen ([llength $out_queue])"
+           append orgwhen "([llength $out_queue])"
        }
        puts "$orgwhen -> $msg"
        puts $sock $msg
@@ -200,7 +200,7 @@ proc onread {args} {
     }
     if {"$command" == "PRIVMSG" &&
         [regexp {^[&#+!]} [lindex $params 0]] &&
-        ![regexp {^!} [lindex $params 1]]} {
+        ![regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} {
        # on-channel message, ignore
        catch {
            recordlastseen_p $prefix "talking on [lindex $params 0]" 1
@@ -413,7 +413,31 @@ proc recordlastseen_n {n how here} {
        msendprivmsg_delayed 1000 $n $ml
     }
 }
-               
+
+proc note_topic {showoff whoby topic} {
+    set msg "FYI, $whoby has changed the topic on $showoff"
+    if {[string length $topic] < 160} {
+       append msg " to $topic"
+    } else {
+       append msg " but it is too long to reproduce here !"
+    }
+    set showoff [irctolower $showoff]
+    set tell [chandb_get $showoff topictell]
+    if {[lsearch -exact $tell *] >= 0} {
+       set tryspies [chandb_list]
+    } else {
+       set tryspies $tell
+    }
+    foreach spy $tryspies {
+       set see [chandb_get $spy topicsee]
+       if {[lsearch -exact $see $showoff] >= 0 || \
+               ([lsearch -exact $see *] >= 0 && \
+               [lsearch -exact $tell $spy] >= 0)} {
+           sendprivmsg $spy $msg
+       }
+    }
+}
+
 proc recordlastseen_p {p how here} {
     prefix_nick
     recordlastseen_n $n $how $here
@@ -488,6 +512,11 @@ proc leaving {lchan} {
     unset nlist
 }
 
+proc doleave {lchan} {
+    sendout PART $lchan
+    leaving $lchan
+}
+
 proc dojoin {lchan} {
     global chan_nicks
     sendout JOIN $lchan
@@ -498,15 +527,18 @@ proc check_justme {lchan} {
     global nick
     upvar #0 chan_nicks($lchan) nlist
     if {[llength $nlist] != 1} return
-    if {"[lindex $nlist 0]" != "$nick"} return
+    if {"[lindex $nlist 0]" != "[irctolower $nick]"} return
     if {[chandb_exists $lchan]} {
        set mode [chandb_get $lchan mode]
        if {"$mode" != "*"} {
            sendout MODE $lchan $mode
        }
+       set topic [chandb_get $lchan topicset]
+       if {[string length $topic]} {
+           sendout TOPIC $lchan $topic
+       }
     } else {
-       sendout PART $lchan
-       leaving $lchan
+       doleave $lchan
     }
 }
 
@@ -532,6 +564,13 @@ proc process_kickpart {chan user} {
     }
 }
 
+proc msg_TOPIC {p c dest topic} {
+    prefix_nick
+    if {![ischan $dest]} return
+    recordlastseen_n $n "changing the topic on $dest" 1
+    note_topic [irctolower $dest] $n $topic
+}
+
 proc msg_KICK {p c chans users comment} {
     set chans [split $chans ,]
     set users [split $users ,]
@@ -584,15 +623,15 @@ proc msg_NICK {p c newnick} {
     prefix_nick
     recordlastseen_n $n "changing nicks to $newnick" 0
     recordlastseen_n $newnick "changing nicks from $n" 1
+    set luser [irctolower $n]
+    set lusernew [irctolower $newnick]
     foreach ary $nick_arys {
-       upvar #0 nick_${ary}($n) old
-       upvar #0 nick_${ary}($newnick) new
+       upvar #0 nick_${ary}($luser) old
+       upvar #0 nick_${ary}($lusernew) new
        if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
        if {[info exists old]} { set new $old; unset old }
     }
-    upvar #0 nick_onchans($new)
-    set luser [irctolower $n]
-    set lusernew [irctolower $newnick]
+    upvar #0 nick_onchans($lusernew) oc
     foreach ch $oc {
        upvar #0 chan_nicks($ch) nlist
        set nlist [grep tn {"$tn" != "$luser"} $nlist]
@@ -611,8 +650,12 @@ proc nick_ishere {n} {
 proc msg_JOIN {p c chan} {
     prefix_nick
     recordlastseen_n $n "joining $chan" 1
-    upvar #0 nick_onchans([irctolower $n]) oc
-    lappend oc [irctolower $chan]
+    set nl [irctolower $n]
+    set lchan [irctolower $chan]
+    upvar #0 nick_onchans($nl) oc
+    upvar #0 chan_nicks($lchan) nlist
+    lappend oc $lchan
+    lappend nlist $nl
     nick_ishere $n
 }
 proc msg_PART {p c chan} {
@@ -789,20 +832,28 @@ proc loadhelp {} {
 }
 
 def_ucmd help {
+    upvar 1 n n
+
+    set topic [irctolower [string trim $text]]
+    if {[string length $topic]} {
+       set ontopic " on `$topic'"
+    } else {
+       set ontopic ""
+    }
     if {[set lag [out_lagged]]} {
        if {[ischan $dest]} { set replyto $dest } else { set replyto $n }
        if {$lag > 1} {
            sendaction_priority 1 $replyto \
-               "is very lagged.  Please ask for help again later."
+               "is very lagged.  Please ask for help$ontopic again later."
            ucmdr {} {}
        } else {
            sendaction_priority 1 $replyto \
-               "is lagged.  Your help will arrive shortly ..."
+               "is lagged.  Your help$ontopic will arrive shortly ..."
        }
     }
     
-    upvar #0 help_topics([irctolower [string trim $text]]) info
-    if {![info exists info]} { ucmdr "No help on $text, sorry." {} }
+    upvar #0 help_topics($topic) info
+    if {![info exists info]} { ucmdr "No help on $topic, sorry." {} }
     ucmdr $info {}
 }
 
@@ -865,7 +916,14 @@ def_somedb_id delete {} {
 }
 
 set default_settings_nick {timeformat ks}
-set default_settings_chan {autojoin 1  mode *  userinvite pub}
+set default_settings_chan {
+    autojoin 1
+    mode *
+    userinvite pub
+    topicset {}
+    topicsee {}
+    topictell {}
+}
 
 def_somedb_id set {args} {
     upvar #0 default_settings_$nickchan def
@@ -943,34 +1001,52 @@ proc def_chancmd {name body} {
            "    upvar 1 target chan; upvar 1 n n; upvar 1 text text; $body"
 }
 
-def_chancmd manager {
+proc ta_listop {findnow procvalue} {
+    # findnow and procvalue are code fragments which will be executed
+    # in the caller's level.  findnow should set ta_listop_ev to
+    # the current list, and procvalue should treat ta_listop_ev as
+    # a proposed value in the list and check and possibly modify
+    # (canonicalise?) it.  After ta_listop, ta_listop_ev will
+    # be the new value of the list.
+    upvar 1 ta_listop_ev exchg
+    upvar 1 text text
     set opcode [ta_word]
     switch -exact _$opcode {
-       _= { set ml {} }
+       _= { }
        _+ - _- {
-           if {[chandb_exists $chan]} {
-               set ml [chandb_get $chan managers]
-           } else {
-               set ml [list [irctolower $n]]
-           }
+           uplevel 1 $findnow
+           foreach item $exchg { set array($item) 1 }
        }
        default {
-           error "`channel manager' opcode must be one of + - ="
+           error "list change opcode must be one of + - ="
        }
     }
-    foreach nn [split $text " "] {
-       if {![string length $nn]} continue
-       check_nick $nn
-       set nn [irctolower $nn]
+    foreach exchg [split $text " "] {
+       if {![string length $exchg]} continue
+       uplevel 1 $procvalue
        if {"$opcode" != "-"} {
-           lappend ml $nn
+           set array($exchg) 1
+       } else {
+           catch { unset array($exchg) }
+       }
+    }
+    set exchg [lsort [array names array]]
+}
+
+def_chancmd manager {
+    ta_listop {
+       if {[chandb_exists $chan]} {
+           set ta_listop_ev [chandb_get $chan managers]
        } else {
-           set ml [grep nq {"$nq" != "$nn"} $ml]
+           set ta_listop_ev [list [irctolower $n]]
        }
+    } {
+       check_nick $ta_listop_ev
+       set ta_listop_ev [irctolower $ta_listop_ev]
     }
-    if {[llength $ml]} {
-       chandb_set $chan managers $ml
-       ucmdr "Managers of $chan: $ml" {}
+    if {[llength $ta_listop_ev]} {
+       chandb_set $chan managers $ta_listop_ev
+       ucmdr "Managers of $chan: $ta_listop_ev" {}
     } else {
        chandb_delete $chan
        ucmdr {} {} "forgets about managing $chan." {}
@@ -985,8 +1061,8 @@ def_chancmd autojoin {
        default { error "channel autojoin must be `yes' or `no' }
     }
     chandb_set $chan autojoin $nv
-    ucmdr [expr {$nv ? "I will join #chan when I'm restarted " : \
-           "I won't join #chan when I'm restarted "}] {}
+    ucmdr [expr {$nv ? "I will join $chan when I'm restarted " : \
+           "I won't join $chan when I'm restarted "}] {}
 }
 
 def_chancmd userinvite {
@@ -1004,6 +1080,42 @@ def_chancmd userinvite {
     ucmdr $txt {}
 }
 
+def_chancmd topic {
+    set what [ta_word]
+    switch -exact $what {
+       leave {
+           ta_nomore
+           chandb_set $chan topicset {}
+           ucmdr "I won't ever change the topic of $chan." {}
+       }
+       set {
+           set t [string trim $text]
+           if {![string length $t]} {
+               error "you must specific the topic to set"
+           }
+           chandb_set $chan topicset $t
+           ucmdr "Whenever I'm alone on $chan, I'll set the topic to $t." {}
+       }
+       see - tell {
+           ta_listop {
+               set ta_listop_ev [chandb_get $chan topic$what]
+           } {
+               if {"$ta_listop_ev" != "*"} {
+                   if {![ischan $ta_listop_ev]} {
+                       error "bad channel \`$ta_listop_ev' in topic $what"
+                   }
+                   set ta_listop_ev [irctolower $ta_listop_ev]
+               }
+           }
+           chandb_set $chan topic$what $ta_listop_ev
+           ucmdr "Topic $what list for $chan: $ta_listop_ev" {}
+       }
+       default {
+           error "unknown channel topic subcommand - see help channel"
+       }
+    }
+}
+
 def_chancmd mode {
     set mode [ta_word]
     if {"$mode" != "*" && ![regexp {^(([-+][imnpst]+)+)$} $mode mode]} {
@@ -1011,9 +1123,9 @@ def_chancmd mode {
     }
     chandb_set $chan mode $mode
     if {"$mode" == "*"} {
-       ucmdr "I won't ever change the mode of #chan." {}
+       ucmdr "I won't ever change the mode of $chan." {}
     } else {
-       ucmdr "Whenever I'm alone on #chan, I'll set the mode to $mode." {}
+       ucmdr "Whenever I'm alone on $chan, I'll set the mode to $mode." {}
     }
 }
 
@@ -1025,25 +1137,62 @@ def_chancmd show {
        append l ", userinvite " [chandb_get $chan userinvite] "."
        append l "\nManagers: "
        append l [join [chandb_get $chan managers] " "]
+       foreach {ts sep} {see "\n" tell "  "} {
+           set t [chandb_get $chan topic$ts]
+           append l $sep
+           if {[llength $t]} {
+               append l "Topic $ts list: $t."
+           } else {
+               append l "Topic $ts list is empty."
+           }
+       }
+       append l "\n"
+       set t [chandb_get $chan topicset]
+       if {[string length $t]} {
+           append l "Topic to set: $t"
+       } else {
+           append l "I will not change the topic."
+       }
        ucmdr {} $l
     } else {
        ucmdr {} "The channel $chan is not managed."
     }
 }
 
-def_ucmd op {
+proc channelmgr_monoop {} {
+    upvar 1 dest dest
+    upvar 1 text text
+    upvar 1 n n
+    upvar 1 p p
+    upvar 1 target target
+    global chan_nicks
+
     if {[ischan $dest]} { set target $dest }
     if {[ta_anymore]} { set target [ta_word] }
     ta_nomore
-    if {![info exists target]} { error "you must specify, or !... on, the channel" }
+    if {![info exists target]} {
+       error "you must specify, or invoke me on, the relevant channel"
+    }
+    if {![info exists chan_nicks([irctolower $target])]} {
+       error "I am not on $target."
+    }
     if {![ischan $target]} { error "not a valid channel" }
     if {![chandb_exists $target]} { error "$target is not a managed channel." }
     prefix_nick
     nick_securitycheck 1
     channel_securitycheck $target $n
+}
+
+def_ucmd op {
+    channelmgr_monoop
     sendout MODE $target +o $n
 }
 
+def_ucmd leave {
+    channelmgr_monoop
+    doleave $target
+}
+
 def_ucmd invite {
     global chan_nicks
     
@@ -1393,11 +1542,11 @@ proc fail {msg} {
 }
 
 proc ensure_connecting {} {
-    global sock ownfullname host port nick
+    global sock ownfullname host port nick socketargs
     global musthaveping_ms musthaveping_after
     
     if {[info exists sock]} return
-    set sock [socket $host $port]
+    set sock [eval socket $socketargs [list $host $port]]
     fconfigure $sock -buffering line
     fconfigure $sock -translation crlf