X-Git-Url: https://git.distorted.org.uk/~mdw/ircbot/blobdiff_plain/d7eda3bc5a7ed03d85586e0cea37ffd98cefe731..09c94f5b71689d03f22f54bb7a478b3e8dc1013d:/bot.tcl diff --git a/bot.tcl b/bot.tcl index fb537d7..0111363 100755 --- a/bot.tcl +++ b/bot.tcl @@ -6,6 +6,9 @@ source irccore.tcl source parsecmd.tcl source stdhelp.tcl +defset marktime_min 300 +defset marktime_join_startdelay 5000 + proc privmsg_unlogged {prefix ischan params} { if {!$ischan || [regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} { @@ -15,7 +18,7 @@ proc privmsg_unlogged {prefix ischan params} { set chan [lindex $params 0] upvar #0 chan_lastactivity([irctolower $chan]) la set la [clock seconds] - catch { recordlastseen_p $prefix "talking on $chan" 1 } + catch_logged { recordlastseen_p $prefix "talking on $chan" 2 } return 1 } @@ -142,11 +145,151 @@ proc looking_whenwhere {when where} { return $str } +proc check_telling {nl event} { + # for all except `talk' we delay 750ms + switch -exact $event { + none { + } + talk { + check_telling_core $nl talk + check_telling_core $nl act + } + act { + after 750 [list check_telling_core $nl $event] + } + default { + error "check_telling $nl $event" + } + } +} + +proc check_telling_core {nl event} { + # event is `talk' or `act' + # When user talks we actually get talk now and act later +FIXME - make it be called with come +FIXME - implement all cmds +FIXME - implement tells_deliver set stt [list $u passed $now] +FIXME - implement tells_delete catch { unset stt } ? + set iml [msgdb_get $nl inbound] + if {![llength $iml]} return + + upvar #0 nick_telling($nl) telling + upvar #0 nick_unique($nl) u + + if {[info exists telling]} { + manyset $telling u2 stt telling_when + if {"$u2" != "$u"} { unset telling; unset stt; unset telling_when } + } + + if {![info exists stt]} { + set stt norecord + set telling_when $now + } + + set ago [expr {$now - $telling_when}] + + # evstate is string of letters + # event + # t talk + # a act + # c come + # security level and timing + # ii Insecure + # ss Secure and soon (before interval) + # sl Secure and late (after interval) + # current state + # n NORECORD + # m MENTIONED + # p PASSED + # reliability and timing + # uu Unreliable + # rv Remind, very soon (before within-interval) + # rs Remind, soon (between) + # rl Remind, late (aftr every-interval) + # ps Pester, soon (before interval) + # pl Pester, late (after interval) + # current identification + # i Identified + # u Unidentified + # current visibility + # v Visible + # h Hidden (invisible, no unique) + + manyset [nickdb_get $n tellsec] sec secwhen + switch -exact $sec { + insecure { set evstate ii } + secure { set evstate [expr {$ago<$secwhen ? "sl" : "ss"}] } + default { set evstate "#$sec#" } + } + + append evstate [string range $stt 0 0] + + manyset [nickdb_set $n tellrel] rel relint relwithin + switch -exact $rel { + unreliable { append evstate uu } + remind { append evstate [expr { + $ago<$relwithin ? "rv" : $ago<$relint ? "rs" : "rl" + }]} + pester { append evstate [expr {$ago<$relint ? "ps" : "pl"}] } + default { append evstate "#$rel#" } + } + + upvar #0 nick_username($nl) nu + if {[info exists nu] && "$nu" == "[nickdb_get $nl username]"} { + append evstate i + } else { + append evstate u + } + + append evstate [expr {[info exists u] ? "v" : "h"}] + + switch -glob $evstate { + t??prv?v { + # consider delivered: + # (very recently passed, and the user talks) + tells_delete {} $nl + } + t??????? { + # ignore + # (any other `talk's) + } + ?iin???? - ?iip?l?? - ?ii????? - + ?s?n??iv - ?s?m??iv - ?s?p?liv { + # pass messages + # (insecure and not passed recently, or just arriving; + # secure and not passed recently) + tells_deliver $nl + } + ?ssp???? - ???p?s?? - ???p?v?? { + # ignore + # (recently mentioned or passed + # immediate `talk' thing) + } + ?s?n???? - ?slm???? - cs?????? { + # mention messages + # (secure and not mentioned recently or just arriving, + # and should not pass) + sendprivmsg $nl \ + {You have messages (so identify yourself please).}] + set stt [list $u mentioned $now] + } + * { + error "check_telling_core nl=$nl evstate=$evstate ?" + } + } +} + proc recordlastseen_n {n how here} { global lastseen lookedfor - set lastseen([irctolower $n]) [list $n [clock seconds] $how] + set nl [irctolower $n] + set now [clock seconds] + set lastseen($nl) [list $n $now $how] + if {!$here} return - upvar #0 lookedfor([irctolower $n]) lf + + check_telling $nl [lindex {none act talk} $here] + + upvar #0 lookedfor($nl) lf if {[info exists lf]} { switch -exact [llength $lf] { 0 { @@ -360,9 +503,10 @@ set nick_counter 0 set nick_arys {onchans username unique} # nick_onchans($luser) -> [list ... $lchan ...] # nick_username($luser) -> -# nick_unique($luser) -> +# nick_unique($luser) -> # nick_case($luser) -> $user (valid even if no longer visible) # nick_markid($luser) -> +# nick_telling($luser) -> mentioned|passed # chan_nicks($lchan) -> [list ... $luser ...] # chan_lastactivity($lchan) -> [clock seconds] @@ -413,7 +557,7 @@ proc msg_NICK {p c newnick} { set nlist [grep tn {"$tn" != "$luser"} $nlist] lappend nlist $lusernew } - lnick_marktime_start $lusernew "Hi." 500 + lnick_marktime_start $lusernew "Hi." 500 1 nick_case $newnick } @@ -426,6 +570,7 @@ proc nick_ishere {n} { proc msg_JOIN {p c chan} { prefix_nick + nick_ishere $n recordlastseen_n $n "joining $chan" 1 set nl [irctolower $n] set lchan [irctolower $chan] @@ -433,11 +578,10 @@ proc msg_JOIN {p c chan} { upvar #0 chan_nicks($lchan) nlist if {![info exists oc]} { global marktime_join_startdelay - lnick_marktime_start $nl "Welcome." $marktime_join_startdelay + lnick_marktime_start $nl "Welcome." $marktime_join_startdelay 1 } lappend oc $lchan lappend nlist $nl - nick_ishere $n } proc msg_PART {p c chan args} { prefix_nick @@ -1007,7 +1151,8 @@ def_ucmd tell { set ctarget $target if {[info exists nick_case($ltarget)]} { set ctarget $nick_case($ltarget) } - manyset [nickdb_get $target tellsec] sec mailto mailwhy + manyset [nickdb_get $target tellsec] sec mailtoint mailwhy + manyset [nickdb_get $target tellrel] rel relint relwithin switch -exact $sec { insecure - secure { set now [clock seconds] @@ -1030,28 +1175,41 @@ def_ucmd tell { lappend noutbound $ctarget $now 1 } msgsdb_set $n outbound $noutbound - if {!$found} { - ucmdr "OK, I'll tell $ctarget." {} + set msg "OK, I'll tell $ctarget" + if {$found} { append msg " that too" } + append msg ", " + if {"$sec" != "secure"} { + switch -exact $rel { + unreliable { append msg "neither reliably nor securely" } + remind { append msg "pretty reliably, but not securely" } + pester { append msg "reliably but not securely" } + } } else { - ucmdr "OK, I'll tell $ctarget that too." {} + switch -exact $rel { + unreliable { append msg "securely but not reliably" } + remind { append msg "securely and pretty reliably" } + pester { append msg "reliably and securely" } + } } + append msg . + ucmdr $msg {} } mailto { set fmtmsg [exec fmt << " $text"] exec /usr/sbin/sendmail -odb -oi -t -oee -f $mailwhy \ > /dev/null << \ "From: $ownmailaddr ($ownfullname) -To: $mailto +To: $mailtoint Subject: IRC tell from $n $n asked me[expr {[ischan $dest] ? " on $dest" : ""}] to tell you: [exec fmt << " $text"] (This message was for your nick $ctarget; your account $mailwhy - arranged for it to be forwarded to $mailto.) + arranged for it to be forwarded to $mailtoint.) " ucmdr \ - "I've mailed $ctarget at $mailto, which is what they prefer." \ + "I've mailed $ctarget, which is what they prefer." \ {} } refuse { @@ -1164,20 +1322,20 @@ proc def_setting {opt show_body set_body} { } proc tellme_sec_desc {v} { - manyset $v sec mailto + manyset $v sec mailtoint switch -exact $sec { insecure { return "I'll tell you your messages whenever I see you." } secure { return \ - "I'll keep the bodies of your messages private until you identify yourself." + "I'll keep the bodies of your messages private until you identify yourself, reminding you every [showintervalsecs $mailtoint 1]." } refuse { return "I shan't accept messages for you." } mailto { - return "I'll forward your messages by email to $mailto." + return "I'll forward your messages by email to $mailtoint." } default { error "bad tellsec $sec" @@ -1242,7 +1400,7 @@ def_setting marktime { set mt [parse_interval $mt $marktime_min] } nickdb_set $n marktime $mt - lnick_marktime_start [irctolower $n] "So:" 500 + lnick_marktime_start [irctolower $n] "So:" 500 0 ucmdr {} [marktime_desc $mt] } @@ -1321,6 +1479,37 @@ def_setting tellme { ucmdr [tellme_${sr}_desc $v] {} } +proc lnick_checktold {luser} { + set ml [msgsdb_get $luser outbound] + if {![llength $ml]} return + set is1 [expr {[llength $ml]==3}] + set m1 "FYI, I haven't yet passed on your" + set ol {} + set now [clock seconds] + while {[llength $ml]} { + manyset $ml r t n + set ml [lreplace $ml 0 2] + set td [expr {$now-$t}] + if {$n == 1} { + set iv [showinterval $td] + set ifo "$r, $iv" + set if1 "message to $r, $iv." + } else { + set iv [showintervalsecs $td 0] + set ifo "$r, $n messages, oldest $iv" + set if1 "$n messages to $r, oldest $iv." + } + if {$is1} { + sendprivmsg $luser "$m1 $if1" + return + } else { + lappend ol " to $ifo[expr {[llength $ml] ? ";" : "."}]" + } + } + sendprivmsg $luser "$m1 messages:" + msendprivmsg $luser $ol +} + def_ucmd set { global settings prefix_nick @@ -1450,32 +1639,34 @@ proc lnick_marktime_cancel {luser} { catch { unset mi } } -proc lnick_marktime_doafter {luser why ms} { +proc lnick_marktime_doafter {luser why ms mentiontold} { lnick_marktime_cancel $luser upvar #0 nick_markid($luser) mi - set mi [after $ms [list lnick_marktime_now $luser $why]] + set mi [after $ms [list lnick_marktime_now $luser $why 0]] } 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}] + lnick_marktime_doafter $luser "Time passes." [expr {$mt*1000}] 0 } -proc lnick_marktime_start {luser why ms} { +proc lnick_marktime_start {luser why ms mentiontold} { set mt [nickdb_get $luser marktime] if {"$mt" == "off"} { lnick_marktime_cancel $luser + after $ms [list lnick_checktold $luser] } else { - lnick_marktime_doafter $luser $why $ms + lnick_marktime_doafter $luser $why $ms $mentiontold } } -proc lnick_marktime_now {luser why} { +proc lnick_marktime_now {luser why mentiontold} { upvar #0 nick_onchans($luser) oc global calling_nick set calling_nick $luser sendprivmsg $luser [lnick_pingstring $why $oc ""] + if {$mentiontold} { lnick_checktold $luser } lnick_marktime_reset $luser } @@ -1512,12 +1703,12 @@ proc lnick_pingstring {why oc apstring} { } def_ucmd ping { + prefix_nick + set ln [irctolower $n] 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 { @@ -1525,6 +1716,7 @@ def_ucmd ping { } if {[llength $oc]} { lnick_marktime_reset $ln } } + lnick_checktold $ln ucmdr {} [lnick_pingstring "Pong!" $oc $text] }