1 # maintains local list of users to userv-slurp config from
2 # each user provides list of
10 # nicks ignore presence
12 # time for `a while ago'
13 # time for `very-recently'
15 # nick ignore|nopresence|prefer <glob-pattern> [...]
16 # times <very-recently> <a-while-ago> (default 120 450)
17 # (affect subsequent `monitor' directives)
18 # monitor <monname> <#chan>[,<#chan>...]
19 # <monname> must start with <username>:
21 # a deviceset specifies
26 # leds <led-group> <monname> <state>=<value>
27 # where state is one of
28 # [pref]talk[now] any non-ignored (with `pref', only any preferred)
29 # nick(s) spoke at least somewhat recently
30 # (with `now', only if they spoke very recently)
31 # present at least some non-nopresence nicks present
32 # default always matches
33 # where the first matching state wins; if none, no LEDs are set
43 # monitor/$monname(chans) -> [list $chan1 $chan2 ...]
44 # monitor/$monname(ignore) -> [list $regexp ...]
45 # monitor/$monname(prefer) -> [list $regexp ...]
46 # monitor/$monname(present) -> [list $lnick ...]
47 # monitor/$monname(last-talk) -> $time_t
48 # monitor/$monname(last-talkpref) -> $time_t
49 # monitor/$monname(time-recent) -> $seconds
50 # monitor/$monname(time-recentnow) -> $seconds
52 # deviceset/$username:$lno(monname) -> $monname
53 # deviceset/$username:$lno(group) -> $led_group
54 # deviceset/$username:$lno(states) -> [list $state1 $value1 $state2 ...]
55 # deviceset/$username:$lno(fchan) -> [open remoteleds ... |] or unset
56 # deviceset/$username:$lno(retry) -> [after ... ] or unset
58 # onchans($chan) [list mustleave] # in config_chane
59 # onchans($chan) [list idle]
60 # onchans($chan) [list forced] # for errchan
61 # onchans($chan) [list shortly [after ...]] # do a NAMES
65 foreach v [info globals] {
66 if {![regsub ^$vp/ $v {} v]} continue
72 proc privmsg_unlogged {prefix ischan params} {
75 execute_usercommand $p PRIVMSG $n $n \
76 [lindex $params 0] [lindex $params 1]
80 foreach m [list_objs monitor] {
81 mon_speech $m [irctolower [lindex $params 0]] [irctolower $n]
88 sendprivmsg $errchan $m
91 proc proc_mon {name argl body} {
92 proc mon_$name [concat m $argl] "
93 upvar #0 monitor/\$m mm
97 proc_mon speech {chan ln} {
98 if {[search -exact $mm(chans) $chan] == -1} return
99 if {[mon_nick_is $mm(ignore) $ln]} return
100 set now [clock seconds]
101 set mm(last-talk) $now
102 if {[mon_nick_is $mm(prefer)]} { set mm(last-talkpref) $now }
106 proc_mon calcstate {} {
108 if {[llength $mm(present)]} { append s "present " }
109 set now [clock seconds]
112 set since [expr {$now - $mm(time-recent$t)}]
113 if {[expr {$mm(last-talk$pref) < $since}]} continue
114 append s "${p}talk${t} "
120 proc_mon updateall {} {
121 set s [mon_calcstate $m]
122 for d [list_objs deviceset] {
123 upvar #0 deviceset/$d dd
124 if {[string compare $m $dd(monname)]} continue
129 proc_mon destroy {} {
133 proc proc_dset {name argl body} {
134 proc dset_$name [concat d $argl] "
135 upvar #0 deviceset/\$d dd
139 reporterr \"error on \$d: \$emsg\"
143 proc_dset setbystate {s} {
146 if {![string match *$sq* $s]} continue
152 proc dset_destroy {} {
153 catch { after cancel $dd(retry) }
154 catch { close $dd(fchan) }
158 proc reloaduser {username} {
159 check_username $username
161 set cfg [exec userv --timeout 3 $username irc-ledcontrol-config \
163 set pw [exec userv --timeout 3 $username irc-ledcontrol-passwords \
164 < /dev/null > pwdb/p$username]
166 reporterr "error reloading $username: $emsg"
168 for d [list_objs deviceset] {
169 if {![string match $username:* $d]} continue
172 for m [list_objs monitor] {
173 if {![string match $username* $m]} continue
176 if {![string length $cfg]} {
177 file remove pwdb/$username
179 foreach cv {ignore nopresence prefer} { set cc($cv) {} }
180 set cc(time-recentnow) 120
181 set cc(time-recent) 450
183 foreach l [split $cfg "\n"] {
185 set l [string trim $l]
186 if {[regexp {^\#} $l]} {
187 } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \
188 $l dummy kind globs]} {
190 foreach gl [split $globs " "] {
191 if {![string length $gl]} continue
193 lappend cc($kind) $gl
195 } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy r rnow]} {
196 foreach cv {{} now} { set cc(time-recent$cv) [set r$cv] }
197 } elseif {[regexp {^monitor\s+(\S+)\s+(\S.*)$} $l dummy m cl]} {
199 if {![string match $username:* $m]} {
200 error "monname must start with $username:"
202 foreach ch [split $cl " "] {
203 if {![string length $ch]} continue
205 if {![ischan $ch]} { error "invalid channel $ch" }
206 lappend cc(chans) [irctolower $ch]
208 upvar #0 monitor/$m mm
209 foreach cv [array names cc] { set mm($cv) $cc($cv) }
210 foreach cv {{} pref} { set mm(last-talk$cv) 0 }
212 {^leds\s+([0-9A-Za-z][-:/0-9A-Za-z]+)\s+(\S+)\s+(\S+.*)$} \
213 $l dummy g m states]} {
214 set d $username:$lno:$g
216 foreach sv [split $states " "] {
217 if {![string length $sv]} continue
219 {^((pref)?talk(now)?|present|default)\=([0-9a-z][,/+0-9A-Za-z]*)$} \
220 $sv dummy lhs dummy dummy rhs]} {
221 error "invalid state spec"
225 upvar #0 deviceset/$d dd
233 reporterr "setup error $username:$pline:$emsg"
238 catch { unset dd(retry) }
240 set fchan [open [list | \
241 remoteleds 2>&1 --pipe $g \
242 --passfile-only pwdb/p$username \
245 fconfigure $fchan -blocking 0
246 fileevent $fchan readable [list dset_rledout $d]
249 reporterr "remoteleds startup $d: $emsg"
254 proc_dset rledout {} {
255 global errchan retry_after
256 while {[gets $dd(fchan) l] != -1} { reporterr "remoteleds on $d: $l" }
257 if {[fblocked $dd(fchan)]} return
258 catch { close $dd(fchan) }
260 reporterr "remoteleds on $d died"
264 proc_dset trylater {} {
265 set dd(retry) [after $retry_after [list proc_dset start $d]]
268 proc config_change {} {
269 global onchans chans_retry errchan
270 foreach ch [array names onchans] {
271 manyset $onchans($ch) status after
272 if {"$status" == "shortly"} {
273 catch { after cancel $after }
275 set onchans($ch) mustleave
277 set ch($errchan) forced
278 sendout JOIN $errchan
279 foreach m [list_objs monitor] {
280 upvar #0 monitor/$m mm
281 foreach ch $mm(chans) {
286 foreach ch [array names onchans] {
287 if {"[lindex $onchans($ch) 0]" != "mustleave"} continue
291 after $chans_retry config_change
294 proc chan_shortly {ch} {
296 upvar #0 onchans($ch) oc
297 manyset $oc status after
298 if {"$status" != "idle"} return
299 set oc [list shortly [after $chan_after chan_sendnames $ch]]
302 proc chan_sendnames {ch} {
303 upvar #0 onchans($ch) oc
309 set username [ta_word]
316 foreach f [glob -nocomplain pwdb/p*] {
317 regexp {^pwdb/p(.*)$} $f dummy username
318 check_username $username