-}
-
-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" &&
- [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 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
- upvar 1 n n
- if {![regexp {^([^!]+)!} $p dummy n]} { error "not from nick" }
- check_nick $n
- if {"[irctolower $n]" == "[irctolower $nick]"} {
- error "from myself" {} {}
- }