--- /dev/null
+# 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 <glob-pattern> [...]
+# times <very-recently> <a-while-ago> (default 120 450)
+# (affect subsequent `monitor' directives)
+# monitor <monname> <#chan>[,<#chan>...]
+# <monname> must start with <username>:
+#
+# a deviceset specifies
+# monitor
+# led-group
+# led states
+# syntax
+# leds <led-group> <monname> <state>=<value>
+# 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
+
+set helpfile ledhelp
+
+source irccore.tcl
+source parsecmd.tcl
+source stdhelp.tcl
+
+# variables
+#
+# monitor/$monname(chans) -> [list $chan1 $chan2 ...]
+# monitor/$monname(ignore) -> [list $regexp ...]
+# monitor/$monname(prefer) -> [list $regexp ...]
+# monitor/$monname(present) -> [list $lnick ...]
+# monitor/$monname(last-talk) -> $time_t
+# monitor/$monname(last-talkpref) -> $time_t
+# 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
+#
+# onchans($chan) [list mustleave] # in config_chane
+# onchans($chan) [list idle]
+# onchans($chan) [list forced] # for errchan
+# onchans($chan) [list shortly [after ...]] # do a NAMES
+
+proc list_objs {vp} {
+ set l {}
+ foreach v [info globals] {
+ if {![regsub ^$vp/ $v {} v]} continue
+ lappend l $v
+ }
+ 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
+ }
+
+ foreach m [list_objs monitor] {
+ mon_speech $m [irctolower [lindex $params 0]] [irctolower $n]
+ }
+ return 1;
+}
+
+proc reporterr {m} {
+ global errchan
+ sendprivmsg $errchan $m
+}
+
+proc proc_mon {name argl body} {
+ proc mon_$name [concat m $argl] "
+ upvar #0 monitor/\$m mm
+ $body"
+}
+
+proc_mon speech {chan ln} {
+ if {[search -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 }
+ mon_updateall $m
+}
+
+proc_mon calcstate {} {
+ set s " "
+ if {[llength $mm(present)]} { append s "present " }
+ set now [clock seconds]
+ for p {{} pref} {
+ foreach t {{} now} {
+ set since [expr {$now - $mm(time-recent$t)}]
+ if {[expr {$mm(last-talk$pref) < $since}]} continue
+ append s "${p}talk${t} "
+ }
+ }
+ return $s
+}
+
+proc_mon updateall {} {
+ set s [mon_calcstate $m]
+ for d [list_objs deviceset] {
+ upvar #0 deviceset/$d dd
+ if {[string compare $m $dd(monname)]} continue
+ dset_setbystate $s
+ }
+}
+
+proc_mon destroy {} {
+ catch { unset mm }
+}
+
+proc proc_dset {name argl body} {
+ proc dset_$name [concat d $argl] "
+ upvar #0 deviceset/\$d dd
+ if {[catch {
+ $body
+ } emsg]} {
+ reporterr \"error on \$d: \$emsg\"
+ }"
+}
+
+proc_dset setbystate {s} {
+ set lv {}
+ foreach {sq v} {
+ if {![string match *$sq* $s]} continue
+ set lv $v; break
+ }
+ puts $dd(fchan) $lv
+}
+
+proc dset_destroy {} {
+ catch { after cancel $dd(retry) }
+ catch { close $dd(fchan) }
+ catch { unset dd }
+}
+
+proc reloaduser {username} {
+ check_username $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]} {
+ reporterr "error reloading $username: $emsg"
+ }
+ for d [list_objs deviceset] {
+ if {![string match $username:* $d]} continue
+ dset_destroy $d
+ }
+ for m [list_objs monitor] {
+ if {![string match $username* $m]} continue
+ mon_destroy $m
+ }
+ if {![string length $cfg]} {
+ file remove pwdb/$username
+ } elseif {[catch {
+ foreach cv {ignore nopresence prefer} { set cc($cv) {} }
+ set cc(time-recentnow) 120
+ set cc(time-recent) 450
+ set pline 0
+ foreach l [split $cfg "\n"] {
+ incr pline
+ set l [string trim $l]
+ if {[regexp {^\#} $l]} {
+ } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\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]} {
+ 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) {}
+ if {![string match $username:* $m]} {
+ error "monname must start with $username:"
+ }
+ foreach ch [split $cl " "] {
+ if {![string length $ch]} continue
+ check_nick $ch
+ if {![ischan $ch]} { error "invalid channel $ch" }
+ lappend cc(chans) [irctolower $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 }
+ } 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 {}
+ foreach sv [split $states " "] {
+ if {![string length $sv]} continue
+ if {![regexp \
+ {^((pref)?talk(now)?|present|default)\=([0-9a-z][,/+0-9A-Za-z]*)$} \
+ $sv dummy lhs dummy dummy rhs]} {
+ error "invalid state spec"
+ }
+ lappend sl $lhs $rhs
+ }
+ upvar #0 deviceset/$d dd
+ set dd(monname) $m
+ set dd(states) $sl
+ set dd(group) $g
+ dset_start $d
+ }
+ }
+ } emsg]} {
+ reporterr "setup error $username:$pline:$emsg"
+ }
+}
+
+proc_dset start {} {
+ catch { unset dd(retry) }
+ if {[catch {
+ set fchan [open [list | \
+ remoteleds 2>&1 --pipe $g \
+ --passfile-only pwdb/p$username \
+ |& cat \
+ ]]
+ fconfigure $fchan -blocking 0
+ fileevent $fchan readable [list dset_rledout $d]
+ set dd(fchan) $fchan
+ } emsg]} {
+ reporterr "remoteleds startup $d: $emsg"
+ dset_trylater $d
+ }
+}
+
+proc_dset rledout {} {
+ global errchan retry_after
+ while {[gets $dd(fchan) l] != -1} { reporterr "remoteleds on $d: $l" }
+ if {[fblocked $dd(fchan)]} return
+ catch { 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]]
+}
+
+proc config_change {} {
+ global onchans chans_retry errchan
+ foreach ch [array names onchans] {
+ manyset $onchans($ch) status after
+ if {"$status" == "shortly"} {
+ catch { after cancel $after }
+ }
+ set onchans($ch) mustleave
+ }
+ set ch($errchan) forced
+ sendout JOIN $errchan
+ foreach m [list_objs monitor] {
+ upvar #0 monitor/$m mm
+ foreach ch $mm(chans) {
+ sendout JOIN $ch
+ chan_shortly $ch
+ }
+ }
+ foreach ch [array names onchans] {
+ if {"[lindex $onchans($ch) 0]" != "mustleave"} continue
+ sendout PART $ch
+ unset onchans($ch)
+ }
+ after $chans_retry config_change
+}
+
+proc chan_shortly {ch} {
+ global chan_after
+ upvar #0 onchans($ch) oc
+ manyset $oc status after
+ if {"$status" != "idle"} return
+ set oc [list shortly [after $chan_after chan_sendnames $ch]]
+}
+
+proc chan_sendnames {ch} {
+ upvar #0 onchans($ch) oc
+ sendout NAMES $ch
+ set oc idle
+}
+
+def_ucmd reload {} {
+ set username [ta_word]
+ ta_nomore
+ reloaduser $username
+ config_change
+}
+
+proc connected {
+ foreach f [glob -nocomplain pwdb/p*] {
+ regexp {^pwdb/p(.*)$} $f dummy username
+ check_username $username
+ reloaduser $username
+ }
+ config_change
+}
+
+# fixme
+# 353
+# JOIN PART
+# KICK KILL QUIT
~mdw / ircbot / commitdiff