X-Git-Url: https://git.distorted.org.uk/~mdw/ircbot/blobdiff_plain/a867f5471a1c97cf8c10acbc30f6cd0503b68832..ebbae0a97c455e925b5a28a1e11853c5fed1c150:/bot.tcl

diff --git a/bot.tcl b/bot.tcl
index ad5c908..b07b567 100755
--- a/bot.tcl
+++ b/bot.tcl
@@ -18,6 +18,9 @@ defset out_interval 2100
 defset out_lag_lag 5000
 defset out_lag_very 25000
 
+defset marktime_min 300
+defset marktime_join_startdelay 5000
+
 proc manyset {list args} {
     foreach val $list var $args {
 	upvar 1 $var my
@@ -200,11 +203,12 @@ 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
-	}
+	set chan [lindex $params 0]
+	upvar #0 chan_lastactivity([irctolower $chan]) la
+	set la [clock seconds]
+	catch { recordlastseen_p $prefix "talking on $chan" 1 }
 	return
     }
     log "[clock seconds] <- $org"
@@ -510,6 +514,13 @@ proc leaving {lchan} {
     }
     upvar #0 chan_nicks($lchan) nlist
     unset nlist
+    upvar #0 chan_lastactivity($lchan) la
+    catch { unset la }
+}
+
+proc doleave {lchan} {
+    sendout PART $lchan
+    leaving $lchan
 }
 
 proc dojoin {lchan} {
@@ -533,8 +544,7 @@ proc check_justme {lchan} {
 	    sendout TOPIC $lchan $topic
 	}
     } else {
-	sendout PART $lchan
-	leaving $lchan
+	doleave $lchan
     }
 }
 
@@ -587,11 +597,14 @@ set nick_arys {onchans username unique}
 # nick_username($luser) -> <securely known local username>
 # nick_unique($luser) -> <counter>
 # nick_case($luser) -> $user  (valid even if no longer visible)
+# nick_markid($luser) -> <after id for marktime>
 
 # chan_nicks($lchan) -> [list ... $luser ...]
