X-Git-Url: https://git.distorted.org.uk/~mdw/ircbot/blobdiff_plain/c362e1729f5517438d2d96c9793cf5754cdb3f3e..28c8ab788e2733e81f35d586bdbbe1678ce0398f:/bot.tcl diff --git a/bot.tcl b/bot.tcl index b187113..55d93c7 100755 --- a/bot.tcl +++ b/bot.tcl @@ -6,14 +6,11 @@ if {![info exists nick]} { set nick Blight } if {![info exists ownfullname]} { set ownfullname "here to Help" } set ownmailaddr blight@chiark.greenend.org.uk -if {![info exists globalsecret]} { - set gsfile [open /dev/urandom r] - fconfigure $gsfile -translation binary - set globalsecret [read $gsfile 32] - binary scan $globalsecret H* globalsecret - close $gsfile - unset gsfile -} +set musthaveping_ms 10000 +set out_maxburst 6 +set out_interval 2100 +set out_lag_lag 5000 +set out_lag_very 25000 proc manyset {list args} { foreach val $list var $args { @@ -45,8 +42,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 +117,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 } @@ -89,7 +157,7 @@ proc bgerror {msg} { proc onread {args} { global sock nick calling_nick errorInfo errorCode - if {[gets $sock line] == -1} { set terminate 1; return } + if {[gets $sock line] == -1} { fail "EOF/error on input" } regsub -all "\[^ -\176\240-\376\]" $line ? line set org $line @@ -149,7 +217,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] } @@ -159,8 +229,10 @@ proc prefix_none {} { } proc msg_PING {p c s1} { + global musthaveping_after prefix_none sendout PONG $s1 + if {[info exists musthaveping_after]} { after cancel $musthaveping_after] } } proc check_nick {n} { @@ -518,7 +590,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 +711,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 {} @@ -1102,18 +1186,54 @@ def_ucmd seen { ucmdr {} $rstr } -if {![info exists sock]} { +proc ensure_globalsecret {} { + global globalsecret + + if {[info exists globalsecret]} return + set gsfile [open /dev/urandom r] + fconfigure $gsfile -translation binary + set globalsecret [read $gsfile 32] + binary scan $globalsecret H* globalsecret + close $gsfile + unset gsfile +} + +proc ensure_outqueue {} { + out__vars + if {[info exists out_queue]} return + 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 +} + +proc fail {msg} { + logerror "failing: $msg" + exit 1 +} + +proc ensure_connecting {} { + global sock ownfullname host port nick + global musthaveping_ms musthaveping_after + + if {[info exists sock]} return set sock [socket $host $port] fconfigure $sock -buffering line - #fconfigure $sock -translation binary fconfigure $sock -translation crlf sendout USER blight 0 * $ownfullname sendout NICK $nick fileevent $sock readable onread + + set musthaveping_after [after $musthaveping_ms \ + {fail "no ping within timeout"}] } +ensure_globalsecret +ensure_outqueue loadhelp +ensure_connecting #if {![regexp {tclsh} $argv0]} { # vwait terminate