X-Git-Url: https://git.distorted.org.uk/~mdw/ircbot/blobdiff_plain/a44d49829c0774614c44a03ec4e0d0f8cb83e9f0..37a9f1adbed3ab89c14bf4c8c4dbac5cd0ca29ed:/bot.tcl?ds=sidebyside

diff --git a/bot.tcl b/bot.tcl
index 1119fbf..81583ee 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
 }
 
@@ -83,6 +86,23 @@ proc showtime {when} {
     return [showinterval [expr {[clock seconds] - $when}]]
 }
 
+proc parse_interval {specified min} {
+    if {![regexp {^([0-9]+)([a-z]+)$} $specified dummy value unit]} {
+	error "invalid syntax for interval"
+    }
+    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 "interval too large" }
+    set result [expr {$value*$u}]
+    if {$result < $min} { error "interval too small (<${min}s)" }
+    return $result
+}
+
 proc def_msgproc {name argl body} {
     proc msg_$name "varbase $argl" "\
     upvar #0 msg/\$varbase/dest d\n\
@@ -125,11 +145,112 @@ proc looking_whenwhere {when where} {
     return $str
 }
 
+proc check_telling {nl event} {
+    # event is `talk', `act' or `come'
+
+    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
+    #   current state
+    #      n   NORECORD
+    #      m   MENTIONED
+    #      p   PASSED
+    #   security level and timing
+    #      ii  Insecure
+    #      ss  Secure and soon (before interval)
+    #      sl  Secure and late (after interval)
+    #   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)
+
+    set evstate [string range $stt 0 0]
+    
+    manyset [nickdb_get $n tellsec] sec secwhen
+    switch -exact $sec {
+	insecure { append evstate ii }
+	secure { append evstate [expr {$ago<$secwhen ? "sl" : "ss"}] }
+	default { append evstate "#$sec#" }
+    }
+
+    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 {
+	
+    
+	    
+	    
+    if {[
+    set security
+
+    switch -exact
+    
+    if {![info exists u]} { catch { unset telling } }
+	&& [info exists telling]} {
+	
+	
+    }
+	
+	if {![info exists telling]} {
+	    
+
 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 {x act talk} $here]
+
+    upvar #0 lookedfor($nl) lf
     if {[info exists lf]} {
 	switch -exact [llength $lf] {
 	    0 {
@@ -343,9 +464,10 @@ set nick_counter 0
 set nick_arys {onchans username unique}
 # nick_onchans($luser) -> [list ... $lchan ...]
 # nick_username($luser) -> <securely known local username>
-# nick_unique($luser) -> <counter>
+# nick_unique($luser) -> <includes-counter>
 # nick_case($luser) -> $user  (valid even if no longer visible)
 # nick_markid($luser) -> <after id for marktime>
+# nick_telling($luser) -> <unique> mentioned|passed <when>
 
 # chan_nicks($lchan) -> [list ... $luser ...]
 # chan_lastactivity($lchan) -> [clock seconds]
@@ -396,7 +518,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
 }
 
@@ -409,6 +531,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]
@@ -416,15 +539,19 @@ 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} {
+proc msg_PART {p c chan args} {
     prefix_nick
-    recordlastseen_n $n "leaving $chan" 1
+    set msg "leaving $chan"
+    if {[llength $args]} {
+	set why [lindex $args 0]
+	if {"[irctolower $why]" != "[irctolower $n]"} {	append msg " ($why)" }
+    }
+    recordlastseen_n $n $msg 1
     process_kickpart $chan $n
 }
 proc msg_QUIT {p c why} {
@@ -525,7 +652,11 @@ proc somedb__head {} {
 }
 
 proc def_somedb {name arglist body} {
-    foreach {nickchan fprefix} {nick users/n chan chans/c} {
+    foreach {nickchan fprefix} {
+	nick users/n
+	chan chans/c
+	msgs users/m
+    } {
 	proc ${nickchan}db_$name $arglist \
             "set nickchan $nickchan; set fprefix $fprefix; $body"
     }
@@ -554,7 +685,13 @@ def_somedb_id delete {} {
     file delete $idfn
 }
 
-set default_settings_nick {timeformat ks  marktime off}
+set default_settings_nick {
+    timeformat ks
+    marktime off
+    tellsec insecure
+    tellrel {remind 3600 30}
+}
+
 set default_settings_chan {
     autojoin 1
     mode *
@@ -564,6 +701,13 @@ set default_settings_chan {
     topictell {}
 }
 
+set default_settings_msgs {
+    inbound {}
+    outbound {}
+}
+# inbound -> [<nick> <time_t> <message>] ...
+# outbound -> [<nick> <time_t(earliest)> <count>] ...
+
 def_somedb_id set {args} {
     upvar #0 default_settings_$nickchan def
     if {![info exists iddbe]} { set iddbe $def }
@@ -957,6 +1101,87 @@ def_ucmd channel {
     channel/$subcmd
 }
 
+def_ucmd tell {
+    global nick_case ownmailaddr ownfullname
+    
+    prefix_nick
+    set target [ta_word]
+    if {![string length $text]} { error "tell them what?" }
+
+    set ltarget [irctolower $target]
+    set ctarget $target
+    if {[info exists nick_case($ltarget)]} { set ctarget $nick_case($ltarget) }
+
+    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]
+	    set inbound [msgsdb_get $ltarget inbound]
+	    lappend inbound $n $now $text
+	    msgsdb_set $ltarget inbound $inbound
+
+	    set outbound [msgsdb_get $n outbound]
+	    set noutbound {}
+	    set found 0
+	    foreach {recip time count} $outbound {
+		if {"[irctolower $recip]" == "$ltarget"} {
+		    incr count
+		    set recip $ctarget
+		    set found 1
+		}
+		lappend noutbound $recip $time $count
+	    }
+	    if {!$found} {
+		lappend noutbound $ctarget $now 1
+	    }
+	    msgsdb_set $n outbound $noutbound
+	    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 {
+		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: $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 $mailtoint.)
+"
+            ucmdr \
+ "I've mailed $ctarget, which is what they prefer." \
+                {}
+	}
+	refuse {
+	    usererror "Sorry, $ctarget does not want me to take messages."
+	}
+	default {
+	    error "bad tellsec $sec"
+	}
+    }
+}
+
 def_ucmd who {
     if {[ta_anymore]} {
 	set target [ta_word]; ta_nomore
@@ -1041,7 +1266,10 @@ proc timeformat_desc {tf} {
     }
 }
 
+set settings {}
 proc def_setting {opt show_body set_body} {
+    global settings
+    lappend settings $opt
     proc set_show/$opt {} "
         upvar 1 n n
         set opt $opt
@@ -1054,6 +1282,47 @@ proc def_setting {opt show_body set_body} {
         $set_body"
 }
 
+proc tellme_sec_desc {v} {
+    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, 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 $mailtoint."
+	}
+	default {
+	    error "bad tellsec $sec"
+	}
+    }
+}
+
+proc tellme_rel_desc {v} {
+    manyset $v rel every within
+    switch -exact $rel {
+	unreliable {
+	    return "As soon as I've told you, I'll forget the message - note that this means messages can get lost !"
+	}
+	pester {
+	    set u {}
+	}
+	remind {
+	    set u ", or talk on channel within [showintervalsecs $within 1] of me having told you"
+	}
+	default {
+	    error "bad tellrel $rel"
+	}
+    }
+    return "I'll remind you every [showintervalsecs $every 1] until you say delmsg$u."
+}
+
 def_setting timeformat {
     set tf [nickdb_get $n timeformat]
     return "$tf: [timeformat_desc $tf]"
@@ -1088,22 +1357,11 @@ def_setting marktime {
     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"
+	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]
 }
 
@@ -1116,7 +1374,105 @@ def_setting security {
     }
 } {}
 
+def_setting tellme {
+    set secv [nickdb_get $n tellsec]
+    set ms [tellme_sec_desc $secv]
+    manyset $secv sec
+    switch -exact $sec {
+	insecure - secure {
+	    set mr [tellme_rel_desc [nickdb_get $n tellrel]]
+	    return "$ms  $mr"
+	}
+	refuse - mailto {
+	    return $ms
+	}
+    }
+} {
+    set setting [string tolower [ta_word]]
+    switch -exact $setting {
+	insecure - secure - refuse {
+	    ta_nomore
+	    if {"$setting" == "refuse" && [llength [msgsdb_get $n inbound]]} {
+		usererror "You must delete the messages you have, first."
+	    }
+	    set sr sec
+	    set v $setting
+	}
+	mailto {
+	    set u [nickdb_get $n username]
+	    if {![string length $u]} {
+		usererror "Sorry, you must register secure to have your messages mailed (to prevent the use of this feature for spamming)."
+	    }
+	    set sr sec
+	    set v [list mailto [ta_word] $u]
+	}
+	unreliable - pester - remind {
+	    manyset [nickdb_get $n tellsec] sec
+	    switch -exact $sec {
+		refuse - mailto {
+		    error "can't change message delivery conditions when message disposition prevents messages from being left"
+		}
+	    }
+	    set sr rel
+	    set v $setting
+	    if {"$setting" != "unreliable"} {
+		set every [parse_interval [ta_word] 300]
+		lappend v $every
+	    }
+	    if {"$setting" == "remind"} {
+		if {[ta_anymore]} {
+		    set within [parse_interval [ta_word] 5]
+		} else {
+		    set within 30
+		}
+		if {$within > $every} {
+		    error "remind interval must be at least time to respond"
+		}
+		lappend v $within
+	    }
+	    ta_nomore
+	}
+	default {
+	    error "invalid tellme setting $setting"
+	}
+    }
+    nickdb_set $n tell$sr $v
+    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
     check_notonchan
     if {![nickdb_exists $n]} {
@@ -1124,8 +1480,7 @@ def_ucmd set {
     }
     if {![ta_anymore]} {
 	set ol {}
-	foreach proc [lsort [info procs]] {
-	    if {![regexp {^set_show/(.*)$} $proc dummy opt]} continue
+	foreach opt $settings {
 	    lappend ol [format "%-10s %s" $opt [set_show/$opt]]
 	}
 	ucmdr {} [join $ol "\n"]
@@ -1135,7 +1490,7 @@ def_ucmd set {
 	    error "no setting $opt"
 	}
 	if {![ta_anymore]} {
-	    ucmdr {} "$opt [set_show/$opt]"
+	    ucmdr {} "$opt: [set_show/$opt]"
 	} else {
 	    nick_securitycheck 0
 	    if {[catch { info body set_set/$opt }]} {
@@ -1245,32 +1600,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
 }    
 
@@ -1279,7 +1636,7 @@ proc lnick_pingstring {why oc apstring} {
     catch { exec uptime } uptime
     set nnicks [llength [array names nick_onchans]]
     if {[regexp \
- {^ *([0-9:apm]+) +up.*, +(\d+) users, +load average: +([0-9., ]+) *$} \
+ {^ *([0-9:apm]+) +up.*, +(\d+) users?, +load average: +([0-9., ]+) *$} \
             $uptime dummy time users load]} {
 	regsub -all , $load {} load
         set uptime "$time  $nnicks/$users  $load"
@@ -1307,12 +1664,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 {
@@ -1320,6 +1677,7 @@ def_ucmd ping {
 	}
 	if {[llength $oc]} { lnick_marktime_reset $ln }
     }
+    lnick_checktold $ln
     ucmdr {} [lnick_pingstring "Pong!" $oc $text]
 }