Avoid flood kill.

diff --git a/bot.tcl b/bot.tcl
index b187113fb073642ea836aa3b0184b6fba381ee4c..66ab9c27e5e61cc2a502757e1ea37d6878560918 100755 (executable)
--- a/bot.tcl
+++ b/bot.tcl
@@ -6,6 +6,19 @@ if {![info exists nick]} { set nick Blight }
 if {![info exists ownfullname]} { set ownfullname "here to Help" }
 set ownmailaddr blight@chiark.greenend.org.uk
 
+set out_maxburst 6
+set out_interval 2100
+set out_lag_lag 5000
+set out_lag_very 15000
+
+if {![info exists out_queue]} {
+    set out_creditms [expr {$out_maxburst*$out_interval}]
+    set out_creditat [clock seconds]
+    set out_queue {}
+    set out_lag_reported 0
+    set out_lag_reportwhen $out_creditat
+}
+
 if {![info exists globalsecret]} {
     set gsfile [open /dev/urandom r]
     fconfigure $gsfile -translation binary
@@ -45,8 +58,69 @@ proc try_except_finally {try except finally} {
     }
 }
 
-proc sendout {command args} {
+proc out__vars {} {
+    uplevel 1 {
+       global out_queue out_creditms out_creditat out_interval out_maxburst
+       global out_lag_lag out_lag_very
+#set pr [lindex [info level 0] 0]
+#puts $pr>[clock seconds]|$out_creditat|$out_creditms|[llength $out_queue]<
+    }
+}
+
+proc out_lagged {} {
+    out__vars
+    if {[llength $out_queue]*$out_interval > $out_lag_very} {
+       return 2
+    } elseif {[llength $out_queue]*$out_interval > $out_lag_lag} {
+       return 1
+    } else {
+       return 0
+    }
+}
+
+proc out_restart {} {
+    out__vars
+    
+    set now [clock seconds]
+    incr out_creditms [expr {($now - $out_creditat) * 1000}]
+    set out_creditat $now
+    if {$out_creditms > $out_maxburst*$out_interval} {
+       set out_creditms [expr {$out_maxburst*$out_interval}]
+    }
+    out_runqueue $now
+}
+
+proc out_runqueue {now} {
     global sock
+    out__vars
+    
+    while {[llength $out_queue] && $out_creditms >= $out_interval} {
+#puts rq>$now|$out_creditat|$out_creditms|[llength $out_queue]<
+       manyset [lindex $out_queue 0] orgwhen msg
+       set out_queue [lrange $out_queue 1 end]
+       if {[llength $out_queue]} {
+           append orgwhen "+[expr {$now - $orgwhen}]"
+           append orgwhen ([llength $out_queue])"
+       }
+       puts "$orgwhen -> $msg"
+       puts $sock $msg
+       incr out_creditms -$out_interval
+    }
+    if {[llength $out_queue]} {
+       after $out_interval out_nextmessage
+    }
+}
+
+proc out_nextmessage {} {
+    out__vars
+    set now [clock seconds]
+    incr out_creditms $out_interval
+    set out_creditat $now
+    out_runqueue $now
+}
+
+proc sendout_priority {priority command args} {
+    global sock out_queue
     if {[llength $args]} {
        set la [lindex $args end]
        set args [lreplace $args end end]
@@ -59,10 +133,20 @@ proc sendout {command args} {
     }
     set args [lreplace $args 0 -1 $command]
     set string [join $args { }]
-    puts "[clock seconds] -> $string"
-    puts $sock $string
+    set now [clock seconds]
+    set newe [list $now $string]
+    if {$priority} {
+       set out_queue [concat [list $newe] $out_queue]
+    } else {
+       lappend out_queue $newe
+    }
+    if {[llength $out_queue] == 1} {
+       out_restart
+    }
 }
 
+proc sendout {command args} { eval sendout_priority [list 0 $command] $args }
+    
 proc log {data} {
     puts $data
 }
@@ -149,7 +233,9 @@ proc sendprivmsg {dest l} {
        sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $v
     }
 }
-proc sendaction {dest what} { sendout PRIVMSG $dest "\001ACTION $what\001" }
+proc sendaction_priority {priority dest what} {
+    sendout_priority $priority PRIVMSG $dest "\001ACTION $what\001"
+}
 proc msendprivmsg {dest ll} { foreach l $ll { sendprivmsg $dest $l } }
 proc msendprivmsg_delayed {delay dest ll} { after $delay [list msendprivmsg $dest $ll] }
 
@@ -518,7 +604,7 @@ proc msg_PRIVMSG {p c dest text} {
        manyset $rv priv_msgs pub_msgs priv_acts pub_acts
        foreach {td val} [list $n $priv_acts $output $pub_acts] {
            foreach l [split $val "\n"] {
-               sendaction $td $l
+               sendaction_priority 0 $td $l
            }
        }
        foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
@@ -639,6 +725,18 @@ proc loadhelp {} {
 }
 
 def_ucmd help {
+    if {[set lag [out_lagged]]} {
+       if {[ischan $dest]} { set replyto $dest } else { set replyto $n }
+       if {$lag > 1} {
+           sendaction_priority 1 $replyto \
+               "is very lagged.  Please ask for help again later."
+           ucmdr {} {}
+       } else {
+           sendaction_priority 1 $replyto \
+               "is lagged.  Your help will arrive shortly ..."
+       }
+    }
+    
     upvar #0 help_topics([irctolower [string trim $text]]) info
     if {![info exists info]} { ucmdr "No help on $text, sorry." {} }
     ucmdr $info {}