~mdw
/
ircbot
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Startup for chiark.
[ircbot]
/
bot.tcl
diff --git
a/bot.tcl
b/bot.tcl
index
e313f5b
..
f9dcda8
100755
(executable)
--- a/
bot.tcl
+++ b/
bot.tcl
@@
-90,7
+90,7
@@
proc out_runqueue {now} {
set out_queue [lrange $out_queue 1 end]
if {[llength $out_queue]} {
append orgwhen "+[expr {$now - $orgwhen}]"
set out_queue [lrange $out_queue 1 end]
if {[llength $out_queue]} {
append orgwhen "+[expr {$now - $orgwhen}]"
- append orgwhen ([llength $out_queue])"
+ append orgwhen
"
([llength $out_queue])"
}
puts "$orgwhen -> $msg"
puts $sock $msg
}
puts "$orgwhen -> $msg"
puts $sock $msg
@@
-200,7
+200,7
@@
proc onread {args} {
}
if {"$command" == "PRIVMSG" &&
[regexp {^[&#+!]} [lindex $params 0]] &&
}
if {"$command" == "PRIVMSG" &&
[regexp {^[&#+!]} [lindex $params 0]] &&
- ![regexp {^!} [lindex $params 1]]} {
+ ![regexp {^!
[a-z][-a-z]*[a-z]( .*)?$
} [lindex $params 1]]} {
# on-channel message, ignore
catch {
recordlastseen_p $prefix "talking on [lindex $params 0]" 1
# on-channel message, ignore
catch {
recordlastseen_p $prefix "talking on [lindex $params 0]" 1
@@
-415,11
+415,7
@@
proc recordlastseen_n {n how here} {
}
proc note_topic {showoff whoby topic} {
}
proc note_topic {showoff whoby topic} {
- if {[string length $whoby]} {
- set msg "FYI, $whoby has changed the topic on $showoff"
- } else {
- set msg "FYI, I have reset the topic on $showoff"
- }
+ set msg "FYI, $whoby has changed the topic on $showoff"
if {[string length $topic] < 160} {
append msg " to $topic"
} else {
if {[string length $topic] < 160} {
append msg " to $topic"
} else {
@@
-516,6
+512,11
@@
proc leaving {lchan} {
unset nlist
}
unset nlist
}
+proc doleave {lchan} {
+ sendout PART $lchan
+ leaving $lchan
+}
+
proc dojoin {lchan} {
global chan_nicks
sendout JOIN $lchan
proc dojoin {lchan} {
global chan_nicks
sendout JOIN $lchan
@@
-526,7
+527,7
@@
proc check_justme {lchan} {
global nick
upvar #0 chan_nicks($lchan) nlist
if {[llength $nlist] != 1} return
global nick
upvar #0 chan_nicks($lchan) nlist
if {[llength $nlist] != 1} return
- if {"[lindex $nlist 0]" != "
$nick
"} return
+ if {"[lindex $nlist 0]" != "
[irctolower $nick]
"} return
if {[chandb_exists $lchan]} {
set mode [chandb_get $lchan mode]
if {"$mode" != "*"} {
if {[chandb_exists $lchan]} {
set mode [chandb_get $lchan mode]
if {"$mode" != "*"} {
@@
-535,11
+536,9
@@
proc check_justme {lchan} {
set topic [chandb_get $lchan topicset]
if {[string length $topic]} {
sendout TOPIC $lchan $topic
set topic [chandb_get $lchan topicset]
if {[string length $topic]} {
sendout TOPIC $lchan $topic
- note_topic $lchan {} $topic
}
} else {
}
} else {
- sendout PART $lchan
- leaving $lchan
+ doleave $lchan
}
}
}
}
@@
-624,15
+623,15
@@
proc msg_NICK {p c newnick} {
prefix_nick
recordlastseen_n $n "changing nicks to $newnick" 0
recordlastseen_n $newnick "changing nicks from $n" 1
prefix_nick
recordlastseen_n $n "changing nicks to $newnick" 0
recordlastseen_n $newnick "changing nicks from $n" 1
+ set luser [irctolower $n]
+ set lusernew [irctolower $newnick]
foreach ary $nick_arys {
foreach ary $nick_arys {
- upvar #0 nick_${ary}($
n
) old
- upvar #0 nick_${ary}($
newnick
) new
+ upvar #0 nick_${ary}($
luser
) old
+ upvar #0 nick_${ary}($
lusernew
) new
if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
if {[info exists old]} { set new $old; unset old }
}
if {[info exists new]} { error "nick collision ?! $ary $n $newnick" }
if {[info exists old]} { set new $old; unset old }
}
- upvar #0 nick_onchans($new)
- set luser [irctolower $n]
- set lusernew [irctolower $newnick]
+ upvar #0 nick_onchans($lusernew) oc
foreach ch $oc {
upvar #0 chan_nicks($ch) nlist
set nlist [grep tn {"$tn" != "$luser"} $nlist]
foreach ch $oc {
upvar #0 chan_nicks($ch) nlist
set nlist [grep tn {"$tn" != "$luser"} $nlist]
@@
-651,8
+650,12
@@
proc nick_ishere {n} {
proc msg_JOIN {p c chan} {
prefix_nick
recordlastseen_n $n "joining $chan" 1
proc msg_JOIN {p c chan} {
prefix_nick
recordlastseen_n $n "joining $chan" 1
- upvar #0 nick_onchans([irctolower $n]) oc
- lappend oc [irctolower $chan]
+ set nl [irctolower $n]
+ set lchan [irctolower $chan]
+ upvar #0 nick_onchans($nl) oc
+ upvar #0 chan_nicks($lchan) nlist
+ lappend oc $lchan
+ lappend nlist $nl
nick_ishere $n
}
proc msg_PART {p c chan} {
nick_ishere $n
}
proc msg_PART {p c chan} {
@@
-829,20
+832,28
@@
proc loadhelp {} {
}
def_ucmd help {
}
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 \
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."
+ "is very lagged. Please ask for help
$ontopic
again later."
ucmdr {} {}
} else {
sendaction_priority 1 $replyto \
ucmdr {} {}
} else {
sendaction_priority 1 $replyto \
- "is lagged. Your help will arrive shortly ..."
+ "is lagged. Your help
$ontopic
will arrive shortly ..."
}
}
}
}
- upvar #0 help_topics(
[irctolower [string trim $text]]
) info
- if {![info exists info]} { ucmdr "No help on $t
ext
, sorry." {} }
+ upvar #0 help_topics(
$topic
) info
+ if {![info exists info]} { ucmdr "No help on $t
opic
, sorry." {} }
ucmdr $info {}
}
ucmdr $info {}
}
@@
-1148,19
+1159,42
@@
def_chancmd show {
}
}
}
}
-def_ucmd op {
+proc channelmgr_monoop {} {
+ upvar 1 dest dest
+ upvar 1 text text
+ upvar 1 n n
+ upvar 1 p p
+ upvar 1 target target
+ global chan_nicks
+
+ prefix_nick
+
if {[ischan $dest]} { set target $dest }
if {[ta_anymore]} { set target [ta_word] }
ta_nomore
if {[ischan $dest]} { set target $dest }
if {[ta_anymore]} { set target [ta_word] }
ta_nomore
- if {![info exists target]} { error "you must specify, or !... on, the channel" }
+ if {![info exists target]} {
+ error "you must specify, or invoke me on, the relevant channel"
+ }
+ if {![info exists chan_nicks([irctolower $target])]} {
+ error "I am not on $target."
+ }
if {![ischan $target]} { error "not a valid channel" }
if {![ischan $target]} { error "not a valid channel" }
+
if {![chandb_exists $target]} { error "$target is not a managed channel." }
if {![chandb_exists $target]} { error "$target is not a managed channel." }
- prefix_nick
nick_securitycheck 1
channel_securitycheck $target $n
nick_securitycheck 1
channel_securitycheck $target $n
+}
+
+def_ucmd op {
+ channelmgr_monoop
sendout MODE $target +o $n
}
sendout MODE $target +o $n
}
+def_ucmd leave {
+ channelmgr_monoop
+ doleave $target
+}
+
def_ucmd invite {
global chan_nicks
def_ucmd invite {
global chan_nicks
@@
-1510,11
+1544,11
@@
proc fail {msg} {
}
proc ensure_connecting {} {
}
proc ensure_connecting {} {
- global sock ownfullname host port nick
+ global sock ownfullname host port nick
socketargs
global musthaveping_ms musthaveping_after
if {[info exists sock]} return
global musthaveping_ms musthaveping_after
if {[info exists sock]} return
- set sock [
socket $host $port
]
+ set sock [
eval socket $socketargs [list $host $port]
]
fconfigure $sock -buffering line
fconfigure $sock -translation crlf
fconfigure $sock -buffering line
fconfigure $sock -translation crlf