global musthaveping_after
prefix_none
sendout PONG $s1
- if {[info exists musthaveping_after]} {
- after cancel $musthaveping_after
- unset musthaveping_after
- }
+ if {[info exists musthaveping_after]} connected
}
proc check_nick {n} {
set who [chanmode_arg]
recordlastseen_n $n "being nice to $who" 1
if {"[irctolower $who]" == "[irctolower $nick]"} {
- set nl [irctolower $n]
- upvar #0 nick_unique($n) u
+ set nlower [irctolower $n]
+ upvar #0 nick_unique($nlower) u
if {[chandb_exists $chan]} {
sendprivmsg $n Thanks.
} elseif {![info exists u]} {
}
}
-proc channel_noone_seen {chan} {
- global nick_onchans
- foreach n [array names nick_onchans] {
- upvar #0 nick_onchans($n) oc
- set oc [grep tc {"$tc" != "$chan"} $oc]
+proc leaving {lchan} {
+ foreach luser [array names nick_onchans] {
+ upvar #0 nick_onchans($luser) oc
+ set oc [grep tc {"$tc" != "$lchan"} $oc]
+ }
+ upvar #0 chan_nicks($lchan) nlist
+ unset nlist
+}
+
+proc dojoin {lchan} {
+ global chan_nicks
+ sendout JOIN $lchan
+ set chan_nicks($lchan) {}
+}
+
+proc check_justme {lchan} {
+ global nick
+ upvar #0 chan_nicks($lchan) nlist
+ if {[llength $nlist] != 1} return
+ if {"[lindex $nlist 0]" != "$nick"} return
+ if {[chandb_exists $lchan]} {
+ set mode [chandb_get $lchan mode]
+ if {"$mode" != "*"} {
+ sendout MODE $lchan $mode
+ }
+ } else {
+ sendout PART $lchan
+ leaving $lchan
}
}
proc process_kickpart {chan user} {
global nick
check_nick $user
+ set luser [irctolower $user]
+ set lchan [irctolower $chan]
if {![ischan $chan]} { error "not a channel" }
- if {"[irctolower $user]" == "[irctolower $nick]"} {
- channel_noone_seen $chan
+ if {"$luser" == "[irctolower $nick]"} {
+ leaving $lchan
+ } else {
+ upvar #0 nick_onchans($luser) oc
+ upvar #0 chan_nicks($lchan) nlist
+ set oc [grep tc {"$tc" != "$lchan"} $oc]
+ set nlist [grep tn {"$tn" != "$luser"} $nlist]
+ nick_case $user
+ if {![llength $oc]} {
+ nick_forget $luser
+ } else {
+ check_justme $lchan
+ }
}
- upvar #0 nick_onchans($user) oc
- set lc [irctolower $chan]
- set oc [grep tc {"$tc" != "$lc"} $oc]
- if {![llength $oc]} { nick_forget $user }
- nick_case $user
-}
+}
proc msg_KICK {p c chans users comment} {
set chans [split $chans ,]
set nick_counter 0
set nick_arys {onchans username unique}
+# nick_onchans($luser) -> [list ... $lchan ...]
+# nick_username($luser) -> <securely known local username>
+# nick_unique($luser) -> <counter>
+# nick_case($luser) -> $user (valid even if no longer visible)
+
+# chan_nicks($lchan) -> [list ... $luser ...]
-proc nick_forget {n} {
- global nick_arys
+proc lnick_forget {luser} {
+ global nick_arys chan_nicks
foreach ary $nick_arys {
- upvar #0 nick_${ary}($n) av
+ upvar #0 nick_${ary}($luser) av
catch { unset av }
}
- nick_case $n
+ foreach lch [array names chan_nicks] {
+ upvar #0 chan_nicks($lch) nlist
+ set nlist [grep tn {"$tn" != "$luser"} $nlist]
+ check_justme $lch
+ }
+}
+
+proc nick_forget {user} {
+ global nick_arys chan_nicks
+ lnick_forget [irctolower $user]
+ nick_case $user
}
-proc nick_case {n} {
+proc nick_case {user} {
global nick_case
- set nick_case([irctolower $n]) $n
+ set nick_case([irctolower $user]) $user
}
proc msg_NICK {p c newnick} {
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]
+ foreach ch $oc {
+ upvar #0 chan_nicks($ch) nlist
+ set nlist [grep tn {"$tn" != "$luser"} $nlist]
+ lappend nlist $lusernew
+ }
nick_case $newnick
}
proc nick_ishere {n} {
global nick_counter
- upvar #0 nick_unique($n) u
+ upvar #0 nick_unique([irctolower $n]) u
if {![info exists u]} { set u [incr nick_counter].$n.[clock seconds] }
nick_case $n
}
proc msg_JOIN {p c chan} {
prefix_nick
recordlastseen_n $n "joining $chan" 1
- upvar #0 nick_onchans($n) oc
+ upvar #0 nick_onchans([irctolower $n]) oc
lappend oc [irctolower $chan]
nick_ishere $n
}
}
proc msg_INVITE {p c n chan} {
- after 1000 [list sendout JOIN $chan]
+ after 1000 [list dojoin [irctolower $chan]]
}
proc grep {var predicate list} {
proc msg_353 {p c dest type chan nicklist} {
global names_chans nick_onchans
- if {![info exists names_chans]} { set names_chans {} }
- set chan [irctolower $chan]
- lappend names_chans $chan
- channel_noone_seen $chan
- foreach n [split $nicklist { }] {
- regsub {^[@+]} $n {} n
- if {![string length $n]} continue
- check_nick $n
- upvar #0 nick_onchans($n) oc
- lappend oc $chan
- nick_ishere $n
+ set lchan [irctolower $chan]
+ upvar #0 chan_nicks($lchan) nlist
+ lappend names_chans $lchan
+ if {![info exists nlist]} {
+ # We don't think we're on this channel, so ignore it !
+ # Unfortunately, because we don't get a reply to PART,
+ # we have to remember ourselves whether we're on a channel,
+ # and ignore stuff if we're not, to avoid races. Feh.
+ return
+ }
+ set nlist_new {}
+ foreach user [split $nicklist { }] {
+ regsub {^[@+]} $user {} user
+ if {![string length $user]} continue
+ check_nick $user
+ set luser [irctolower $user]
+ upvar #0 nick_onchans($luser) oc
+ lappend oc $lchan
+ lappend nlist_new $luser
+ nick_ishere $user
}
+ set nlist $nlist_new
}
proc msg_366 {p c args} {
global names_chans nick_onchans
- if {[llength names_chans] > 1} {
- foreach n [array names nick_onchans] {
- upvar #0 nick_onchans($n) oc
+ set lchan [irctolower $c]
+ foreach luser [array names nick_onchans] {
+ upvar #0 nick_onchans($luser) oc
+ if {[llength names_chans] > 1} {
set oc [grep tc {[lsearch -exact $tc $names_chans] >= 0} $oc]
- if {![llength $oc]} { nick_forget $n }
}
+ if {![llength $oc]} { lnick_forget $n }
}
unset names_chans
}
proc def_somedb {name arglist body} {
foreach {nickchan fprefix} {nick users/n chan chans/c} {
proc ${nickchan}db_$name $arglist \
- "set nickchan $nickchan; set fprefix $fprefix; somedb__head; $body"
+ "set nickchan $nickchan; set fprefix $fprefix; $body"
+ }
+}
+
+def_somedb list {} {
+ set list {}
+ foreach path [glob -nocomplain -path $fprefix *] {
+ binary scan $path "A[string length $fprefix]A*" afprefix thinghex
+ if {"$afprefix" != "$fprefix"} { error "wrong prefix $path $afprefix" }
+ lappend list [binary format H* $thinghex]
}
+ return $list
+}
+
+proc def_somedb_id {name arglist body} {
+ def_somedb $name [concat id $arglist] "somedb__head; $body"
}
-def_somedb exists {id} {
+def_somedb_id exists {} {
return [info exists iddbe]
}
-def_somedb delete {id} {
+def_somedb_id delete {} {
catch { unset iddbe }
file delete $idfn
}
set default_settings_nick {timeformat ks}
-set default_settings_chan {autojoin 1}
+set default_settings_chan {autojoin 1 mode *}
-def_somedb set {id args} {
+def_somedb_id set {args} {
upvar #0 default_settings_$nickchan def
if {![info exists iddbe]} { set iddbe $def }
foreach {key value} [concat $iddbe $args] { set a($key) $value }
set iddbe $newval
}
-def_somedb get {id key} {
+def_somedb_id get {key} {
upvar #0 default_settings_$nickchan def
if {[info exists iddbe]} {
- set l $iddbe
+ set l [concat $iddbe $def]
} else {
set l $def
}
return
}
}
- upvar #0 nick_username($n) nu
+ set luser [irctolower $n]
+ upvar #0 nick_username($luser) nu
if {![info exists nu]} {
error "nick $n is secure, you must identify yourself first."
}
default { error "channel autojoin must be `yes' or `no' }
}
chandb_set $chan autojoin $nv
+ ucmdr [expr {$nv ? "I will join #chan when I'm restarted " : \
+ "I won't join #chan when I'm restarted "}] {}
+}
+
+def_chancmd mode {
+ set mode [ta_word]
+ if {"$mode" != "*" && ![regexp {^(([-+][imnpst]+)+)$} $mode mode]} {
+ error {channel mode must be * or match ([-+][imnpst]+)+}
+ }
+ chandb_set $chan mode $mode
+ if {"$mode" == "*"} {
+ ucmdr "I won't ever change the mode of #chan." {}
+ } else {
+ ucmdr "Whenever I'm alone on #chan, I'll set the mode to $mode." {}
+ }
}
def_chancmd show {
if {[chandb_exists $chan]} {
set l "Settings for $chan: autojoin "
append l [lindex {no yes} [chandb_get $chan autojoin]]
+ append l ", mode " [chandb_get $chan mode] "."
append l "\nManagers: "
append l [join [chandb_get $chan managers] " "]
ucmdr {} $l
channel_securitycheck $target $n
} else {
upvar #0 chan_initialop([irctolower $target]) io
- upvar #0 nick_unique($n) u
+ upvar #0 nick_unique([irctolower $n]) u
if {![info exists io]} { error "$target is not a managed channel" }
if {"$io" != "$u"} { error "you are not the interim manager of $target" }
if {"$subcmd" != "manager"} { error "use `channel manager' first" }
set target $n
set myself [expr {"$target" != "$n"}]
}
- upvar #0 nick_case([irctolower $target]) nc
+ set ltarget [irctolower $target]
+ upvar #0 nick_case($ltarget) ctarget
set nshow $target
- if {[info exists nc]} {
- upvar #0 nick_onchans($nc) oc
- upvar #0 nick_username($nc) nu
- if {[info exists oc]} { set nshow $nc }
+ if {[info exists ctarget]} {
+ upvar #0 nick_onchans($ltarget) oc
+ upvar #0 nick_username($ltarget) nu
+ if {[info exists oc]} { set nshow $ctarget }
}
- if {![nickdb_exists $target]} {
+ if {![nickdb_exists $ltarget]} {
set ol "$nshow is not a registered nick."
} elseif {[string length [set username [nickdb_get $target username]]]} {
set ol "The nick $nshow belongs to the user $username."
} else {
set ol "The nick $nshow is registered (but not to a username)."
}
- if {![info exists nc] || ![info exists oc]} {
+ if {![info exists ctarget] || ![info exists oc]} {
if {$myself} {
append ol "\nI can't see $nshow on anywhere."
} else {
check_notonchan
set old [nickdb_exists $n]
if {$old} { nick_securitycheck 0 }
+ set luser [irctolower $n]
switch -exact [string tolower [string trim $text]] {
{} {
- upvar #0 nick_username($n) nu
+ upvar #0 nick_username($luser) nu
if {![info exists nu]} {
ucmdr {} \
"You must identify yourself before using `register'. See `help identify', or use `register insecure'."
ta_nomore
prefix_nick
check_notonchan
- upvar #0 nick_onchans($n) onchans
+ set luser [irctolower $n]
+ upvar #0 nick_onchans($luser) onchans
if {![info exists onchans] || ![llength $onchans]} {
ucmdr "You must be on a channel with me to identify yourself." {}
}
check_username $username
exec userv --timeout 3 $username << "$passmd5\n" > /dev/null \
irc-identpass $n
- upvar #0 nick_username($n) rec_username
+ upvar #0 nick_username($luser) rec_username
set rec_username $username
ucmdr "Pleased to see you, $username." {}
}
{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
~mdw / ircbot / commitdiff