From 451f5afffa69156dcc7c412118a8fd3aa94717bc Mon Sep 17 00:00:00 2001 From: ijackson Date: Sun, 9 Jun 2002 19:50:17 +0000 Subject: [PATCH] bugfixes. before ledbot fchan reorg --- .cvsignore | 1 + bot.tcl | 9 +-- irccore.tcl | 7 ++ ledconfig.tcl | 6 +- ledhelp | 10 +++ ledmodule.tcl | 173 ++++++++++++++++++++++++++++++++++++-------------- userv.tcl | 8 +++ 7 files changed, 154 insertions(+), 60 deletions(-) create mode 100644 ledhelp create mode 100644 userv.tcl diff --git a/.cvsignore b/.cvsignore index 1aaf75e..e50d556 100644 --- a/.cvsignore +++ b/.cvsignore @@ -1,5 +1,6 @@ summon users chans +pwdb botpass.tcl telling.ps diff --git a/bot.tcl b/bot.tcl index 9b73cc9..b706312 100755 --- a/bot.tcl +++ b/bot.tcl @@ -5,6 +5,7 @@ set helpfile helpinfos source irccore.tcl source parsecmd.tcl source stdhelp.tcl +source userv.tcl defset marktime_min 300 defset marktime_join_startdelay 5000 @@ -794,14 +795,6 @@ proc msg_366 {p c args} { unset names_chans } -proc check_username {target} { - if { - [string length $target] > 8 || - [regexp {[^-0-9a-z]} $target] || - ![regexp {^[a-z]} $target] - } { error "invalid username" } -} - proc somedb__head {} { uplevel 1 { set idl [irctolower $id] diff --git a/irccore.tcl b/irccore.tcl index c3ee544..34836e2 100644 --- a/irccore.tcl +++ b/irccore.tcl @@ -247,6 +247,13 @@ proc check_nick {n} { if {[string length $n] > 18} { error "nick too long" } } +proc check_chan {n} { + if {![regsub {^\#} $n {} n]} { error "bad chan start" } + if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in chan" } + if {[regexp {^[-0-9]} $n]} { error "bad chan name start" } + if {[string length $n] > 18} { error "chan name too long" } +} + proc ischan {dest} { return [regexp {^[&#+!]} $dest] } diff --git a/ledconfig.tcl b/ledconfig.tcl index ae3a72d..3d0a6b4 100644 --- a/ledconfig.tcl +++ b/ledconfig.tcl @@ -1,11 +1,11 @@ # Configuration for ledbot -set host chiark.greenend.org.uk -set nick ledcontrol +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 #ledcontrol +set errchan #$nick set retry_after 300000 set chan_after 3000 set chans_retry 3600000 diff --git a/ledhelp b/ledhelp new file mode 100644 index 0000000..b5ba083 --- /dev/null +++ b/ledhelp @@ -0,0 +1,10 @@ +: +Commands: + reload reload configuration from + help display this help +See + http://... for full information + +# Local variables: +# fill-column: 69 +# End: diff --git a/ledmodule.tcl b/ledmodule.tcl index 90bc013..3986863 100644 --- a/ledmodule.tcl +++ b/ledmodule.tcl @@ -37,6 +37,7 @@ set helpfile ledhelp source irccore.tcl source parsecmd.tcl source stdhelp.tcl +source userv.tcl # variables # @@ -49,11 +50,12 @@ source stdhelp.tcl # monitor/$monname(time-recent) -> $seconds # monitor/$monname(time-recentnow) -> $seconds # -# deviceset/$username:$lno(monname) -> $monname -# deviceset/$username:$lno(group) -> $led_group -# deviceset/$username:$lno(states) -> [list $state1 $value1 $state2 ...] -# deviceset/$username:$lno(fchan) -> [open remoteleds ... |] or unset -# deviceset/$username:$lno(retry) -> [after ... ] or unset +# deviceset/$username:$lno(monname) -> $monname +# deviceset/$username:$lno(group) -> $led_group +# deviceset/$username:$lno(username) -> $username +# deviceset/$username:$lno(states) -> [list $state1 $value1 $state2 ...] +# deviceset/$username:$lno(fchan) -> [open remoteleds ... |] or unset +# deviceset/$username:$lno(retry) -> [after ... ] or unset # # onchans($chan) [list mustleave] # in config_chane # onchans($chan) [list idle] @@ -69,16 +71,18 @@ proc list_objs {vp} { return $l } -proc privmsg_unlogged {prefix ischan params} { - if {!$ischan} { - prefix_nick - execute_usercommand $p PRIVMSG $n $n \ - [lindex $params 0] [lindex $params 1] - return 0 - } +proc privmsg_unlogged {p ischan params} { + global errorInfo + if {!$ischan} { return 0 } - foreach m [list_objs monitor] { - mon_speech $m [irctolower [lindex $params 0]] [irctolower $n] + # on-channel message + if {[catch { + prefix_nick + foreach m [list_objs monitor] { + mon_speech $m [irctolower [lindex $params 0]] [irctolower $n] + } + } emsg]} { + log "processing error: $emsg\n$errorInfo" } return 1; } @@ -88,18 +92,31 @@ proc reporterr {m} { sendprivmsg $errchan $m } +proc msg_PRIVMSG {p c dest text} { + global errchan + prefix_nick + execute_usercommand $p $c $n $errchan $dest $text +} + proc proc_mon {name argl body} { proc mon_$name [concat m $argl] " upvar #0 monitor/\$m mm $body" } +proc mon_nick_is {globlist ln} { + foreach gl $globlist { + if {[string match $gl $ln]} { return 1 } + } + return 0 +} + proc_mon speech {chan ln} { - if {[search -exact $mm(chans) $chan] == -1} return + if {[lsearch -exact $mm(chans) $chan] == -1} return if {[mon_nick_is $mm(ignore) $ln]} return set now [clock seconds] set mm(last-talk) $now - if {[mon_nick_is $mm(prefer)]} { set mm(last-talkpref) $now } + if {[mon_nick_is $mm(prefer) $ln]} { set mm(last-talkpref) $now } mon_updateall $m } @@ -107,10 +124,10 @@ proc_mon calcstate {} { set s " " if {[llength $mm(present)]} { append s "present " } set now [clock seconds] - for p {{} pref} { + foreach p {{} pref} { foreach t {{} now} { set since [expr {$now - $mm(time-recent$t)}] - if {[expr {$mm(last-talk$pref) < $since}]} continue + if {[expr {$mm(last-talk$p) < $since}]} continue append s "${p}talk${t} " } } @@ -119,10 +136,10 @@ proc_mon calcstate {} { proc_mon updateall {} { set s [mon_calcstate $m] - for d [list_objs deviceset] { + foreach d [list_objs deviceset] { upvar #0 deviceset/$d dd if {[string compare $m $dd(monname)]} continue - dset_setbystate $s + dset_setbystate $d $s } } @@ -133,25 +150,33 @@ proc_mon destroy {} { proc proc_dset {name argl body} { proc dset_$name [concat d $argl] " upvar #0 deviceset/\$d dd - if {[catch { + if {\[catch { $body - } emsg]} { + } emsg\]} { reporterr \"error on \$d: \$emsg\" }" } +proc timed_log {m} { + log "[clock seconds] $m" +} + proc_dset setbystate {s} { set lv {} - foreach {sq v} { + foreach {sq v} $s { if {![string match *$sq* $s]} continue set lv $v; break } + timed_log "->$d $lv" puts $dd(fchan) $lv } -proc dset_destroy {} { +proc_dset destroy {} { catch { after cancel $dd(retry) } - catch { close $dd(fchan) } + catch { + if {[info exists dd(fchan)]} { timed_log ">\$$d destroy" } + close $dd(fchan) + } catch { unset dd } } @@ -160,28 +185,35 @@ proc reloaduser {username} { if {[catch { set cfg [exec userv --timeout 3 $username irc-ledcontrol-config \ < /dev/null] - set pw [exec userv --timeout 3 $username irc-ledcontrol-passwords \ - < /dev/null > pwdb/p$username] } emsg]} { + regsub "\n" $emsg " // " emsg reporterr "error reloading $username: $emsg" + return "" } - for d [list_objs deviceset] { + foreach d [list_objs deviceset] { if {![string match $username:* $d]} continue dset_destroy $d } - for m [list_objs monitor] { + foreach m [list_objs monitor] { if {![string match $username* $m]} continue mon_destroy $m } if {![string length $cfg]} { file remove pwdb/$username + return "no config from $username" + } elseif {[catch { + exec userv --timeout 3 $username irc-ledcontrol-passwords \ + < /dev/null > pwdb/p$username + } emsg]} { + reporterr "error reading passwords for $username: $emsg" + return "" } elseif {[catch { foreach cv {ignore nopresence prefer} { set cc($cv) {} } set cc(time-recentnow) 120 set cc(time-recent) 450 - set pline 0 + set lno 0 foreach l [split $cfg "\n"] { - incr pline + incr lno set l [string trim $l] if {[regexp {^\#} $l]} { } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \ @@ -199,20 +231,24 @@ proc reloaduser {username} { if {![string match $username:* $m]} { error "monname must start with $username:" } + check_monname $m foreach ch [split $cl " "] { if {![string length $ch]} continue - check_nick $ch + check_chan $ch if {![ischan $ch]} { error "invalid channel $ch" } lappend cc(chans) [irctolower $ch] + chan_shortly $ch } 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) {} } elseif {[regexp \ {^leds\s+([0-9A-Za-z][-:/0-9A-Za-z]+)\s+(\S+)\s+(\S+.*)$} \ $l dummy g m states]} { set d $username:$lno:$g set sl {} + check_monname $m foreach sv [split $states " "] { if {![string length $sv]} continue if {![regexp \ @@ -226,22 +262,35 @@ proc reloaduser {username} { set dd(monname) $m set dd(states) $sl set dd(group) $g + set dd(username) $username dset_start $d } } } emsg]} { - reporterr "setup error $username:$pline:$emsg" + reporterr "setup error $username:$lno:$emsg" + return "" + } else { + return "reloaded $username" + } +} + +proc check_monname {m} { + if {[regexp {[^-_+:.#0-9a-zA-Z]} $m badchar]} { + error "char $badchar not allowed in monnames" + } + if {![regexp {^[0-9a-zA-Z]} $m]} { + error "monname must start with alphanum" } } proc_dset start {} { catch { unset dd(retry) } + set username $dd(username) if {[catch { - set fchan [open [list | \ - remoteleds 2>&1 --pipe $g \ - --passfile-only pwdb/p$username \ - |& cat \ - ]] + set cmdl [list remoteleds --pipe $dd(group) \ + --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 @@ -252,17 +301,21 @@ proc_dset start {} { } proc_dset rledout {} { - global errchan retry_after + global errchan while {[gets $dd(fchan) l] != -1} { reporterr "remoteleds on $d: $l" } if {[fblocked $dd(fchan)]} return - catch { close $dd(fchan) } + catch { + timed_log ">\$$d failure"; + close $dd(fchan) + } unset dd(fchan) reporterr "remoteleds on $d died" dset_trylater $d } proc_dset trylater {} { - set dd(retry) [after $retry_after [list proc_dset start $d]] + global retry_after + set dd(retry) [after $retry_after [list dset_start $d]] } proc config_change {} { @@ -274,8 +327,8 @@ proc config_change {} { } set onchans($ch) mustleave } - set ch($errchan) forced sendout JOIN $errchan + chan_shortly $errchan foreach m [list_objs monitor] { upvar #0 monitor/$m mm foreach ch $mm(chans) { @@ -294,8 +347,10 @@ proc config_change {} { proc chan_shortly {ch} { global chan_after upvar #0 onchans($ch) oc - manyset $oc status after - if {"$status" != "idle"} return + if {[info exists oc]} { + manyset $oc status after + if {"$status" == "shortly"} return + } set oc [list shortly [after $chan_after chan_sendnames $ch]] } @@ -305,18 +360,31 @@ proc chan_sendnames {ch} { set oc idle } -def_ucmd reload {} { +def_ucmd reload { set username [ta_word] ta_nomore - reloaduser $username + set m [reloaduser $username] config_change + ucmdr {} $m } -proc connected { +def_ucmd who { + set r {} + foreach m [list_objs monitor] { + upvar #0 monitor/$m mm + lappend r "monitoring $mm(chans) for $m" + } + foreach d [list_objs deviceset] { + upvar #0 deviceset/$d dd + regexp {^[^:]*\:[^:]*} $dd(group) dest + lappend r "sending $dd(monname) to $dest" + } +} + +proc connected {} { foreach f [glob -nocomplain pwdb/p*] { regexp {^pwdb/p(.*)$} $f dummy username - check_username $username - reloaduser $username + set m [reloaduser $username] } config_change } @@ -325,3 +393,10 @@ proc connected { # 353 # JOIN PART # KICK KILL QUIT + +if {[catch { + loadhelp + ensure_connecting +} emsg]} { + fail "startup: $emsg" +} diff --git a/userv.tcl b/userv.tcl new file mode 100644 index 0000000..bbb0204 --- /dev/null +++ b/userv.tcl @@ -0,0 +1,8 @@ + +proc check_username {target} { + if { + [string length $target] > 8 || + [regexp {[^-0-9a-z]} $target] || + ![regexp {^[a-z]} $target] + } { error "invalid username" } +} -- 2.30.2