From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 7 Sep 2000 18:22:45 +0000 (+0000)
Subject: Avoid flood kill.
X-Git-Tag: branchpoint-2001-10-09-tell~51
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/ircbot/commitdiff_plain/7818b6afb539ce627b9887e73e43ee684928fd53

Avoid flood kill.
---

diff --git a/bot.tcl b/bot.tcl
index b187113..66ab9c2 100755
--- 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 {}