X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/ircbot/blobdiff_plain/ba7cc780277e0d2aa12d3c9f3051d25f46507979..ebbae0a97c455e925b5a28a1e11853c5fed1c150:/bot.tcl diff --git a/bot.tcl b/bot.tcl index f9dcda8..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 @@ -202,9 +205,10 @@ proc onread {args} { [regexp {^[&#+!]} [lindex $params 0]] && ![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,8 @@ proc leaving {lchan} { } upvar #0 chan_nicks($lchan) nlist unset nlist + upvar #0 chan_lastactivity($lchan) la + catch { unset la } } proc doleave {lchan} { @@ -591,11 +597,14 @@ set nick_arys {onchans username unique} # nick_username($luser) -> # nick_unique($luser) -> # nick_case($luser) -> $user (valid even if no longer visible) +# nick_markid($luser) -> # 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 } @@ -624,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 @@ -637,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 } @@ -654,6 +665,10 @@ proc msg_JOIN {p c chan} { 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 @@ -915,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 * @@ -1385,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]} { @@ -1516,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