Commit | Line | Data |
---|---|---|
6b33d29a IJ |
1 | # maintains local list of users to userv-slurp config from |
2 | # each user provides list of | |
3 | # monitors | |
4 | # devicesets | |
5 | # | |
6 | # a monitor specifies | |
7 | # name | |
8 | # IRC channel(s) | |
9 | # nicks ignore totally | |
10 | # nicks ignore presence | |
11 | # nicks prefer speech | |
12 | # time for `a while ago' | |
13 | # time for `very-recently' | |
14 | # syntax | |
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>: | |
20 | # | |
21 | # a deviceset specifies | |
22 | # monitor | |
23 | # led-group | |
24 | # led states | |
25 | # syntax | |
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 | |
34 | ||
35 | set helpfile ledhelp | |
36 | ||
37 | source irccore.tcl | |
38 | source parsecmd.tcl | |
39 | source stdhelp.tcl | |
b52676c0 | 40 | source userv.tcl |
6b33d29a IJ |
41 | |
42 | # variables | |
43 | # | |
44 | # monitor/$monname(chans) -> [list $chan1 $chan2 ...] | |
45 | # monitor/$monname(ignore) -> [list $regexp ...] | |
46 | # monitor/$monname(prefer) -> [list $regexp ...] | |
47 | # monitor/$monname(present) -> [list $lnick ...] | |
48 | # monitor/$monname(last-talk) -> $time_t | |
49 | # monitor/$monname(last-talkpref) -> $time_t | |
50 | # monitor/$monname(time-recent) -> $seconds | |
51 | # monitor/$monname(time-recentnow) -> $seconds | |
52 | # | |
b52676c0 IJ |
53 | # deviceset/$username:$lno(monname) -> $monname |
54 | # deviceset/$username:$lno(group) -> $led_group | |
55 | # deviceset/$username:$lno(username) -> $username | |
56 | # deviceset/$username:$lno(states) -> [list $state1 $value1 $state2 ...] | |
57 | # deviceset/$username:$lno(fchan) -> [open remoteleds ... |] or unset | |
58 | # deviceset/$username:$lno(retry) -> [after ... ] or unset | |
6b33d29a IJ |
59 | # |
60 | # onchans($chan) [list mustleave] # in config_chane | |
61 | # onchans($chan) [list idle] | |
62 | # onchans($chan) [list forced] # for errchan | |
63 | # onchans($chan) [list shortly [after ...]] # do a NAMES | |
64 | ||
65 | proc list_objs {vp} { | |
66 | set l {} | |
67 | foreach v [info globals] { | |
68 | if {![regsub ^$vp/ $v {} v]} continue | |
69 | lappend l $v | |
70 | } | |
71 | return $l | |
72 | } | |
73 | ||
b52676c0 IJ |
74 | proc privmsg_unlogged {p ischan params} { |
75 | global errorInfo | |
76 | if {!$ischan} { return 0 } | |
6b33d29a | 77 | |
b52676c0 IJ |
78 | # on-channel message |
79 | if {[catch { | |
80 | prefix_nick | |
81 | foreach m [list_objs monitor] { | |
82 | mon_speech $m [irctolower [lindex $params 0]] [irctolower $n] | |
83 | } | |
84 | } emsg]} { | |
85 | log "processing error: $emsg\n$errorInfo" | |
6b33d29a IJ |
86 | } |
87 | return 1; | |
88 | } | |
89 | ||
90 | proc reporterr {m} { | |
91 | global errchan | |
92 | sendprivmsg $errchan $m | |
93 | } | |
94 | ||
b52676c0 IJ |
95 | proc msg_PRIVMSG {p c dest text} { |
96 | global errchan | |
97 | prefix_nick | |
98 | execute_usercommand $p $c $n $errchan $dest $text | |
99 | } | |
100 | ||
6b33d29a IJ |
101 | proc proc_mon {name argl body} { |
102 | proc mon_$name [concat m $argl] " | |
103 | upvar #0 monitor/\$m mm | |
104 | $body" | |
105 | } | |
106 | ||
b52676c0 IJ |
107 | proc mon_nick_is {globlist ln} { |
108 | foreach gl $globlist { | |
109 | if {[string match $gl $ln]} { return 1 } | |
110 | } | |
111 | return 0 | |
112 | } | |
113 | ||
6b33d29a | 114 | proc_mon speech {chan ln} { |
b52676c0 | 115 | if {[lsearch -exact $mm(chans) $chan] == -1} return |
6b33d29a IJ |
116 | if {[mon_nick_is $mm(ignore) $ln]} return |
117 | set now [clock seconds] | |
118 | set mm(last-talk) $now | |
b52676c0 | 119 | if {[mon_nick_is $mm(prefer) $ln]} { set mm(last-talkpref) $now } |
6b33d29a IJ |
120 | mon_updateall $m |
121 | } | |
122 | ||
123 | proc_mon calcstate {} { | |
124 | set s " " | |
125 | if {[llength $mm(present)]} { append s "present " } | |
126 | set now [clock seconds] | |
b52676c0 | 127 | foreach p {{} pref} { |
6b33d29a IJ |
128 | foreach t {{} now} { |
129 | set since [expr {$now - $mm(time-recent$t)}] | |
b52676c0 | 130 | if {[expr {$mm(last-talk$p) < $since}]} continue |
6b33d29a IJ |
131 | append s "${p}talk${t} " |
132 | } | |
133 | } | |
134 | return $s | |
135 | } | |
136 | ||
137 | proc_mon updateall {} { | |
138 | set s [mon_calcstate $m] | |
b52676c0 | 139 | foreach d [list_objs deviceset] { |
6b33d29a IJ |
140 | upvar #0 deviceset/$d dd |
141 | if {[string compare $m $dd(monname)]} continue | |
b52676c0 | 142 | dset_setbystate $d $s |
6b33d29a IJ |
143 | } |
144 | } | |
145 | ||
146 | proc_mon destroy {} { | |
147 | catch { unset mm } | |
148 | } | |
149 | ||
150 | proc proc_dset {name argl body} { | |
151 | proc dset_$name [concat d $argl] " | |
152 | upvar #0 deviceset/\$d dd | |
b52676c0 | 153 | if {\[catch { |
6b33d29a | 154 | $body |
b52676c0 | 155 | } emsg\]} { |
6b33d29a IJ |
156 | reporterr \"error on \$d: \$emsg\" |
157 | }" | |
158 | } | |
159 | ||
b52676c0 IJ |
160 | proc timed_log {m} { |
161 | log "[clock seconds] $m" | |
162 | } | |
163 | ||
6b33d29a IJ |
164 | proc_dset setbystate {s} { |
165 | set lv {} | |
b52676c0 | 166 | foreach {sq v} $s { |
6b33d29a IJ |
167 | if {![string match *$sq* $s]} continue |
168 | set lv $v; break | |
169 | } | |
b52676c0 | 170 | timed_log "->$d $lv" |
6b33d29a IJ |
171 | puts $dd(fchan) $lv |
172 | } | |
173 | ||
b52676c0 | 174 | proc_dset destroy {} { |
6b33d29a | 175 | catch { after cancel $dd(retry) } |
b52676c0 IJ |
176 | catch { |
177 | if {[info exists dd(fchan)]} { timed_log ">\$$d destroy" } | |
178 | close $dd(fchan) | |
179 | } | |
6b33d29a IJ |
180 | catch { unset dd } |
181 | } | |
182 | ||
183 | proc reloaduser {username} { | |
184 | check_username $username | |
185 | if {[catch { | |
186 | set cfg [exec userv --timeout 3 $username irc-ledcontrol-config \ | |
187 | < /dev/null] | |
6b33d29a | 188 | } emsg]} { |
b52676c0 | 189 | regsub "\n" $emsg " // " emsg |
6b33d29a | 190 | reporterr "error reloading $username: $emsg" |
b52676c0 | 191 | return "" |
6b33d29a | 192 | } |
b52676c0 | 193 | foreach d [list_objs deviceset] { |
6b33d29a IJ |
194 | if {![string match $username:* $d]} continue |
195 | dset_destroy $d | |
196 | } | |
b52676c0 | 197 | foreach m [list_objs monitor] { |
6b33d29a IJ |
198 | if {![string match $username* $m]} continue |
199 | mon_destroy $m | |
200 | } | |
201 | if {![string length $cfg]} { | |
202 | file remove pwdb/$username | |
b52676c0 IJ |
203 | return "no config from $username" |
204 | } elseif {[catch { | |
205 | exec userv --timeout 3 $username irc-ledcontrol-passwords \ | |
206 | < /dev/null > pwdb/p$username | |
207 | } emsg]} { | |
208 | reporterr "error reading passwords for $username: $emsg" | |
209 | return "" | |
6b33d29a IJ |
210 | } elseif {[catch { |
211 | foreach cv {ignore nopresence prefer} { set cc($cv) {} } | |
212 | set cc(time-recentnow) 120 | |
213 | set cc(time-recent) 450 | |
b52676c0 | 214 | set lno 0 |
6b33d29a | 215 | foreach l [split $cfg "\n"] { |
b52676c0 | 216 | incr lno |
6b33d29a IJ |
217 | set l [string trim $l] |
218 | if {[regexp {^\#} $l]} { | |
219 | } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \ | |
220 | $l dummy kind globs]} { | |
221 | set cc($kind) {} | |
222 | foreach gl [split $globs " "] { | |
223 | if {![string length $gl]} continue | |
224 | string match $gl {} | |
225 | lappend cc($kind) $gl | |
226 | } | |
227 | } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy r rnow]} { | |
228 | foreach cv {{} now} { set cc(time-recent$cv) [set r$cv] } | |
229 | } elseif {[regexp {^monitor\s+(\S+)\s+(\S.*)$} $l dummy m cl]} { | |
230 | set cc(chans) {} | |
231 | if {![string match $username:* $m]} { | |
232 | error "monname must start with $username:" | |
233 | } | |
b52676c0 | 234 | check_monname $m |
6b33d29a IJ |
235 | foreach ch [split $cl " "] { |
236 | if {![string length $ch]} continue | |
b52676c0 | 237 | check_chan $ch |
6b33d29a IJ |
238 | if {![ischan $ch]} { error "invalid channel $ch" } |
239 | lappend cc(chans) [irctolower $ch] | |
b52676c0 | 240 | chan_shortly $ch |
6b33d29a IJ |
241 | } |
242 | upvar #0 monitor/$m mm | |
243 | foreach cv [array names cc] { set mm($cv) $cc($cv) } | |
244 | foreach cv {{} pref} { set mm(last-talk$cv) 0 } | |
b52676c0 | 245 | set mm(present) {} |
6b33d29a IJ |
246 | } elseif {[regexp \ |
247 | {^leds\s+([0-9A-Za-z][-:/0-9A-Za-z]+)\s+(\S+)\s+(\S+.*)$} \ | |
248 | $l dummy g m states]} { | |
249 | set d $username:$lno:$g | |
250 | set sl {} | |
b52676c0 | 251 | check_monname $m |
6b33d29a IJ |
252 | foreach sv [split $states " "] { |
253 | if {![string length $sv]} continue | |
254 | if {![regexp \ | |
255 | {^((pref)?talk(now)?|present|default)\=([0-9a-z][,/+0-9A-Za-z]*)$} \ | |
256 | $sv dummy lhs dummy dummy rhs]} { | |
257 | error "invalid state spec" | |
258 | } | |
259 | lappend sl $lhs $rhs | |
260 | } | |
261 | upvar #0 deviceset/$d dd | |
262 | set dd(monname) $m | |
263 | set dd(states) $sl | |
264 | set dd(group) $g | |
b52676c0 | 265 | set dd(username) $username |
6b33d29a IJ |
266 | dset_start $d |
267 | } | |
268 | } | |
269 | } emsg]} { | |
b52676c0 IJ |
270 | reporterr "setup error $username:$lno:$emsg" |
271 | return "" | |
272 | } else { | |
273 | return "reloaded $username" | |
274 | } | |
275 | } | |
276 | ||
277 | proc check_monname {m} { | |
278 | if {[regexp {[^-_+:.#0-9a-zA-Z]} $m badchar]} { | |
279 | error "char $badchar not allowed in monnames" | |
280 | } | |
281 | if {![regexp {^[0-9a-zA-Z]} $m]} { | |
282 | error "monname must start with alphanum" | |
6b33d29a IJ |
283 | } |
284 | } | |
285 | ||
286 | proc_dset start {} { | |
287 | catch { unset dd(retry) } | |
b52676c0 | 288 | set username $dd(username) |
6b33d29a | 289 | if {[catch { |
b52676c0 IJ |
290 | set cmdl [list remoteleds --pipe $dd(group) \ |
291 | --passfile-only pwdb/p$username] | |
292 | timed_log "!-$d [join $cmdl " "]" | |
293 | set fchan [open |[concat $cmdl {|& cat}] r+] | |
6b33d29a IJ |
294 | fconfigure $fchan -blocking 0 |
295 | fileevent $fchan readable [list dset_rledout $d] | |
296 | set dd(fchan) $fchan | |
297 | } emsg]} { | |
298 | reporterr "remoteleds startup $d: $emsg" | |
299 | dset_trylater $d | |
300 | } | |
301 | } | |
302 | ||
303 | proc_dset rledout {} { | |
b52676c0 | 304 | global errchan |
6b33d29a IJ |
305 | while {[gets $dd(fchan) l] != -1} { reporterr "remoteleds on $d: $l" } |
306 | if {[fblocked $dd(fchan)]} return | |
b52676c0 IJ |
307 | catch { |
308 | timed_log ">\$$d failure"; | |
309 | close $dd(fchan) | |
310 | } | |
6b33d29a IJ |
311 | unset dd(fchan) |
312 | reporterr "remoteleds on $d died" | |
313 | dset_trylater $d | |
314 | } | |
315 | ||
316 | proc_dset trylater {} { | |
b52676c0 IJ |
317 | global retry_after |
318 | set dd(retry) [after $retry_after [list dset_start $d]] | |
6b33d29a IJ |
319 | } |
320 | ||
321 | proc config_change {} { | |
322 | global onchans chans_retry errchan | |
323 | foreach ch [array names onchans] { | |
324 | manyset $onchans($ch) status after | |
325 | if {"$status" == "shortly"} { | |
326 | catch { after cancel $after } | |
327 | } | |
328 | set onchans($ch) mustleave | |
329 | } | |
6b33d29a | 330 | sendout JOIN $errchan |
b52676c0 | 331 | chan_shortly $errchan |
6b33d29a IJ |
332 | foreach m [list_objs monitor] { |
333 | upvar #0 monitor/$m mm | |
334 | foreach ch $mm(chans) { | |
335 | sendout JOIN $ch | |
336 | chan_shortly $ch | |
337 | } | |
338 | } | |
339 | foreach ch [array names onchans] { | |
340 | if {"[lindex $onchans($ch) 0]" != "mustleave"} continue | |
341 | sendout PART $ch | |
342 | unset onchans($ch) | |
343 | } | |
344 | after $chans_retry config_change | |
345 | } | |
346 | ||
347 | proc chan_shortly {ch} { | |
348 | global chan_after | |
349 | upvar #0 onchans($ch) oc | |
b52676c0 IJ |
350 | if {[info exists oc]} { |
351 | manyset $oc status after | |
352 | if {"$status" == "shortly"} return | |
353 | } | |
6b33d29a IJ |
354 | set oc [list shortly [after $chan_after chan_sendnames $ch]] |
355 | } | |
356 | ||
357 | proc chan_sendnames {ch} { | |
358 | upvar #0 onchans($ch) oc | |
359 | sendout NAMES $ch | |
360 | set oc idle | |
361 | } | |
362 | ||
b52676c0 | 363 | def_ucmd reload { |
6b33d29a IJ |
364 | set username [ta_word] |
365 | ta_nomore | |
b52676c0 | 366 | set m [reloaduser $username] |
6b33d29a | 367 | config_change |
b52676c0 | 368 | ucmdr {} $m |
6b33d29a IJ |
369 | } |
370 | ||
b52676c0 IJ |
371 | def_ucmd who { |
372 | set r {} | |
373 | foreach m [list_objs monitor] { | |
374 | upvar #0 monitor/$m mm | |
375 | lappend r "monitoring $mm(chans) for $m" | |
376 | } | |
377 | foreach d [list_objs deviceset] { | |
378 | upvar #0 deviceset/$d dd | |
379 | regexp {^[^:]*\:[^:]*} $dd(group) dest | |
380 | lappend r "sending $dd(monname) to $dest" | |
381 | } | |
382 | } | |
383 | ||
384 | proc connected {} { | |
6b33d29a IJ |
385 | foreach f [glob -nocomplain pwdb/p*] { |
386 | regexp {^pwdb/p(.*)$} $f dummy username | |
b52676c0 | 387 | set m [reloaduser $username] |
6b33d29a IJ |
388 | } |
389 | config_change | |
390 | } | |
391 | ||
392 | # fixme | |
393 | # 353 | |
394 | # JOIN PART | |
395 | # KICK KILL QUIT | |
b52676c0 IJ |
396 | |
397 | if {[catch { | |
398 | loadhelp | |
399 | ensure_connecting | |
400 | } emsg]} { | |
401 | fail "startup: $emsg" | |
402 | } |