X-Git-Url: https://git.distorted.org.uk/~mdw/ircbot/blobdiff_plain/281f2c0e568eb3fac93173a3d0b852259e61245f..65aff3a3a7ac86da7aca85a10ab0193c935e6f61:/bot.tcl

diff --git a/bot.tcl b/bot.tcl
index fc98c2e..ab788e2 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" 1 }
     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\
@@ -376,9 +396,10 @@ proc nick_case {user} {
 }
 
 proc msg_NICK {p c newnick} {
-    global nick_arys nick_case
+    global nick_arys nick_case calling_nick
     prefix_nick
     recordlastseen_n $n "changing nicks to $newnick" 0
+    set calling_nick $newnick
     recordlastseen_n $newnick "changing nicks from $n" 1
     set luser [irctolower $n]
     lnick_marktime_cancel $luser
@@ -395,7 +416,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
 }
 
@@ -415,15 +436,20 @@ 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} {
@@ -524,7 +550,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"
     }
@@ -553,7 +583,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 *
@@ -563,6 +599,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 }
@@ -956,6 +999,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 mailto 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: $mailto
+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.)
+"
+            ucmdr \
+ "I've mailed $ctarget at $mailto, 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
@@ -1026,6 +1150,9 @@ def_ucmd register {
 		ucmdr {} "This is fine, but bear in mind that people will be able to mess with your settings.  Channel management features need a secure registration." "makes an insecure registration for your nick."
 	    }
 	}
+	default {
+	    error "you mean register / register delete / register insecure"
+	}
     }
 }
 
@@ -1037,7 +1164,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
@@ -1050,6 +1180,47 @@ proc def_setting {opt show_body set_body} {
         $set_body"
 }
 
+proc tellme_sec_desc {v} {
+    manyset $v sec mailto
+    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."
+	}
+	refuse {
+	    return "I shan't accept messages for you."
+	}
+	mailto {
+	    return "I'll forward your messages by email to $mailto."
+	}
+	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]"
@@ -1084,22 +1255,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]
 }
 
@@ -1112,7 +1272,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]} {
@@ -1120,8 +1378,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"]
@@ -1131,7 +1388,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 }]} {
@@ -1241,32 +1498,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
 }    
 
@@ -1275,7 +1534,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"
@@ -1303,12 +1562,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 {
@@ -1316,6 +1575,7 @@ def_ucmd ping {
 	}
 	if {[llength $oc]} { lnick_marktime_reset $ln }
     }
+    lnick_checktold $ln
     ucmdr {} [lnick_pingstring "Pong!" $oc $text]
 }