+# chan_lastactivity($lchan) -> [clock seconds]
 
 proc lnick_forget {luser} {
     global nick_arys chan_nicks
+    lnick_marktime_cancel $luser
     foreach ary $nick_arys {
 	upvar #0 nick_${ary}($luser) av
 	catch { unset av }
@@ -620,6 +633,7 @@ proc msg_NICK {p c newnick} {
     recordlastseen_n $n "changing nicks to $newnick" 0
     recordlastseen_n $newnick "changing nicks from $n" 1
     set luser [irctolower $n]
+    lnick_marktime_cancel $luser
     set lusernew [irctolower $newnick]
     foreach ary $nick_arys {
 	upvar #0 nick_${ary}($luser) old
@@ -633,6 +647,7 @@ proc msg_NICK {p c newnick} {
 	set nlist [grep tn {"$tn" != "$luser"} $nlist]
 	lappend nlist $lusernew
     }
+    lnick_marktime_start $lusernew "Hi." 500
     nick_case $newnick
 }
 
@@ -646,8 +661,16 @@ 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
+    if {![info exists oc]} {
+	global marktime_join_startdelay
+	lnick_marktime_start $nl "Welcome." $marktime_join_startdelay
+    }
+    lappend oc $lchan
+    lappend nlist $nl
     nick_ishere $n
 }
 proc msg_PART {p c chan} {
@@ -824,20 +847,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 {}
 }
 
@@ -899,7 +930,7 @@ def_somedb_id delete {} {
     file delete $idfn
 }
 
-set default_settings_nick {timeformat ks}
+set default_settings_nick {timeformat ks  marktime off}
 set default_settings_chan {
     autojoin 1
     mode *
@@ -1143,19 +1174,42 @@ def_chancmd show {
     }
 }
 
-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
+
+    prefix_nick
+
     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
     
@@ -1346,6 +1400,48 @@ def_setting timeformat {
     ucmdr {} $desc
 }
 
+proc marktime_desc {mt} {
+    if {"$mt" == "off"} {
+	return "I will not send you periodic messages."
+    } elseif {"$mt" == "once"} {
+	return "I will send you one informational message when I see you."
+    } else {
+	return "I'll send you a message every [showintervalsecs $mt]."
+    }
+}
+
+def_setting marktime {
+    set mt [nickdb_get $n marktime]
+    set p $mt
+    if {[string match $mt {[0-9]*}} { append p s }
+    append p ": "
+    append p [marktime_desc $mt]
+    return $p
+} {
+    global marktime_min
+    set mt [string tolower [ta_word]]
+    ta_nomore
+
+    if {"$mt" == "off" || "$mt" == "once"} {
+    } elseif {[regexp {^([0-9]+)([a-z]+)$} $mt dummy value unit]} {
+	switch -exact $unit {
+	    s { set u 1 }
+	    ks { set u 1000 }
+	    m { set u 60 }
+	    h { set u 3600 }
+	    default { error "unknown unit of time $unit" }
+	}
+	if {$value > 86400*21/$u} { error "marktime interval too large" }
+	set mt [expr {$value*$u}]
+	if {$mt < $marktime_min} { error "marktime interval too small" }
+    } else {
+	error "invalid syntax for marktime"
+    }
+    nickdb_set $n marktime $mt
+    lnick_marktime_start [irctolower $n] "So:" 500
+    ucmdr {} [marktime_desc $mt]
+}
+
 def_setting security {
     set s [nickdb_get $n username]
     if {[string length $s]} {
@@ -1477,6 +1573,88 @@ def_ucmd seen {
     ucmdr {} $rstr
 }
 
+proc lnick_marktime_cancel {luser} {
+    upvar #0 nick_markid($luser) mi
+    if {![info exists mi]} return
+    catch { after cancel $mi }
+    catch { unset mi }
+}
+
+proc lnick_marktime_doafter {luser why ms} {
+    lnick_marktime_cancel $luser
+    upvar #0 nick_markid($luser) mi
+    set mi [after $ms [list lnick_marktime_now $luser $why]]
+}
+
+proc lnick_marktime_reset {luser} {
+    set mt [nickdb_get $luser marktime]
+    if {"$mt" == "off" || "$mt" == "once"} return
+    lnick_marktime_doafter $luser "Time passes." [expr {$mt*1000}]
+}
+
+proc lnick_marktime_start {luser why ms} {
+    set mt [nickdb_get $luser marktime]
+    if {"$mt" == "off"} {
+	lnick_marktime_cancel $luser
+    } else {
+	lnick_marktime_doafter $luser $why $ms
+    }
+}
+
+proc lnick_marktime_now {luser why} {
+    upvar #0 nick_onchans($luser) oc
+    sendprivmsg $luser [lnick_pingstring $why $oc ""]
+    lnick_marktime_reset $luser
+}    
+
+proc lnick_pingstring {why oc apstring} {
+    global nick_onchans
+    catch { exec uptime } uptime
+    set nnicks [llength [array names nick_onchans]]
+    if {[regexp \
+ {^ *([0-9:apm]+) +up.*, +(\d+) users, +load average: +([0-9., ]+) *$} \
+            $uptime dummy time users load]} {
+	regsub , $load {} load
+        set uptime "$time  $nnicks/$users  $load"
+    } else {
+	append uptime ", $nnicks nicks"
+    }
+    if {[llength $oc]} {
+	set best_la 0
+	set activity quiet
+	foreach ch $oc {
+	    upvar #0 chan_lastactivity($ch) la
+	    if {![info exists la]} continue
+	    if {$la <= $best_la} continue
+	    set activity "$ch [showintervalsecs [expr {[clock seconds]-$la}]]"
+	    set best_la $la
+	}
+    } else {
+	set activity unseen
+    }
+    set str $why
+    append str "  " $uptime "  " $activity
+    if {[string length $apstring]} { append str "  " $apstring }
+    return $str
+}
+
+def_ucmd ping {
+    if {[ischan $dest]} {
+	set oc [irctolower $dest]
+    } else {
+	global nick_onchans
+	prefix_nick
+	set ln [irctolower $n]
+	if {[info exists nick_onchans($ln)]} {
+	    set oc $nick_onchans($ln)
+	} else {
+	    set oc {}
+	}
+	if {[llength $oc]} { lnick_marktime_reset $ln }
+    }
+    ucmdr {} [lnick_pingstring "Pong!" $oc $text]
+}
+
 proc ensure_globalsecret {} {
     global globalsecret