Commit | Line | Data |
---|---|---|
3e580664 | 1 | # see ledbot.html |
def7479c | 2 | # $Id: ledmodule.tcl,v 1.14 2002-06-10 03:13:26 ijackson Exp $ |
6b33d29a IJ |
3 | |
4 | set helpfile ledhelp | |
5 | ||
6 | source irccore.tcl | |
7 | source parsecmd.tcl | |
8 | source stdhelp.tcl | |
b52676c0 | 9 | source userv.tcl |
6b33d29a | 10 | |
cdbc7569 IJ |
11 | defset errchan #$nick |
12 | defset retry_after 900000 | |
c3b9bf49 | 13 | defset chan_after 1500 |
cdbc7569 IJ |
14 | defset chans_retry 3600000 |
15 | defset debug_reset_after 86400000 | |
16 | ||
17 | defset debugusers {} | |
18 | ||
6b33d29a IJ |
19 | # variables |
20 | # | |
21 | # monitor/$monname(chans) -> [list $chan1 $chan2 ...] | |
22 | # monitor/$monname(ignore) -> [list $regexp ...] | |
23 | # monitor/$monname(prefer) -> [list $regexp ...] | |
cdbc7569 | 24 | # monitor/$monname(present-$chan) -> [list $lnick ...] |
6b33d29a IJ |
25 | # monitor/$monname(last-talk) -> $time_t |
26 | # monitor/$monname(last-talkpref) -> $time_t | |
27 | # monitor/$monname(time-recent) -> $seconds | |
28 | # monitor/$monname(time-recentnow) -> $seconds | |
cdbc7569 | 29 | # monitor/$monname(talkchange) -> [after ...] or unset |
6b33d29a | 30 | # |
b52676c0 IJ |
31 | # deviceset/$username:$lno(monname) -> $monname |
32 | # deviceset/$username:$lno(group) -> $led_group | |
33 | # deviceset/$username:$lno(username) -> $username | |
cdbc7569 | 34 | # deviceset/$username:$lno(values) -> $valuestring |
b52676c0 | 35 | # deviceset/$username:$lno(states) -> [list $state1 $value1 $state2 ...] |
cdbc7569 IJ |
36 | # deviceset/$username:$lno(ochan) -> [open remoteleds ... | r] or unset |
37 | # deviceset/$username:$lno(ichan) -> fifo for remoteleds input or unset | |
b52676c0 | 38 | # deviceset/$username:$lno(retry) -> [after ... ] or unset |
6b33d29a IJ |
39 | # |
40 | # onchans($chan) [list mustleave] # in config_chane | |
41 | # onchans($chan) [list idle] | |
42 | # onchans($chan) [list forced] # for errchan | |
43 | # onchans($chan) [list shortly [after ...]] # do a NAMES | |
44 | ||
cdbc7569 IJ |
45 | proc ldebug {facil m} { |
46 | global debugusers | |
47 | # facil is | |
48 | # m$monname | |
49 | # d$deviceset | |
50 | # c$lchan | |
51 | # {} for system stuff | |
17621e46 | 52 | if {![llength $debugusers]} return |
d1dac9c9 | 53 | if {[regexp {[mdu]([^:]+)\:} $facil dummy username] && |
cdbc7569 IJ |
54 | [lsearch -exact $debugusers $username]==-1} return |
55 | ||
56 | regsub {^(.)} $facil {\1 } cc | |
57 | reporterr "DEBUG $cc $m" | |
58 | } | |
59 | ||
6b33d29a IJ |
60 | proc list_objs {vp} { |
61 | set l {} | |
62 | foreach v [info globals] { | |
63 | if {![regsub ^$vp/ $v {} v]} continue | |
64 | lappend l $v | |
65 | } | |
66 | return $l | |
67 | } | |
68 | ||
b52676c0 IJ |
69 | proc privmsg_unlogged {p ischan params} { |
70 | global errorInfo | |
71 | if {!$ischan} { return 0 } | |
6b33d29a | 72 | |
b52676c0 IJ |
73 | # on-channel message |
74 | if {[catch { | |
75 | prefix_nick | |
76 | foreach m [list_objs monitor] { | |
77 | mon_speech $m [irctolower [lindex $params 0]] [irctolower $n] | |
78 | } | |
79 | } emsg]} { | |
80 | log "processing error: $emsg\n$errorInfo" | |
6b33d29a IJ |
81 | } |
82 | return 1; | |
83 | } | |
84 | ||
85 | proc reporterr {m} { | |
86 | global errchan | |
87 | sendprivmsg $errchan $m | |
88 | } | |
89 | ||
b52676c0 IJ |
90 | proc msg_PRIVMSG {p c dest text} { |
91 | global errchan | |
92 | prefix_nick | |
93 | execute_usercommand $p $c $n $errchan $dest $text | |
94 | } | |
95 | ||
6b33d29a IJ |
96 | proc proc_mon {name argl body} { |
97 | proc mon_$name [concat m $argl] " | |
98 | upvar #0 monitor/\$m mm | |
99 | $body" | |
100 | } | |
101 | ||
b52676c0 IJ |
102 | proc mon_nick_is {globlist ln} { |
103 | foreach gl $globlist { | |
104 | if {[string match $gl $ln]} { return 1 } | |
105 | } | |
106 | return 0 | |
107 | } | |
108 | ||
cdbc7569 | 109 | proc_mon gotchanlist {ch nll} { |
c3b9bf49 | 110 | global nick |
cdbc7569 | 111 | if {[lsearch -exact $mm(chans) $ch] == -1} return |
c3b9bf49 IJ |
112 | set l {} |
113 | foreach nl $nll { | |
114 | if {![string compare $nl [irctolower $nick]]} continue | |
115 | if {[mon_nick_is $mm(nopresence) $nl]} continue | |
178ab287 | 116 | if {[mon_nick_is $mm(ignore) $nl]} continue |
fbcbda85 | 117 | lappend l $nl |
c3b9bf49 | 118 | } |
9d6128b9 | 119 | ldebug m$m "$ch names: $l" |
c3b9bf49 | 120 | set mm(present-$ch) $l |
cdbc7569 IJ |
121 | mon_updateall $m |
122 | } | |
123 | ||
6b33d29a | 124 | proc_mon speech {chan ln} { |
b52676c0 | 125 | if {[lsearch -exact $mm(chans) $chan] == -1} return |
6b33d29a IJ |
126 | if {[mon_nick_is $mm(ignore) $ln]} return |
127 | set now [clock seconds] | |
128 | set mm(last-talk) $now | |
b52676c0 | 129 | if {[mon_nick_is $mm(prefer) $ln]} { set mm(last-talkpref) $now } |
6b33d29a IJ |
130 | mon_updateall $m |
131 | } | |
132 | ||
133 | proc_mon calcstate {} { | |
cdbc7569 IJ |
134 | set s " default " |
135 | foreach ch $mm(chans) { | |
136 | if {[llength $mm(present-$ch)]} { append s "present "; break } | |
137 | } | |
6b33d29a | 138 | set now [clock seconds] |
cdbc7569 IJ |
139 | set valid_until [expr {$now + 86400}] |
140 | set refresh_later 0 | |
141 | catch { after cancel $mm(talkchange) } | |
b52676c0 | 142 | foreach p {{} pref} { |
6b33d29a | 143 | foreach t {{} now} { |
cdbc7569 IJ |
144 | set vu [expr {$mm(last-talk$p) + $mm(time-recent$t)}] |
145 | if {$vu < $now} continue | |
6b33d29a | 146 | append s "${p}talk${t} " |
cdbc7569 IJ |
147 | set refresh_later 1 |
148 | if {$vu < $valid_until} { set valid_until $vu } | |
6b33d29a IJ |
149 | } |
150 | } | |
cdbc7569 IJ |
151 | regsub {^ default } $s { } ss |
152 | set ds [string trim $ss] | |
153 | if {$refresh_later} { | |
154 | set interval [expr {$valid_until - $now + 2}] | |
155 | set ivms [expr {$interval*1000}] | |
156 | set mm(talkchange) [after $ivms [list mon_updateall $m]] | |
157 | ldebug m$m "until now+${interval}: $ds" | |
158 | } else { | |
159 | ldebug m$m "indefinitely: $ds" | |
160 | } | |
6b33d29a IJ |
161 | return $s |
162 | } | |
163 | ||
164 | proc_mon updateall {} { | |
165 | set s [mon_calcstate $m] | |
b52676c0 | 166 | foreach d [list_objs deviceset] { |
6b33d29a IJ |
167 | upvar #0 deviceset/$d dd |
168 | if {[string compare $m $dd(monname)]} continue | |
b52676c0 | 169 | dset_setbystate $d $s |
6b33d29a IJ |
170 | } |
171 | } | |
172 | ||
173 | proc_mon destroy {} { | |
cdbc7569 IJ |
174 | ldebug m$m "destroying" |
175 | catch { after cancel $mm(talkchange) } | |
6b33d29a IJ |
176 | catch { unset mm } |
177 | } | |
178 | ||
179 | proc proc_dset {name argl body} { | |
180 | proc dset_$name [concat d $argl] " | |
181 | upvar #0 deviceset/\$d dd | |
03106fe0 | 182 | set returncode \[catch { |
6b33d29a | 183 | $body |
03106fe0 IJ |
184 | } emsg\] |
185 | global errorInfo errorCode | |
186 | if {\$returncode==1} { | |
6b33d29a | 187 | reporterr \"error on \$d: \$emsg\" |
03106fe0 IJ |
188 | } elseif {\$returncode==2} { |
189 | return \$emsg | |
190 | } else { | |
191 | return -code \$returncode -errorinfo \$errorInfo -errorcode \$errorCode | |
6b33d29a IJ |
192 | }" |
193 | } | |
194 | ||
b52676c0 IJ |
195 | proc timed_log {m} { |
196 | log "[clock seconds] $m" | |
197 | } | |
198 | ||
6b33d29a | 199 | proc_dset setbystate {s} { |
cdbc7569 | 200 | foreach {sq v} $dd(states) { |
6b33d29a IJ |
201 | if {![string match *$sq* $s]} continue |
202 | set lv $v; break | |
203 | } | |
d1dac9c9 | 204 | if {![info exists dd(ichan)]} return |
cdbc7569 IJ |
205 | if {![info exists lv]} { |
206 | reporterr "no state for $d matching$s" | |
207 | return | |
208 | } | |
209 | ldebug d$d "matches $sq: $v" | |
b52676c0 | 210 | timed_log "->$d $lv" |
cdbc7569 IJ |
211 | set dd(values) "$sq=$lv" |
212 | puts $dd(ichan) $lv | |
6b33d29a IJ |
213 | } |
214 | ||
b52676c0 | 215 | proc_dset destroy {} { |
cdbc7569 | 216 | ldebug d$d "destroying" |
6b33d29a | 217 | catch { after cancel $dd(retry) } |
b52676c0 | 218 | catch { |
cdbc7569 IJ |
219 | if {[info exists dd(ochan)]} { timed_log ">\$$d destroy" } |
220 | close $dd(ochan) | |
221 | close $dd(ichan) | |
b52676c0 | 222 | } |
6b33d29a IJ |
223 | catch { unset dd } |
224 | } | |
225 | ||
cdbc7569 IJ |
226 | proc modvar_save_copy {cv defv} { |
227 | upvar 1 m m | |
228 | upvar 1 mm mm | |
229 | upvar 1 save/$m save | |
230 | if {[info exists save($cv)]} { | |
231 | set mm($cv) $save($cv) | |
232 | } else { | |
233 | set mm($cv) $defv | |
234 | } | |
235 | } | |
236 | ||
6b33d29a IJ |
237 | proc reloaduser {username} { |
238 | check_username $username | |
cdbc7569 | 239 | ldebug u$username "reloading" |
6b33d29a IJ |
240 | if {[catch { |
241 | set cfg [exec userv --timeout 3 $username irc-ledcontrol-config \ | |
242 | < /dev/null] | |
6b33d29a | 243 | } emsg]} { |
b52676c0 | 244 | regsub "\n" $emsg " // " emsg |
6b33d29a | 245 | reporterr "error reloading $username: $emsg" |
b52676c0 | 246 | return "" |
6b33d29a | 247 | } |
b52676c0 | 248 | foreach d [list_objs deviceset] { |
6b33d29a IJ |
249 | if {![string match $username:* $d]} continue |
250 | dset_destroy $d | |
251 | } | |
b52676c0 | 252 | foreach m [list_objs monitor] { |
6b33d29a | 253 | if {![string match $username* $m]} continue |
cdbc7569 IJ |
254 | upvar #0 monitor/$m mm |
255 | foreach cv [array names mm] { set save/${m}($cv) $mm($cv) } | |
6b33d29a IJ |
256 | } |
257 | if {![string length $cfg]} { | |
cdbc7569 | 258 | file delete pwdb/$username |
b52676c0 IJ |
259 | return "no config from $username" |
260 | } elseif {[catch { | |
261 | exec userv --timeout 3 $username irc-ledcontrol-passwords \ | |
262 | < /dev/null > pwdb/p$username | |
263 | } emsg]} { | |
264 | reporterr "error reading passwords for $username: $emsg" | |
265 | return "" | |
6b33d29a | 266 | } elseif {[catch { |
cdbc7569 | 267 | ldebug u$username "parsing" |
6b33d29a IJ |
268 | foreach cv {ignore nopresence prefer} { set cc($cv) {} } |
269 | set cc(time-recentnow) 120 | |
270 | set cc(time-recent) 450 | |
b52676c0 | 271 | set lno 0 |
d1dac9c9 | 272 | set contin {} |
6b33d29a | 273 | foreach l [split $cfg "\n"] { |
b52676c0 | 274 | incr lno |
d1dac9c9 IJ |
275 | append contin [string trim $l] |
276 | if {[regsub {\\$} $contin { } contin]} continue | |
277 | set l $contin | |
278 | set contin {} | |
6b33d29a | 279 | if {[regexp {^\#} $l]} { |
03106fe0 IJ |
280 | } elseif {![regexp {\S} $l]} { |
281 | } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(.*)$} \ | |
282 | "$l " dummy kind globs]} { | |
6b33d29a IJ |
283 | set cc($kind) {} |
284 | foreach gl [split $globs " "] { | |
285 | if {![string length $gl]} continue | |
286 | string match $gl {} | |
287 | lappend cc($kind) $gl | |
288 | } | |
def7479c | 289 | } elseif {[regexp {^times\s+(\d+)\s+(\d+)$} $l dummy rnow r]} { |
6b33d29a IJ |
290 | foreach cv {{} now} { set cc(time-recent$cv) [set r$cv] } |
291 | } elseif {[regexp {^monitor\s+(\S+)\s+(\S.*)$} $l dummy m cl]} { | |
292 | set cc(chans) {} | |
293 | if {![string match $username:* $m]} { | |
294 | error "monname must start with $username:" | |
295 | } | |
b52676c0 | 296 | check_monname $m |
6b33d29a IJ |
297 | foreach ch [split $cl " "] { |
298 | if {![string length $ch]} continue | |
b52676c0 | 299 | check_chan $ch |
6b33d29a IJ |
300 | if {![ischan $ch]} { error "invalid channel $ch" } |
301 | lappend cc(chans) [irctolower $ch] | |
b52676c0 | 302 | chan_shortly $ch |
6b33d29a IJ |
303 | } |
304 | upvar #0 monitor/$m mm | |
305 | foreach cv [array names cc] { set mm($cv) $cc($cv) } | |
cdbc7569 IJ |
306 | foreach cv {{} pref} { |
307 | modvar_save_copy last-talk$cv 0 | |
308 | } | |
309 | foreach cv [array names mm(chans)] { | |
310 | modvar_save_copy present-$cv {} | |
311 | } | |
312 | ldebug m$m "created" | |
6b33d29a | 313 | } elseif {[regexp \ |
d1dac9c9 | 314 | {^leds\s+([0-9A-Za-z][-.:/0-9A-Za-z]+)\s+(\S+)\s+(\S+.*)$} \ |
6b33d29a IJ |
315 | $l dummy g m states]} { |
316 | set d $username:$lno:$g | |
317 | set sl {} | |
b52676c0 | 318 | check_monname $m |
6b33d29a IJ |
319 | foreach sv [split $states " "] { |
320 | if {![string length $sv]} continue | |
321 | if {![regexp \ | |
cdbc7569 IJ |
322 | {^((?:pref)?talk(?:now)?|present|default)\=([0-9a-z][,/+0-9A-Za-z]*)$} \ |
323 | $sv dummy lhs rhs]} { | |
6b33d29a IJ |
324 | error "invalid state spec" |
325 | } | |
326 | lappend sl $lhs $rhs | |
327 | } | |
328 | upvar #0 deviceset/$d dd | |
329 | set dd(monname) $m | |
330 | set dd(states) $sl | |
331 | set dd(group) $g | |
cdbc7569 | 332 | set dd(values) startup |
b52676c0 | 333 | set dd(username) $username |
6b33d29a | 334 | dset_start $d |
cdbc7569 | 335 | ldebug d$d "created" |
d1dac9c9 IJ |
336 | } else { |
337 | error "invalid directive or syntax" | |
6b33d29a IJ |
338 | } |
339 | } | |
d1dac9c9 IJ |
340 | if {[string length $contin]} { |
341 | error "continuation line at end of file" | |
342 | } | |
6b33d29a | 343 | } emsg]} { |
b52676c0 IJ |
344 | reporterr "setup error $username:$lno:$emsg" |
345 | return "" | |
346 | } else { | |
347 | return "reloaded $username" | |
348 | } | |
349 | } | |
350 | ||
351 | proc check_monname {m} { | |
352 | if {[regexp {[^-_+:.#0-9a-zA-Z]} $m badchar]} { | |
353 | error "char $badchar not allowed in monnames" | |
354 | } | |
355 | if {![regexp {^[0-9a-zA-Z]} $m]} { | |
356 | error "monname must start with alphanum" | |
6b33d29a IJ |
357 | } |
358 | } | |
359 | ||
360 | proc_dset start {} { | |
361 | catch { unset dd(retry) } | |
b52676c0 | 362 | set username $dd(username) |
cdbc7569 | 363 | ldebug d$d "starting" |
6b33d29a | 364 | if {[catch { |
b52676c0 | 365 | set cmdl [list remoteleds --pipe $dd(group) \ |
cdbc7569 | 366 | --human --passfile-only pwdb/p$username] |
b52676c0 | 367 | timed_log "!-$d [join $cmdl " "]" |
cdbc7569 IJ |
368 | lappend cmdl < pwdb/fifo |& cat |
369 | catch { file delete pwdb/fifo } | |
370 | exec mkfifo -m 0600 pwdb/fifo | |
371 | set ichan [open pwdb/fifo r+] | |
372 | set ochan [open |$cmdl r] | |
373 | fconfigure $ichan -blocking 0 -buffering line | |
374 | fconfigure $ochan -blocking 0 -buffering line | |
cdbc7569 IJ |
375 | set dd(ichan) $ichan |
376 | set dd(ochan) $ochan | |
d1dac9c9 | 377 | fileevent $ochan readable [list dset_rledout $d] |
6b33d29a IJ |
378 | } emsg]} { |
379 | reporterr "remoteleds startup $d: $emsg" | |
cdbc7569 IJ |
380 | catch { close $ichan } |
381 | catch { close $ochan } | |
6b33d29a IJ |
382 | dset_trylater $d |
383 | } | |
384 | } | |
385 | ||
386 | proc_dset rledout {} { | |
b52676c0 | 387 | global errchan |
cdbc7569 | 388 | while {[gets $dd(ochan) l] != -1} { |
d1dac9c9 | 389 | reporterr "on $d: $dd(values): $l" |
b52676c0 | 390 | } |
cdbc7569 IJ |
391 | if {[fblocked $dd(ochan)]} return |
392 | timed_log ">\$$d failure"; | |
393 | catch { close $dd(ichan) } | |
394 | catch { close $dd(ochan) } | |
395 | unset dd(ichan) | |
396 | unset dd(ochan) | |
d1dac9c9 | 397 | reporterr "on $d died" |
6b33d29a IJ |
398 | dset_trylater $d |
399 | } | |
400 | ||
401 | proc_dset trylater {} { | |
b52676c0 | 402 | global retry_after |
cdbc7569 | 403 | ldebug d$d "will try again later" |
b52676c0 | 404 | set dd(retry) [after $retry_after [list dset_start $d]] |
6b33d29a IJ |
405 | } |
406 | ||
407 | proc config_change {} { | |
cdbc7569 IJ |
408 | global onchans chans_retry errchan config_retry_after |
409 | ldebug {} "rechecking configuration etc" | |
6b33d29a IJ |
410 | foreach ch [array names onchans] { |
411 | manyset $onchans($ch) status after | |
412 | if {"$status" == "shortly"} { | |
413 | catch { after cancel $after } | |
414 | } | |
415 | set onchans($ch) mustleave | |
416 | } | |
6b33d29a | 417 | sendout JOIN $errchan |
b52676c0 | 418 | chan_shortly $errchan |
6b33d29a IJ |
419 | foreach m [list_objs monitor] { |
420 | upvar #0 monitor/$m mm | |
421 | foreach ch $mm(chans) { | |
422 | sendout JOIN $ch | |
423 | chan_shortly $ch | |
424 | } | |
425 | } | |
426 | foreach ch [array names onchans] { | |
427 | if {"[lindex $onchans($ch) 0]" != "mustleave"} continue | |
428 | sendout PART $ch | |
429 | unset onchans($ch) | |
430 | } | |
cdbc7569 IJ |
431 | catch { after cancel $config_retry_after } |
432 | set config_retry_after [after $chans_retry config_change] | |
6b33d29a IJ |
433 | } |
434 | ||
c3b9bf49 | 435 | proc allchans_shortly {} { |
9d6128b9 IJ |
436 | global onchans |
437 | foreach ch [array names onchans] { chan_shortly $ch } | |
c3b9bf49 IJ |
438 | } |
439 | ||
6b33d29a | 440 | proc chan_shortly {ch} { |
9d6128b9 | 441 | global chan_after |
c3b9bf49 | 442 | set ch [irctolower $ch] |
6b33d29a | 443 | upvar #0 onchans($ch) oc |
b52676c0 IJ |
444 | if {[info exists oc]} { |
445 | manyset $oc status after | |
cdbc7569 IJ |
446 | if {"$status" == "shortly"} { |
447 | ldebug c$ch "queued check already pending" | |
448 | return | |
449 | } | |
b52676c0 | 450 | } |
cdbc7569 | 451 | ldebug c$ch "queueing check" |
6b33d29a IJ |
452 | set oc [list shortly [after $chan_after chan_sendnames $ch]] |
453 | } | |
454 | ||
cdbc7569 IJ |
455 | proc msg_353 {p c dest type chan nicklist} { |
456 | set lchan [irctolower $chan] | |
457 | set nll [irctolower $nicklist] | |
c3b9bf49 | 458 | regsub -all {[=@*]} $nll {} nll |
9d6128b9 | 459 | ldebug c$lchan "all names: $nll" |
cdbc7569 IJ |
460 | foreach m [list_objs monitor] { |
461 | mon_gotchanlist $m $lchan $nll | |
462 | } | |
463 | } | |
464 | ||
6b33d29a IJ |
465 | proc chan_sendnames {ch} { |
466 | upvar #0 onchans($ch) oc | |
cdbc7569 | 467 | ldebug c$ch "asking for namelist" |
6b33d29a IJ |
468 | sendout NAMES $ch |
469 | set oc idle | |
470 | } | |
471 | ||
b52676c0 | 472 | def_ucmd reload { |
6b33d29a IJ |
473 | set username [ta_word] |
474 | ta_nomore | |
b52676c0 | 475 | set m [reloaduser $username] |
6b33d29a | 476 | config_change |
b52676c0 | 477 | ucmdr {} $m |
6b33d29a IJ |
478 | } |
479 | ||
cdbc7569 IJ |
480 | proc debug_reset {} { |
481 | global debugusers debug_cancelling | |
482 | unset debug_cancelling | |
483 | set debugusers {} | |
484 | reporterr "debug mode timed out" | |
485 | } | |
486 | ||
487 | def_ucmd debug { | |
488 | prefix_nick | |
489 | global debugusers debug_cancelling debug_reset_after | |
490 | if {![string length $text]} { error "must give list of usernames" } | |
491 | llength $text | |
492 | set debugusers $text | |
493 | catch { after cancel $debug_cancelling } | |
494 | set debug_cancelling [after $debug_reset_after debug_reset] | |
495 | reporterr "debug enabled by $n: $debugusers" | |
496 | } | |
497 | ||
498 | def_ucmd nodebug { | |
499 | prefix_nick | |
9d6128b9 | 500 | ta_nomore |
cdbc7569 IJ |
501 | global debugusers debug_cancelling |
502 | set debugusers {} | |
503 | catch { after cancel $debug_cancelling } | |
504 | catch { unset debug_cancelling } | |
505 | reporterr "debug disabled by $n" | |
506 | } | |
507 | ||
03106fe0 IJ |
508 | proc_dset visibledest {} { |
509 | regsub {\:[^:]*/} $d/ { } p | |
510 | regsub {^([^:]+)\:\d+\:} $p {\1, } p | |
511 | regsub { $} $p {} p | |
512 | return $p | |
178ab287 IJ |
513 | } |
514 | ||
b52676c0 IJ |
515 | def_ucmd who { |
516 | set r {} | |
517 | foreach m [list_objs monitor] { | |
518 | upvar #0 monitor/$m mm | |
519 | lappend r "monitoring $mm(chans) for $m" | |
520 | } | |
521 | foreach d [list_objs deviceset] { | |
522 | upvar #0 deviceset/$d dd | |
ac076fbd IJ |
523 | set m $dd(monname) |
524 | upvar #0 monitor/$m mm | |
9e0b3214 | 525 | if {![info exists mm(chans)]} continue |
ac076fbd | 526 | lappend r "sending $m to [dset_visibledest $d]" |
b52676c0 | 527 | } |
cdbc7569 | 528 | ucmdr [join $r "\n"] {} |
b52676c0 IJ |
529 | } |
530 | ||
531 | proc connected {} { | |
cdbc7569 | 532 | ldebug {} "connected" |
6b33d29a IJ |
533 | foreach f [glob -nocomplain pwdb/p*] { |
534 | regexp {^pwdb/p(.*)$} $f dummy username | |
b52676c0 | 535 | set m [reloaduser $username] |
6b33d29a IJ |
536 | } |
537 | config_change | |
538 | } | |
539 | ||
178ab287 IJ |
540 | proc warn_pref {n} { |
541 | set nl [irctolower $n] | |
542 | set l {} | |
178ab287 IJ |
543 | foreach d [list_objs deviceset] { |
544 | upvar #0 deviceset/$d dd | |
03106fe0 IJ |
545 | set m $dd(monname) |
546 | upvar #0 monitor/$m mm | |
547 | if {![info exists mm(prefer)]} continue | |
548 | if {![mon_nick_is $mm(prefer) $nl]} continue | |
549 | foreach ch $mm(chans) { set wch($ch) 1 } | |
550 | lappend l [dset_visibledest $d] | |
178ab287 IJ |
551 | } |
552 | if {[llength $l]} { | |
03106fe0 IJ |
553 | sendprivmsg $nl "LEDs are watching on [\ |
554 | join [lsort [array names wch]] ","]: [join $l " "]" | |
178ab287 IJ |
555 | } |
556 | } | |
557 | ||
558 | proc msg_JOIN {p c chan} { | |
559 | prefix_nick | |
560 | set nl [irctolower $n] | |
561 | chan_shortly $chan | |
562 | warn_pref $n | |
563 | } | |
c3b9bf49 IJ |
564 | proc msg_PART {p c chan} { chan_shortly $chan } |
565 | proc msg_KILL {p c user why} { allchans_shortly } | |
566 | proc msg_QUIT {p c why} { allchans_shortly } | |
178ab287 | 567 | proc msg_NICK {p c newnick} { allchans_shortly; warn_pref $newnick } |
c3b9bf49 IJ |
568 | proc msg_KICK {p c chans users comment} { |
569 | if {[llength $chans] > 1} { | |
570 | allchans_shortly | |
571 | } else { | |
572 | chan_shortly [lindex $chans 0] | |
573 | } | |
574 | } | |
b52676c0 IJ |
575 | |
576 | if {[catch { | |
577 | loadhelp | |
578 | ensure_connecting | |
579 | } emsg]} { | |
580 | fail "startup: $emsg" | |
581 | } |