chiark / gitweb /
Working on implementation of tell. Have done: tell, and set tellme. Need to do...
[ircbot] / bot.tcl
diff --git a/bot.tcl b/bot.tcl
index e021af774f92c1c3ecca647b42331b362427c177..fb537d7481c25314236629bc2308a4207d0a428d 100755 (executable)
--- a/bot.tcl
+++ b/bot.tcl
@@ -83,6 +83,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\
@@ -530,7 +547,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"
     }
@@ -559,7 +580,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 *
@@ -569,6 +596,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 }
@@ -962,6 +996,73 @@ 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
+    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
+           if {!$found} {
+               ucmdr "OK, I'll tell $ctarget." {}
+           } else {
+               ucmdr "OK, I'll tell $ctarget that too." {}
+           }
+       }
+       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
@@ -1046,7 +1147,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
@@ -1059,6 +1163,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]"
@@ -1093,19 +1238,8 @@ 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
@@ -1121,7 +1255,74 @@ 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] {}
+}
+
 def_ucmd set {
+    global settings
     prefix_nick
     check_notonchan
     if {![nickdb_exists $n]} {
@@ -1129,8 +1330,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"]
@@ -1140,7 +1340,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 }]} {