X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=blobdiff_plain;f=ledmodule.tcl;h=b4a20fd858b890e3eddc1073c7733fe8cc517ec6;hb=HEAD;hp=eb1deedfd690c5f6531d31907d130e76ff9866a7;hpb=9f0cdd4e69f6a2693a408574dd000dc614bb2edb;p=ircbot.git diff --git a/ledmodule.tcl b/ledmodule.tcl index eb1deed..b4a20fd 100644 --- a/ledmodule.tcl +++ b/ledmodule.tcl @@ -1,36 +1,5 @@ -# maintains local list of users to userv-slurp config from -# each user provides list of -# monitors -# devicesets -# -# a monitor specifies -# name -# IRC channel(s) -# nicks ignore totally -# nicks ignore presence -# nicks prefer speech -# time for `a while ago' -# time for `very-recently' -# syntax -# nick ignore|nopresence|prefer [...] -# times (default 120 450) -# (affect subsequent `monitor' directives) -# monitor <#chan>[,<#chan>...] -# must start with : -# -# a deviceset specifies -# monitor -# led-group -# led states -# syntax -# leds = -# where state is one of -# [pref]talk[now] any non-ignored (with `pref', only any preferred) -# nick(s) spoke at least somewhat recently -# (with `now', only if they spoke very recently) -# present at least some non-nopresence nicks present -# default always matches -# where the first matching state wins; if none, no LEDs are set +# see ledbot.html +# $Id$ set helpfile ledhelp @@ -81,7 +50,7 @@ proc ldebug {facil m} { # c$lchan # {} for system stuff if {![llength $debugusers]} return - if {[regexp {[md]([^:]+)\:} $facil dummy username] && + if {[regexp {[mdu]([^:]+)\:} $facil dummy username] && [lsearch -exact $debugusers $username]==-1} return regsub {^(.)} $facil {\1 } cc @@ -144,8 +113,10 @@ proc_mon gotchanlist {ch nll} { foreach nl $nll { if {![string compare $nl [irctolower $nick]]} continue if {[mon_nick_is $mm(nopresence) $nl]} continue - lappend $l $nl + if {[mon_nick_is $mm(ignore) $nl]} continue + lappend l $nl } + ldebug m$m "$ch names: $l" set mm(present-$ch) $l mon_updateall $m } @@ -208,10 +179,16 @@ proc_mon destroy {} { proc proc_dset {name argl body} { proc dset_$name [concat d $argl] " upvar #0 deviceset/\$d dd - if {\[catch { + set returncode \[catch { $body - } emsg\]==1} { + } emsg\] + global errorInfo errorCode + if {\$returncode==1} { reporterr \"error on \$d: \$emsg\" + } elseif {\$returncode==2} { + return \$emsg + } else { + return -code \$returncode -errorinfo \$errorInfo -errorcode \$errorCode }" } @@ -224,6 +201,7 @@ proc_dset setbystate {s} { if {![string match *$sq* $s]} continue set lv $v; break } + if {![info exists dd(ichan)]} return if {![info exists lv]} { reporterr "no state for $d matching$s" return @@ -291,19 +269,24 @@ proc reloaduser {username} { set cc(time-recentnow) 120 set cc(time-recent) 450 set lno 0 + set contin {} foreach l [split $cfg "\n"] { incr lno - set l [string trim $l] + append contin [string trim $l] + if {[regsub {\\$} $contin { } contin]} continue + set l $contin + set contin {} if {[regexp {^\#} $l]} { - } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \ - $l dummy kind globs]} { + } elseif {![regexp {\S} $l]} { + } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(.*)$} \ + "$l " dummy kind globs]} { set cc($kind) {} foreach gl [split $globs " "] { if {![string length $gl]} continue string match $gl {} lappend cc($kind) $gl } - } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy r rnow]} { + } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy rnow r]} { foreach cv {{} now} { set cc(time-recent$cv) [set r$cv] } } elseif {[regexp {^monitor\s+(\S+)\s+(\S.*)$} $l dummy m cl]} { set cc(chans) {} @@ -328,7 +311,7 @@ proc reloaduser {username} { } ldebug m$m "created" } elseif {[regexp \ - {^leds\s+([0-9A-Za-z][-:/0-9A-Za-z]+)\s+(\S+)\s+(\S+.*)$} \ + {^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 {} @@ -350,8 +333,13 @@ proc reloaduser {username} { set dd(username) $username dset_start $d ldebug d$d "created" + } else { + error "invalid directive or syntax" } } + if {[string length $contin]} { + error "continuation line at end of file" + } } emsg]} { reporterr "setup error $username:$lno:$emsg" return "" @@ -384,9 +372,9 @@ proc_dset start {} { 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 + fileevent $ochan readable [list dset_rledout $d] } emsg]} { reporterr "remoteleds startup $d: $emsg" catch { close $ichan } @@ -398,7 +386,7 @@ proc_dset start {} { proc_dset rledout {} { global errchan while {[gets $dd(ochan) l] != -1} { - reporterr "remoteleds on $d: $dd(values): $l" + reporterr "on $d: $dd(values): $l" } if {[fblocked $dd(ochan)]} return timed_log ">\$$d failure"; @@ -406,7 +394,7 @@ proc_dset rledout {} { catch { close $dd(ochan) } unset dd(ichan) unset dd(ochan) - reporterr "remoteleds on $d died" + reporterr "on $d died" dset_trylater $d } @@ -445,33 +433,13 @@ proc config_change {} { } proc allchans_shortly {} { - global chan_after onchans shortly_alling - if {[info exists shortly_alling]} { - ldebug {} "global check already pending" - return - } - foreach ch [array names onchans] { - manyset $onchans($ch) status after - if {"$status" != "shortly"} continue - set idle - } - set shortly_alling [after $chan_after allchans_sendnames] -} - -proc allchans_sendnames {} { - global shortly_alling - unset shortly_alling - ldebug {} "asking for global namelist" - sendout NAMES + global onchans + foreach ch [array names onchans] { chan_shortly $ch } } proc chan_shortly {ch} { - global chan_after shortly_alling + global chan_after set ch [irctolower $ch] - if {[info exists shortly_alling]} { - ldebug c$ch "global check already pending" - return - } upvar #0 onchans($ch) oc if {[info exists oc]} { manyset $oc status after @@ -488,7 +456,7 @@ proc msg_353 {p c dest type chan nicklist} { set lchan [irctolower $chan] set nll [irctolower $nicklist] regsub -all {[=@*]} $nll {} nll - ldebug c$lchan "got names $nll" + ldebug c$lchan "all names: $nll" foreach m [list_objs monitor] { mon_gotchanlist $m $lchan $nll } @@ -529,6 +497,7 @@ def_ucmd debug { def_ucmd nodebug { prefix_nick + ta_nomore global debugusers debug_cancelling set debugusers {} catch { after cancel $debug_cancelling } @@ -536,6 +505,13 @@ def_ucmd nodebug { reporterr "debug disabled by $n" } +proc_dset visibledest {} { + regsub {\:[^:]*/} $d/ { } p + regsub {^([^:]+)\:\d+\:} $p {\1, } p + regsub { $} $p {} p + return $p +} + def_ucmd who { set r {} foreach m [list_objs monitor] { @@ -544,8 +520,10 @@ def_ucmd who { } foreach d [list_objs deviceset] { upvar #0 deviceset/$d dd - regexp {^[^:]*\:[^:]*} $dd(group) dest - lappend r "sending $dd(monname) to $dest" + set m $dd(monname) + upvar #0 monitor/$m mm + if {![info exists mm(chans)]} continue + lappend r "sending $m to [dset_visibledest $d]" } ucmdr [join $r "\n"] {} } @@ -559,10 +537,34 @@ proc connected {} { config_change } -proc msg_JOIN {p c chan} { chan_shortly $chan } +proc warn_pref {n} { + set nl [irctolower $n] + set l {} + foreach d [list_objs deviceset] { + upvar #0 deviceset/$d dd + set m $dd(monname) + upvar #0 monitor/$m mm + if {![info exists mm(prefer)]} continue + if {![mon_nick_is $mm(prefer) $nl]} continue + foreach ch $mm(chans) { set wch($ch) 1 } + lappend l [dset_visibledest $d] + } + if {[llength $l]} { + sendprivmsg $nl "LEDs are watching you on [\ + join [lsort [array names wch]] ","]: [join $l " "]" + } +} + +proc msg_JOIN {p c chan} { + prefix_nick + set nl [irctolower $n] + chan_shortly $chan + warn_pref $n +} proc msg_PART {p c chan} { chan_shortly $chan } proc msg_KILL {p c user why} { allchans_shortly } proc msg_QUIT {p c why} { allchans_shortly } +proc msg_NICK {p c newnick} { allchans_shortly; warn_pref $newnick } proc msg_KICK {p c chans users comment} { if {[llength $chans] > 1} { allchans_shortly