-# Core bot code
+# Actual IRC bot code
+
+set helpfile helpinfos
source irccore.tcl
+source parsecmd.tcl
+source stdhelp.tcl
-proc unlogged_content_msg {prefix params} {
- if {![regexp {^[&#+!]} [lindex $params 0]] ||
+proc privmsg_unlogged {prefix ischan params} {
+ if {!$ischan ||
[regexp {^![a-z][-a-z]*[a-z]( .*)?$} [lindex $params 1]]} {
- return 1
+ return 0
}
# 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 usererror {emsg} { error $emsg {} {BLIGHT USER} }
-
-proc prefix_none {} {
- upvar 1 p p
- if {[string length $p]} { error "prefix specified" }
-}
-
-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" {} {}
- }
+ return 1
}
proc showintervalsecs {howlong abbrev} {
}
nick_case $n
- if {[catch {
- regsub {^! *} $text {} text
- set ucmd [ta_word]
- set procname ucmd/[string tolower $ucmd]
- if {[catch { info body $procname }]} {
- usererror "Unknown command; try help for help."
- }
- $procname $p $dest
- } rv]} {
- if {"$errorCode" != "BLIGHT USER"} { set rv "error: $rv" }
- sendprivmsg $n $rv
- } else {
- 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_priority 0 $td $l
- }
- }
- foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
- foreach l [split $val "\n"] {
- sendprivmsg $td $l
- }
- }
- }
+ execute_usercommand $p $c $n $output $dest $text
}
proc msg_INVITE {p c n chan} {
unset names_chans
}
-proc ta_anymore {} {
- upvar 1 text text
- return [expr {!![string length $text]}]
-}
-
-proc ta_nomore {} {
- upvar 1 text text
- if {[string length $text]} { error "too many parameters" }
-}
-
-proc ta_word {} {
- upvar 1 text text
- if {![regexp {^([^ ]+) *(.*)} $text dummy firstword text]} {
- error "too few parameters"
- }
- return $firstword
-}
-
-proc ta_nick {} {
- upvar 1 text text
- set v [ta_word]
- check_nick $v
- return $v
-}
-
-proc def_ucmd {cmdname body} {
- proc ucmd/$cmdname {p dest} " upvar 1 text text\n$body"
-}
-
-proc ucmdr {priv pub args} {
- return -code return [concat [list $priv $pub] $args]
-}
-
-proc loadhelp {} {
- global help_topics errorInfo
-
- catch { unset help_topics }
- set f [open helpinfos r]
- try_except_finally {
- set lno 0
- while {[gets $f l] >= 0} {
- incr lno
- if {[regexp {^#.*} $l]} {
- } elseif {[regexp {^ *$} $l]} {
- if {[info exists topic]} {
- set help_topics($topic) [join $lines "\n"]
- unset topic
- unset lines
- }
- } elseif {[regexp {^\:\:} $l]} {
- } elseif {[regexp {^\:([-+._0-9a-z]*)$} $l dummy newtopic]} {
- if {[info exists topic]} {
- error "help $newtopic while in $topic"
- }
- set topic $newtopic
- set lines {}
- } elseif {[regexp {^[^:#]} $l]} {
- set topic
- regsub -all {([^\\])\!\$?} _$l {\1} l
- regsub -all {\\(.)} $l {\1} l
- regsub {^_} $l {} l
- lappend lines [string trimright $l]
- } else {
- error "eh ? $lno: $l"
- }
- }
- if {[info exists topic]} { error "unfinished topic $topic" }
- } {
- set errorInfo "in helpinfos line $lno\n$errorInfo"
- } {
- close $f
- }
-}
-
-def_ucmd help {
- upvar 1 n n
-
- set topic [irctolower [string trim $text]]
- if {[string length $topic]} {
- set ontopic " on `$topic'"
- } else {
- set ontopic ""
- }
- 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$ontopic again later."
- ucmdr {} {}
- } else {
- sendaction_priority 1 $replyto \
- "is lagged. Your help$ontopic will arrive shortly ..."
- }
- }
-
- upvar #0 help_topics($topic) info
- if {![info exists info]} { ucmdr "No help on $topic, sorry." {} }
- ucmdr $info {}
-}
-
-def_ucmd ? {
- global help_topics
- ucmdr $help_topics() {}
-}
-
proc check_username {target} {
if {
[string length $target] > 8 ||
unset gsfile
}
-proc ensure_outqueue {} {
- out__vars
- if {[info exists out_queue]} return
- set out_creditms 0
- 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 socketargs
- global musthaveping_ms musthaveping_after
-
- if {[info exists sock]} return
- set sock [eval socket $socketargs [list $host $port]]
- fconfigure $sock -buffering line
- 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"}]
-}
-
proc connected {} {
- global musthaveping_after
-
- after cancel $musthaveping_after
- unset musthaveping_after
-
foreach chan [chandb_list] {
if {[chandb_get $chan autojoin]} { dojoin $chan }
}
}
ensure_globalsecret
-ensure_outqueue
loadhelp
ensure_connecting
--- /dev/null
+set botpass sesame
--- /dev/null
+# Battle.net server bridge thingy
+
+set helpfile bridgehelp
+set bnbot_callervars {nicks}
+
+source irccore.tcl
+source parsecmd.tcl
+source usebnbot.tcl
+source stdhelp.tcl
+
+proc privmsg_unlogged {p ischan params} {
+ global bots errorCode errorInfo line_org_1char
+ if {$ischan} {
+ if {[catch {
+ prefix_nick
+ set text [lindex $params 1]
+ if {"$line_org_1char" == "\001"} {
+ if {[regexp {^\?ACTION (.*)\?$} $text dummy text]} {
+ set towrite "* $n $text"
+ } else {
+ return
+ }
+ } else {
+ set towrite "\[$n] [lindex $params 1]"
+ }
+ foreach botid $bots {
+ upvar #0 bot/$botid/bnchan ch
+ puts $ch $towrite
+ }
+ } emsg]} {
+ log "error: $emsg $errorCode $errorInfo"
+ }
+ return 1
+ } else {
+ prefix_nick
+ execute_usercommand $p PRIVMSG $n $n \
+ [lindex $params 0] [lindex $params 1]
+ return 0
+ }
+}
+
+proc connected {} {
+ global channel
+ sendout JOIN $channel
+}
+
+proc bnnick_clean {n} {
+ if {[regexp {^[-+_0-9a-zA-Z]} $n]} { return $n }
+ return "\"$n\"";
+}
+
+def_bnbot event {l} {
+ global channel errorCode
+ if {[regexp {^1002 JOIN ([^ ]+) \w+} $l dummy n]} {
+ set bnnicks($n) 1
+ sendprivmsg $channel "[bnnick_clean $n] has joined $bnchanfn"
+ } elseif {[regexp {^1003 LEAVE ([^ ]+) \w+$} $l dummy n]} {
+ if {"$n" == "$bnnick"} return
+ catch { unset bnnicks($n) }
+ sendprivmsg $channel "[bnnick_clean $n] has left $bnchanfn"
+ } elseif {[regexp {^1004 WHISPER ([^ ]+) \w+ "(.*)"$} $l dummy n text]} {
+ if {[catch {
+ go_usercommand "$botid $n" $bnchanfn $n $n $text
+ } rv]} {
+ if {"$errorCode" != "BLIGHT USER"} { set rv "error: $rv" }
+ bnbot_write $botid "/msg $n $rv"
+ } else {
+ set rvl {}
+ foreach mt $rv { lappend rvl [split $mt "\n"] }
+ manyset $rvl priv_msgs pub_msgs priv_acts pub_acts
+ foreach m $priv_acts { bnbot_write $botid "/msg $n The bot $m" }
+ foreach m $pub_acts { bnbot_write $botid "/me $m" }
+ foreach m $priv_msgs { bnbot_write $botid "/msg $n $m" }
+ foreach m $pub_msgs { bnbot_writemsg $botid "$n $m" }
+ }
+ } elseif {[regexp {^1001 USER ([^ ]+) \w+} $l dummy n]} {
+ if {"$n" == "$bnnick"} return
+ set bnnicks($n) 1
+ }
+}
+
+proc new_event {} {}
+
+proc msg_353 {p c dest type chan nicklist} {
+ global onchan_nicks channel nick
+ catch { unset onchan_nicks }
+ foreach n $nicklist {
+ regsub {^[@+]} $n {} n
+ if {"$n" == "$nick"} continue
+ set onchan_nicks($n) 1
+ }
+}
+
+proc tellall {msg} {
+ global bots
+ foreach botid $bots { bnbot_writemsg $botid $msg }
+}
+
+proc msg_JOIN {p c chan} {
+ global onchan_nicks
+ prefix_nick
+ tellall "$n has joined $chan"
+ set onchan_nicks($n) 1
+}
+
+proc msg_NICK {p c newnick} {
+ global onchan_nicks
+ prefix_nick
+ kill_nick $n
+ set onchan_nicks($newnick) 1
+ tellall "$n has changed nicks to $newnick"
+}
+
+proc kill_nick {n} { global onchan_nicks; catch { unset onchan_nicks($n) } }
+
+proc msg_KICK {p c chans users comment} {
+ foreach n [split $users ,] {
+ tellall "$user was kicked off $chans ($comment)"
+ kill_nick $n
+ }
+}
+proc msg_KILL {p c user why} {
+ tellall "$user was killed ($why)"
+ kill_nick $user
+}
+proc msg_PART {p c chan} {
+ prefix_nick
+ tellall "$n has left $chan"
+ kill_nick $n
+}
+proc msg_QUIT {p c why} {
+ prefix_nick
+ tellall "$n has signed off ($why)"
+ kill_nick $n
+}
+
+proc who_res {thing l} {
+ if {[llength $l]} {
+ return "$thing: [lsort -dictionary $l]"
+ } else {
+ return "$thing - empty."
+ }
+}
+
+def_bnbot who {} { who_res $bnchanfn [array names bnnicks] }
+
+def_ucmd who {
+ global bots channel onchan_nicks
+ ta_nomore
+ set o [who_res "$channel (IRC)" [array names onchan_nicks]]
+ foreach botid $bots { append o "\n" [bnbot_who $botid] }
+ return [list $o]
+}
+
+loadhelp
+ensure_connecting
+foreach botid $bots { bnbot_ensure_connecting $botid }
--- /dev/null
+:
+Commands:
+ who tell who is on where
+ help display this help
+
+# Local variables:
+# fill-column: 69
+# End:
--- /dev/null
+# Configuration for testbot
+
+set host chiark
+set nick testbot
+set ownfullname confused
+set socketargs {}
+set marktime_min 10
+set channel #test
+
+set bots bw
+source botpass.tcl
+
+set bot/bw/host bnetd.relativity.greenend.org.uk
+set bot/bw/nick iwj-test1
+set bot/bw/pass $botpass
+set bot/bw/channel "Brood War"
+
+set bnbot ./bnbot
+
+source bridge.tcl
proc defset {varname val} {
- upvar #0 $varname var
+ upvar 1 $varname var
if {![info exists var]} { set var $val }
}
}
proc onread {args} {
- global sock nick calling_nick errorInfo errorCode
-
+ global sock nick calling_nick errorInfo errorCode line_org_1char
+
if {[gets $sock line] == -1} { fail "EOF/error on input" }
+ set line_org_1char [string range $line 0 0]
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
+ new_event
if {[regexp -nocase {^:([^ ]+) (.*)} $line dummy prefix remain]} {
set line $remain
log "junk at end: $org"
return
}
- if {"$command" == "PRIVMSG" && [privmsg_unlogged $prefix $params]} {
+ if {"$command" == "PRIVMSG" && \
+ [privmsg_unlogged $prefix [ischan [lindex $params 0]] $params]} {
return
}
log "[clock seconds] <- $org"
return [string tolower $v]
}
+proc prefix_none {} {
+ upvar 1 p p
+ if {[string length $p]} { error "prefix specified" }
+}
+
+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" {} {}
+ }
+}
+
proc msg_PING {p c s1} {
global musthaveping_after
prefix_none
sendout PONG $s1
- if {[info exists musthaveping_after]} connected
+ if {[info exists musthaveping_after]} {
+ after cancel $musthaveping_after
+ unset musthaveping_after
+ connected
+ }
+}
+
+proc ensure_outqueue {} {
+ out__vars
+ if {[info exists out_queue]} return
+ set out_creditms 0
+ 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 socketargs
+ global musthaveping_ms musthaveping_after
+
+ ensure_outqueue
+
+ if {[info exists sock]} return
+ set sock [eval socket $socketargs [list $host $port]]
+ fconfigure $sock -buffering line
+ 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"}]
}
--- /dev/null
+proc ta_anymore {} {
+ upvar 1 text text
+ return [expr {!![string length $text]}]
+}
+
+proc ta_nomore {} {
+ upvar 1 text text
+ if {[string length $text]} { error "too many parameters" }
+}
+
+proc ta_word {} {
+ upvar 1 text text
+ if {![regexp {^([^ ]+) *(.*)} $text dummy firstword text]} {
+ error "too few parameters"
+ }
+ return $firstword
+}
+
+proc ta_nick {} {
+ upvar 1 text text
+ set v [ta_word]
+ check_nick $v
+ return $v
+}
+
+proc usererror {emsg} { error $emsg {} {BLIGHT USER} }
+
+proc go_usercommand {p c n dest text} {
+ regsub {^! *} $text {} text
+ set ucmd [ta_word]
+ set procname ucmd/[string tolower $ucmd]
+ if {[catch { info body $procname }]} {
+ usererror "Unknown command; try help for help."
+ }
+ $procname $p $dest
+}
+
+proc execute_usercommand {p c n output dest text} {
+ global errorCode
+ if {[catch {
+ go_usercommand $p $c $n $dest $text
+ } rv]} {
+ if {"$errorCode" != "BLIGHT USER"} { set rv "error: $rv" }
+ sendprivmsg $n $rv
+ } else {
+ 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_priority 0 $td $l
+ }
+ }
+ foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
+ foreach l [split $val "\n"] {
+ sendprivmsg $td $l
+ }
+ }
+ }
+}
+
+proc def_ucmd {cmdname body} {
+ proc ucmd/$cmdname {p dest} " upvar 1 text text\n$body"
+}
+
+proc ucmdr {priv pub args} {
+ return -code return [concat [list $priv $pub] $args]
+}
+
+proc new_event {} {
+ global errorInfo errorCode
+ set ei $errorInfo
+ set ec $errorCode
+ catch { unset calling_nick }
+ set errorInfo $ei
+ set errorCode $ec
+}
--- /dev/null
+proc loadhelp {} {
+ global help_topics errorInfo helpfile
+
+ catch { unset help_topics }
+ set f [open $helpfile r]
+ try_except_finally {
+ set lno 0
+ while {[gets $f l] >= 0} {
+ incr lno
+ if {[regexp {^#.*} $l]} {
+ } elseif {[regexp {^ *$} $l]} {
+ if {[info exists topic]} {
+ set help_topics($topic) [join $lines "\n"]
+ unset topic
+ unset lines
+ }
+ } elseif {[regexp {^\:\:} $l]} {
+ } elseif {[regexp {^\:([-+._0-9a-z]*)$} $l dummy newtopic]} {
+ if {[info exists topic]} {
+ error "help $newtopic while in $topic"
+ }
+ set topic $newtopic
+ set lines {}
+ } elseif {[regexp {^[^:#]} $l]} {
+ set topic
+ regsub -all {([^\\])\!\$?} _$l {\1} l
+ regsub -all {\\(.)} $l {\1} l
+ regsub {^_} $l {} l
+ lappend lines [string trimright $l]
+ } else {
+ error "eh ? $lno: $l"
+ }
+ }
+ if {[info exists topic]} { error "unfinished topic $topic" }
+ } {
+ set errorInfo "in $helpfile line $lno\n$errorInfo"
+ } {
+ close $f
+ }
+}
+
+def_ucmd help {
+ upvar 1 n n
+
+ set topic [irctolower [string trim $text]]
+ if {[string length $topic]} {
+ set ontopic " on `$topic'"
+ } else {
+ set ontopic ""
+ }
+ 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$ontopic again later."
+ ucmdr {} {}
+ } else {
+ sendaction_priority 1 $replyto \
+ "is lagged. Your help$ontopic will arrive shortly ..."
+ }
+ }
+
+ upvar #0 help_topics($topic) info
+ if {![info exists info]} { ucmdr "No help on $topic, sorry." {} }
+ ucmdr $info {}
+}
+
+def_ucmd ? {
+ global help_topics
+ ucmdr $help_topics() {}
+}
+
--- /dev/null
+# Code for starting up bnbot
+
+proc def_bnbot {name argl body} {
+ proc "bnbot_$name" [concat botid $argl] \
+ "bnbot__vars\n
+ $body"
+}
+
+proc bnbot__vars {} {
+ global bnbot_callervars
+ upvar 1 botid botid
+ foreach v [concat {
+ host port nick pass channel
+ chan mbokafter state chanfn
+ } $bnbot_callervars] {
+ uplevel 1 [list upvar #0 "bot/$botid/$v" bn$v]
+ }
+}
+
+def_bnbot ensure_connecting {} {
+ global musthaveping_ms bnbot
+
+ if {[info exists bnchan]} return
+ defset bnport 6112
+ set bnchan [open [list | $bnbot $bnhost $bnport] w+]
+ fconfigure $bnchan -buffering line
+ set bnmbokafter [after $musthaveping_ms \
+ "fail {bot $botid not ok within timeout}"]
+ set bnstate Connected
+ fileevent $bnchan readable [list bnbot_onread $botid]
+}
+
+def_bnbot write {str} {
+ log "[clock seconds] -$botid-> $str"
+ puts $bnchan $str
+}
+
+def_bnbot writemsg {str} {
+ if {[regexp {^/} $str]} { set str " $str" }
+ bnbot_write $botid $str
+}
+
+def_bnbot onread {args} {
+ global channel
+ if {[gets $bnchan l] == -1} { fail "bot $bot EOF/error on input" }
+ if {[regexp {^1005 TALK ([^ ]+) \w+ \"(.*)\"$} $l dummy n text]} {
+ sendprivmsg $channel "\[$n] $text"
+ return
+ } elseif {[regexp {^1023 EMOTE ([^ ]+) \w+ \"(.*)\"$} $l dummy n text]} {
+ if {"$n" == "$bnnick"} return
+ sendprivmsg $channel "* $n $text"
+ return
+ }
+ log "[clock seconds] <-$botid- $l"
+ if {[string length $bnstate] && [regexp "^$bnstate" $l]} {
+ switch -exact $bnstate {
+ Connected { set bnstate Username }
+ Username { set bnstate Password; bnbot_write $botid $bnnick }
+ Password {
+ set bnstate "1007 CHANNEL"
+ puts $bnchan $bnpass
+ }
+ {1007 CHANNEL} {
+ set bnstate {}
+ bnbot_write $botid "/CHANNEL $bnchannel"
+ }
+ default { error "wrong bnstate: $bnstate" }
+ }
+ } elseif {[regexp {^1007 CHANNEL "(.*)"} $l dummy bnchanfn]} {
+ after cancel $bnmbokafter
+ unset bnmbokafter
+ } elseif {![string length $bnstate]} {
+ bnbot_event $botid $l
+ }
+}
~mdw / ircbot / commitdiff