chiark / gitweb /
Actually cope with nick changes.
[ircbot] / bot.tcl
diff --git a/bot.tcl b/bot.tcl
index 140ff1cdd8889ab8dc29e5902db7abf45e11e848..876a2383a2e4136827604181ce78a4d5fc5c2039 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
@@ -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
@@ -498,12 +522,16 @@ 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
@@ -532,6 +560,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 +619,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]
@@ -748,7 +783,7 @@ proc ucmdr {priv pub args} {
 }
 
 proc loadhelp {} {
-    global help_topics
+    global help_topics errorInfo
 
     catch { unset help_topics }
     set f [open helpinfos r]
@@ -763,21 +798,27 @@ proc loadhelp {} {
                    unset topic
                    unset lines
                }
-           } elseif {[regexp {^!([-+._0-9a-z]*)$} $l dummy newtopic]} {
+           } elseif {[regexp {^\:\:} $l]} {
+           } elseif {[regexp {^\:([-+._0-9a-z]*)$} $l dummy newtopic]} {
                if {[info exists topic]} {
                    error "help $newtopic while in $topic"
                }
                set topic $newtopic
                set lines {}
-           } elseif {[regexp {^[^!#]} $l]} {
+           } elseif {[regexp {^[^:#]} $l]} {
                set topic
+               regsub -all {([^\\])\!\$?} _$l {\1} l
+               regsub -all {\\(.)} $l {\1} l
+               regsub {^_} $l {} l
                lappend lines [string trimright $l]
            } else {
                error "eh ? $lno: $l"
            }
        }
        if {[info exists topic]} { error "unfinished topic $topic" }
-    } {} {
+    } {
+       set errorInfo "in helpinfos line $lno\n$errorInfo"
+    } {
        close $f
     }
 }
@@ -859,7 +900,14 @@ def_somedb_id delete {} {
 }
 
 set default_settings_nick {timeformat ks}
-set default_settings_chan {autojoin 1  mode *}
+set default_settings_chan {
+    autojoin 1
+    mode *
+    userinvite pub
+    topicset {}
+    topicsee {}
+    topictell {}
+}
 
 def_somedb_id set {args} {
     upvar #0 default_settings_$nickchan def
@@ -937,34 +985,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." {}
@@ -979,8 +1045,59 @@ 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 {
+    set nv [string tolower [ta_word]]
+    switch -exact $nv {
+       pub { set txt "!invite will work for $chan, but it won't work by /msg" }
+       here { set txt "!invite and /msg invite will work, but only for users who are already on $chan." }
+       all { set txt "Any user will be able to invite themselves or anyone else to $chan." }
+       none { set txt "I will not invite anyone to $chan." }
+       default {
+           error "channel userinvite must be `pub', `here', `all' or `none'
+       }
+    }
+    chandb_set $chan userinvite $nv
+    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 {
@@ -990,9 +1107,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." {}
     }
 }
 
@@ -1000,9 +1117,26 @@ def_chancmd show {
     if {[chandb_exists $chan]} {
        set l "Settings for $chan: autojoin "
        append l [lindex {no yes} [chandb_get $chan autojoin]]
-       append l ", mode " [chandb_get $chan mode] "."
+       append l ", mode " [chandb_get $chan mode]
+       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."
@@ -1022,6 +1156,57 @@ def_ucmd op {
     sendout MODE $target +o $n
 }
 
+def_ucmd invite {
+    global chan_nicks
+    
+    if {[ischan $dest]} {
+       set target $dest
+       set onchan 1
+    } else {
+       set target [ta_word]
+       set onchan 0
+    }
+    set ltarget [irctolower $target]
+    if {![ischan $target]} { error "$target is not a channel." }
+    if {![info exists chan_nicks($ltarget)]} { error "I am not on $target." }
+    set ui [chandb_get $ltarget userinvite]
+    if {"$ui" == "pub" && !$onchan} {
+       error "Invitations to $target must be made with !invite."
+    }
+    if {"$ui" != "all"} {
+       prefix_nick
+       if {[lsearch -exact $chan_nicks($ltarget) [irctolower $n]] < 0} {
+ error "Invitations to $target may only be made by a user on the channel."
+       }
+    }
+    if {"$ui" == "none"} {
+       error "Sorry, I've not been authorised to invite people to $target."
+    }
+    if {![ta_anymore]} {
+       error "You have to say who to invite."
+    }
+    set invitees {}
+    while {[ta_anymore]} {
+       set invitee [ta_word]
+       check_nick $invitee
+       lappend invitees $invitee
+    }
+    foreach invitee $invitees {
+       sendout INVITE $invitee $ltarget
+    }
+    set who [lindex $invitees 0]
+    switch -exact llength $invitees {
+       0 { error "zero invitees" }
+       1 { }
+       2 { append who " and [lindex $invitees 1]" }
+       * {
+           set who [join [lreplace $invitees end end] ", "]
+           append who " and [lindex $invitees [llength $invitees]]"
+       }
+    }
+    ucmdr {} "invites $who to $target."
+}
+
 def_ucmd channel {
     if {[ischan $dest]} { set target $dest }
     if {![ta_anymore]} {
@@ -1307,7 +1492,7 @@ proc ensure_globalsecret {} {
 proc ensure_outqueue {} {
     out__vars
     if {[info exists out_queue]} return
-    set out_creditms [expr {$out_maxburst*$out_interval}]
+    set out_creditms 0
     set out_creditat [clock seconds]
     set out_queue {}
     set out_lag_reported 0