From 574abac6430df672a6ad566fffcce7422933c68a Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 10 Jun 2001 12:47:11 +0000 Subject: [PATCH] Split IRC core stuff off ? --- bot.tcl | 266 +++--------------------------------------------------------- irccore.tcl | 251 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 262 insertions(+), 255 deletions(-) create mode 100644 irccore.tcl diff --git a/bot.tcl b/bot.tcl index 5b73d6a..da2a472 100755 --- a/bot.tcl +++ b/bot.tcl @@ -1,271 +1,27 @@ # Core bot code -proc defset {varname val} { - upvar #0 $varname var - if {![info exists var]} { set var $val } -} - -# must set host -defset port 6667 - -defset nick testbot -defset ownfullname "testing bot" -defset ownmailaddr test-irc-bot@example.com - -defset musthaveping_ms 10000 -defset out_maxburst 6 -defset out_interval 2100 -defset out_lag_lag 5000 -defset out_lag_very 25000 - -defset marktime_min 300 -defset marktime_join_startdelay 5000 - -proc manyset {list args} { - foreach val $list var $args { - upvar 1 $var my - set my $val - } -} +source irccore.tcl -proc try_except_finally {try except finally} { - global errorInfo errorCode - set er [catch { uplevel 1 $try } emsg] - if {$er} { - set ei $errorInfo - set ec $errorCode - if {[catch { uplevel 1 $except } emsg3]} { - append ei "\nALSO ERROR HANDLING ERROR:\n$emsg3" - } - } - set er2 [catch { uplevel 1 $finally } emsg2] - if {$er} { - if {$er2} { - append ei "\nALSO ERROR CLEANING UP:\n$emsg2" - } - return -code $er -errorinfo $ei -errorcode $ec $emsg - } elseif {$er2} { - return -code $er2 -errorinfo $errorInfo -errorcode $errorCode $emsg2 - } else { - return $emsg - } -} - -proc usererror {emsg} { error $emsg {} {BLIGHT USER} } - -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} { +proc unlogged_content_msg {prefix params} { + if {![regexp {^[&#+!]} [lindex $params 0]] || + [regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} { 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] - foreach i $args { - if {[regexp {[: ]} $i]} { - error "bad argument in output $i ($command $args)" - } - } - lappend args :$la - } - set args [lreplace $args 0 -1 $command] - set string [join $args { }] - 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 } + # on-channel message, ignore + set chan [lindex $params 0] + upvar #0 chan_lastactivity([irctolower $chan]) la + set la [clock seconds] + catch { recordlastseen_p $prefix "talking on $chan" 1 } + return } -proc sendout {command args} { eval sendout_priority [list 0 $command] $args } - -proc log {data} { - puts $data -} - -proc logerror {data} { - log $data -} - -proc saveeic {} { - global saveei saveec errorInfo errorCode - - set saveei $errorInfo - set saveec $errorCode - - puts ">$saveec|$saveei<" -} - -proc bgerror {msg} { - global save - logerror $msg - saveeic -} - -proc onread {args} { - global sock nick calling_nick errorInfo errorCode - - if {[gets $sock line] == -1} { fail "EOF/error on input" } - regsub -all "\[^ -\176\240-\376\]" $line ? line - set org $line - - set ei $errorInfo - set ec $errorCode - catch { unset calling_nick } - set errorInfo $ei - set errorCode $ec - - if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} { - set line $remain - if {[regexp {^([^!]+)!} $prefix dummy maybenick]} { - set calling_nick $maybenick - if {"[irctolower $maybenick]" == "[irctolower $nick]"} return - } - } else { - set prefix {} - } - if {![string length $line]} { return } - if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} { - log "bad command: $org" - return - } - set command [string toupper $command] - set params {} - while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} { - lappend params $thisword - } - if {[regexp {^:(.*)} $line dummy thisword]} { - lappend params $thisword - } elseif {[string length $line]} { - log "junk at end: $org" - return - } - if {"$command" == "PRIVMSG" && - [regexp {^[&#+!]} [lindex $params 0]] && - ![regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} { - # on-channel message, ignore - set chan [lindex $params 0] - upvar #0 chan_lastactivity([irctolower $chan]) la - set la [clock seconds] - catch { recordlastseen_p $prefix "talking on $chan" 1 } - return - } - log "[clock seconds] <- $org" - set procname msg_$command - if {[catch { info body $procname }]} { return } - if {[catch { - eval [list $procname $prefix $command] $params - } emsg]} { - logerror "error: $emsg ($prefix $command $params)" - saveeic - } -} - -proc sendprivmsg {dest l} { - foreach v [split $l "\n"] { - sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $v - } -} -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] } +proc usererror {emsg} { error $emsg {} {BLIGHT USER} } proc prefix_none {} { upvar 1 p p if {[string length $p]} { error "prefix specified" } } -proc msg_PING {p c s1} { - global musthaveping_after - prefix_none - sendout PONG $s1 - if {[info exists musthaveping_after]} connected -} - -proc check_nick {n} { - if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" } - if {[regexp {^[-0-9]} $n]} { error "bad nick start" } -} - -proc ischan {dest} { - return [regexp {^[&#+!]} $dest] -} - -proc irctolower {v} { - foreach {from to} [list "\\\[" "{" \ - "\\\]" "}" \ - "\\\\" "|" \ - "~" "^"] { - regsub -all $from $v $to v - } - return [string tolower $v] -} - proc prefix_nick {} { global nick upvar 1 p p diff --git a/irccore.tcl b/irccore.tcl new file mode 100644 index 0000000..0efb0e9 --- /dev/null +++ b/irccore.tcl @@ -0,0 +1,251 @@ +proc defset {varname val} { + upvar #0 $varname var + if {![info exists var]} { set var $val } +} + +# must set host +defset port 6667 + +defset nick testbot +defset ownfullname "testing bot" +defset ownmailaddr test-irc-bot@example.com + +defset musthaveping_ms 10000 +defset out_maxburst 6 +defset out_interval 2100 +defset out_lag_lag 5000 +defset out_lag_very 25000 + +defset marktime_min 300 +defset marktime_join_startdelay 5000 + +proc manyset {list args} { + foreach val $list var $args { + upvar 1 $var my + set my $val + } +} + +proc try_except_finally {try except finally} { + global errorInfo errorCode + set er [catch { uplevel 1 $try } emsg] + if {$er} { + set ei $errorInfo + set ec $errorCode + if {[catch { uplevel 1 $except } emsg3]} { + append ei "\nALSO ERROR HANDLING ERROR:\n$emsg3" + } + } + set er2 [catch { uplevel 1 $finally } emsg2] + if {$er} { + if {$er2} { + append ei "\nALSO ERROR CLEANING UP:\n$emsg2" + } + return -code $er -errorinfo $ei -errorcode $ec $emsg + } elseif {$er2} { + return -code $er2 -errorinfo $errorInfo -errorcode $errorCode $emsg2 + } else { + return $emsg + } +} + +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] + foreach i $args { + if {[regexp {[: ]} $i]} { + error "bad argument in output $i ($command $args)" + } + } + lappend args :$la + } + set args [lreplace $args 0 -1 $command] + set string [join $args { }] + 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 +} + +proc logerror {data} { + log $data +} + +proc saveeic {} { + global saveei saveec errorInfo errorCode + + set saveei $errorInfo + set saveec $errorCode + + puts ">$saveec|$saveei<" +} + +proc bgerror {msg} { + global save + logerror $msg + saveeic +} + +proc onread {args} { + global sock nick calling_nick errorInfo errorCode + + if {[gets $sock line] == -1} { fail "EOF/error on input" } + regsub -all "\[^ -\176\240-\376\]" $line ? line + set org $line + + set ei $errorInfo + set ec $errorCode + catch { unset calling_nick } + set errorInfo $ei + set errorCode $ec + + if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} { + set line $remain + if {[regexp {^([^!]+)!} $prefix dummy maybenick]} { + set calling_nick $maybenick + if {"[irctolower $maybenick]" == "[irctolower $nick]"} return + } + } else { + set prefix {} + } + if {![string length $line]} { return } + if {![regexp -nocase {^([0-9a-z]+) *(.*)} $line dummy command line]} { + log "bad command: $org" + return + } + set command [string toupper $command] + set params {} + while {[regexp {^([^ :]+) *(.*)} $line dummy thisword line]} { + lappend params $thisword + } + if {[regexp {^:(.*)} $line dummy thisword]} { + lappend params $thisword + } elseif {[string length $line]} { + log "junk at end: $org" + return + } + if {"$command" == "PRIVMSG" && [privmsg_unlogged $prefix $params]} { + return + } + log "[clock seconds] <- $org" + set procname msg_$command + if {[catch { info body $procname }]} { return } + if {[catch { + eval [list $procname $prefix $command] $params + } emsg]} { + logerror "error: $emsg ($prefix $command $params)" + saveeic + } +} + +proc sendprivmsg {dest l} { + foreach v [split $l "\n"] { + sendout [expr {[ischan $dest] ? "PRIVMSG" : "NOTICE"}] $dest $v + } +} +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] } + +proc check_nick {n} { + if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in nick" } + if {[regexp {^[-0-9]} $n]} { error "bad nick start" } +} + +proc ischan {dest} { + return [regexp {^[&#+!]} $dest] +} + +proc irctolower {v} { + foreach {from to} [list "\\\[" "{" \ + "\\\]" "}" \ + "\\\\" "|" \ + "~" "^"] { + regsub -all $from $v $to v + } + return [string tolower $v] +} + +proc msg_PING {p c s1} { + global musthaveping_after + prefix_none + sendout PONG $s1 + if {[info exists musthaveping_after]} connected +} -- 2.11.0