From c31ed83cb357d713943b5a3f72d1130de2a441a8 Mon Sep 17 00:00:00 2001 From: ijackson Date: Sun, 9 Jun 2002 22:50:35 +0000 Subject: [PATCH] bugfixes --- irccore.tcl | 1 + ledconfig.tcl | 5 -- ledmodule.tcl | 202 +++++++++++++++++++++++++++++++++++++++++--------- 3 files changed, 169 insertions(+), 39 deletions(-) diff --git a/irccore.tcl b/irccore.tcl index 34836e2..545446c 100644 --- a/irccore.tcl +++ b/irccore.tcl @@ -5,6 +5,7 @@ proc defset {varname val} { # must set host defset port 6667 +defset socketargs {} defset nick testbot defset ident blight diff --git a/ledconfig.tcl b/ledconfig.tcl index 3d0a6b4..2896afe 100644 --- a/ledconfig.tcl +++ b/ledconfig.tcl @@ -4,10 +4,5 @@ set host chiark-tunnel.greenend.org.uk set nick ledctrl set ownfullname "activity LEDs" set ownmailaddr ijackson@chiark.greenend.org.uk -set socketargs {} -set errchan #$nick -set retry_after 300000 -set chan_after 3000 -set chans_retry 3600000 source ledmodule.tcl diff --git a/ledmodule.tcl b/ledmodule.tcl index 3986863..250f600 100644 --- a/ledmodule.tcl +++ b/ledmodule.tcl @@ -39,22 +39,33 @@ source parsecmd.tcl source stdhelp.tcl source userv.tcl +defset errchan #$nick +defset retry_after 900000 +defset chan_after 3000 +defset chans_retry 3600000 +defset debug_reset_after 86400000 + +defset debugusers {} + # variables # # monitor/$monname(chans) -> [list $chan1 $chan2 ...] # monitor/$monname(ignore) -> [list $regexp ...] # monitor/$monname(prefer) -> [list $regexp ...] -# monitor/$monname(present) -> [list $lnick ...] +# monitor/$monname(present-$chan) -> [list $lnick ...] # monitor/$monname(last-talk) -> $time_t # monitor/$monname(last-talkpref) -> $time_t # monitor/$monname(time-recent) -> $seconds # monitor/$monname(time-recentnow) -> $seconds +# monitor/$monname(talkchange) -> [after ...] or unset # # deviceset/$username:$lno(monname) -> $monname # deviceset/$username:$lno(group) -> $led_group # deviceset/$username:$lno(username) -> $username +# deviceset/$username:$lno(values) -> $valuestring # deviceset/$username:$lno(states) -> [list $state1 $value1 $state2 ...] -# deviceset/$username:$lno(fchan) -> [open remoteleds ... |] or unset +# deviceset/$username:$lno(ochan) -> [open remoteleds ... | r] or unset +# deviceset/$username:$lno(ichan) -> fifo for remoteleds input or unset # deviceset/$username:$lno(retry) -> [after ... ] or unset # # onchans($chan) [list mustleave] # in config_chane @@ -62,6 +73,21 @@ source userv.tcl # onchans($chan) [list forced] # for errchan # onchans($chan) [list shortly [after ...]] # do a NAMES +proc ldebug {facil m} { + global debugusers + # facil is + # m$monname + # d$deviceset + # c$lchan + # {} for system stuff + if {![llength debugusers]} return + if {[regexp {[md]([^:]+)\:} $facil dummy username] && + [lsearch -exact $debugusers $username]==-1} return + + regsub {^(.)} $facil {\1 } cc + reporterr "DEBUG $cc $m" +} + proc list_objs {vp} { set l {} foreach v [info globals] { @@ -111,6 +137,12 @@ proc mon_nick_is {globlist ln} { return 0 } +proc_mon gotchanlist {ch nll} { + if {[lsearch -exact $mm(chans) $ch] == -1} return + set mm(present-$ch) $nll + mon_updateall $m +} + proc_mon speech {chan ln} { if {[lsearch -exact $mm(chans) $chan] == -1} return if {[mon_nick_is $mm(ignore) $ln]} return @@ -121,16 +153,33 @@ proc_mon speech {chan ln} { } proc_mon calcstate {} { - set s " " - if {[llength $mm(present)]} { append s "present " } + set s " default " + foreach ch $mm(chans) { + if {[llength $mm(present-$ch)]} { append s "present "; break } + } set now [clock seconds] + set valid_until [expr {$now + 86400}] + set refresh_later 0 + catch { after cancel $mm(talkchange) } foreach p {{} pref} { foreach t {{} now} { - set since [expr {$now - $mm(time-recent$t)}] - if {[expr {$mm(last-talk$p) < $since}]} continue + set vu [expr {$mm(last-talk$p) + $mm(time-recent$t)}] + if {$vu < $now} continue append s "${p}talk${t} " + set refresh_later 1 + if {$vu < $valid_until} { set valid_until $vu } } } + regsub {^ default } $s { } ss + set ds [string trim $ss] + if {$refresh_later} { + set interval [expr {$valid_until - $now + 2}] + set ivms [expr {$interval*1000}] + set mm(talkchange) [after $ivms [list mon_updateall $m]] + ldebug m$m "until now+${interval}: $ds" + } else { + ldebug m$m "indefinitely: $ds" + } return $s } @@ -144,6 +193,8 @@ proc_mon updateall {} { } proc_mon destroy {} { + ldebug m$m "destroying" + catch { after cancel $mm(talkchange) } catch { unset mm } } @@ -152,7 +203,7 @@ proc proc_dset {name argl body} { upvar #0 deviceset/\$d dd if {\[catch { $body - } emsg\]} { + } emsg\]==1} { reporterr \"error on \$d: \$emsg\" }" } @@ -162,26 +213,45 @@ proc timed_log {m} { } proc_dset setbystate {s} { - set lv {} - foreach {sq v} $s { + foreach {sq v} $dd(states) { if {![string match *$sq* $s]} continue set lv $v; break } + if {![info exists lv]} { + reporterr "no state for $d matching$s" + return + } + ldebug d$d "matches $sq: $v" timed_log "->$d $lv" - puts $dd(fchan) $lv + set dd(values) "$sq=$lv" + puts $dd(ichan) $lv } proc_dset destroy {} { + ldebug d$d "destroying" catch { after cancel $dd(retry) } catch { - if {[info exists dd(fchan)]} { timed_log ">\$$d destroy" } - close $dd(fchan) + if {[info exists dd(ochan)]} { timed_log ">\$$d destroy" } + close $dd(ochan) + close $dd(ichan) } catch { unset dd } } +proc modvar_save_copy {cv defv} { + upvar 1 m m + upvar 1 mm mm + upvar 1 save/$m save + if {[info exists save($cv)]} { + set mm($cv) $save($cv) + } else { + set mm($cv) $defv + } +} + proc reloaduser {username} { check_username $username + ldebug u$username "reloading" if {[catch { set cfg [exec userv --timeout 3 $username irc-ledcontrol-config \ < /dev/null] @@ -196,10 +266,11 @@ proc reloaduser {username} { } foreach m [list_objs monitor] { if {![string match $username* $m]} continue - mon_destroy $m + upvar #0 monitor/$m mm + foreach cv [array names mm] { set save/${m}($cv) $mm($cv) } } if {![string length $cfg]} { - file remove pwdb/$username + file delete pwdb/$username return "no config from $username" } elseif {[catch { exec userv --timeout 3 $username irc-ledcontrol-passwords \ @@ -208,6 +279,7 @@ proc reloaduser {username} { reporterr "error reading passwords for $username: $emsg" return "" } elseif {[catch { + ldebug u$username "parsing" foreach cv {ignore nopresence prefer} { set cc($cv) {} } set cc(time-recentnow) 120 set cc(time-recent) 450 @@ -241,8 +313,13 @@ proc reloaduser {username} { } upvar #0 monitor/$m mm foreach cv [array names cc] { set mm($cv) $cc($cv) } - foreach cv {{} pref} { set mm(last-talk$cv) 0 } - set mm(present) {} + foreach cv {{} pref} { + modvar_save_copy last-talk$cv 0 + } + foreach cv [array names mm(chans)] { + modvar_save_copy present-$cv {} + } + ldebug m$m "created" } elseif {[regexp \ {^leds\s+([0-9A-Za-z][-:/0-9A-Za-z]+)\s+(\S+)\s+(\S+.*)$} \ $l dummy g m states]} { @@ -252,8 +329,8 @@ proc reloaduser {username} { foreach sv [split $states " "] { if {![string length $sv]} continue if {![regexp \ - {^((pref)?talk(now)?|present|default)\=([0-9a-z][,/+0-9A-Za-z]*)$} \ - $sv dummy lhs dummy dummy rhs]} { + {^((?:pref)?talk(?:now)?|present|default)\=([0-9a-z][,/+0-9A-Za-z]*)$} \ + $sv dummy lhs rhs]} { error "invalid state spec" } lappend sl $lhs $rhs @@ -262,8 +339,10 @@ proc reloaduser {username} { set dd(monname) $m set dd(states) $sl set dd(group) $g + set dd(values) startup set dd(username) $username dset_start $d + ldebug d$d "created" } } } emsg]} { @@ -286,40 +365,53 @@ proc check_monname {m} { proc_dset start {} { catch { unset dd(retry) } set username $dd(username) + ldebug d$d "starting" if {[catch { set cmdl [list remoteleds --pipe $dd(group) \ - --passfile-only pwdb/p$username] + --human --passfile-only pwdb/p$username] timed_log "!-$d [join $cmdl " "]" - set fchan [open |[concat $cmdl {|& cat}] r+] - fconfigure $fchan -blocking 0 - fileevent $fchan readable [list dset_rledout $d] - set dd(fchan) $fchan + lappend cmdl < pwdb/fifo |& cat + catch { file delete pwdb/fifo } + exec mkfifo -m 0600 pwdb/fifo + set ichan [open pwdb/fifo r+] + set ochan [open |$cmdl r] + fconfigure $ichan -blocking 0 -buffering line + fconfigure $ochan -blocking 0 -buffering line + fileevent $ochan readable [list dset_rledout $d] + set dd(ichan) $ichan + set dd(ochan) $ochan } emsg]} { reporterr "remoteleds startup $d: $emsg" + catch { close $ichan } + catch { close $ochan } dset_trylater $d } } proc_dset rledout {} { global errchan - while {[gets $dd(fchan) l] != -1} { reporterr "remoteleds on $d: $l" } - if {[fblocked $dd(fchan)]} return - catch { - timed_log ">\$$d failure"; - close $dd(fchan) + while {[gets $dd(ochan) l] != -1} { + reporterr "remoteleds on $d: $dd(values): $l" } - unset dd(fchan) + if {[fblocked $dd(ochan)]} return + timed_log ">\$$d failure"; + catch { close $dd(ichan) } + catch { close $dd(ochan) } + unset dd(ichan) + unset dd(ochan) reporterr "remoteleds on $d died" dset_trylater $d } proc_dset trylater {} { global retry_after + ldebug d$d "will try again later" set dd(retry) [after $retry_after [list dset_start $d]] } proc config_change {} { - global onchans chans_retry errchan + global onchans chans_retry errchan config_retry_after + ldebug {} "rechecking configuration etc" foreach ch [array names onchans] { manyset $onchans($ch) status after if {"$status" == "shortly"} { @@ -341,7 +433,8 @@ proc config_change {} { sendout PART $ch unset onchans($ch) } - after $chans_retry config_change + catch { after cancel $config_retry_after } + set config_retry_after [after $chans_retry config_change] } proc chan_shortly {ch} { @@ -349,13 +442,27 @@ proc chan_shortly {ch} { upvar #0 onchans($ch) oc if {[info exists oc]} { manyset $oc status after - if {"$status" == "shortly"} return + if {"$status" == "shortly"} { + ldebug c$ch "queued check already pending" + return + } } + ldebug c$ch "queueing check" set oc [list shortly [after $chan_after chan_sendnames $ch]] } +proc msg_353 {p c dest type chan nicklist} { + set lchan [irctolower $chan] + set nll [irctolower $nicklist] + ldebug c$lchan "got names $nll" + foreach m [list_objs monitor] { + mon_gotchanlist $m $lchan $nll + } +} + proc chan_sendnames {ch} { upvar #0 onchans($ch) oc + ldebug c$ch "asking for namelist" sendout NAMES $ch set oc idle } @@ -368,6 +475,33 @@ def_ucmd reload { ucmdr {} $m } +proc debug_reset {} { + global debugusers debug_cancelling + unset debug_cancelling + set debugusers {} + reporterr "debug mode timed out" +} + +def_ucmd debug { + prefix_nick + global debugusers debug_cancelling debug_reset_after + if {![string length $text]} { error "must give list of usernames" } + llength $text + set debugusers $text + catch { after cancel $debug_cancelling } + set debug_cancelling [after $debug_reset_after debug_reset] + reporterr "debug enabled by $n: $debugusers" +} + +def_ucmd nodebug { + prefix_nick + global debugusers debug_cancelling + set debugusers {} + catch { after cancel $debug_cancelling } + catch { unset debug_cancelling } + reporterr "debug disabled by $n" +} + def_ucmd who { set r {} foreach m [list_objs monitor] { @@ -379,9 +513,11 @@ def_ucmd who { regexp {^[^:]*\:[^:]*} $dd(group) dest lappend r "sending $dd(monname) to $dest" } + ucmdr [join $r "\n"] {} } proc connected {} { + ldebug {} "connected" foreach f [glob -nocomplain pwdb/p*] { regexp {^pwdb/p(.*)$} $f dummy username set m [reloaduser $username] @@ -389,8 +525,6 @@ proc connected {} { config_change } -# fixme -# 353 # JOIN PART # KICK KILL QUIT -- 2.30.2