From: ijackson <ijackson>
Date: Sun, 9 Jun 2002 18:14:35 +0000 (+0000)
Subject: LED - before first test
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=30eceb6293c9f0bbb905e21925d91b203f07047b;p=ircbot.git

LED - before first test
---

diff --git a/ledconfig.tcl b/ledconfig.tcl
new file mode 100644
index 0000000..ae3a72d
--- /dev/null
+++ b/ledconfig.tcl
@@ -0,0 +1,13 @@
+# Configuration for ledbot
+
+set host chiark.greenend.org.uk
+set nick ledcontrol
+set ownfullname "activity LEDs"
+set ownmailaddr ijackson@chiark.greenend.org.uk
+set socketargs {}
+set errchan #ledcontrol
+set retry_after 300000
+set chan_after 3000
+set chans_retry 3600000
+
+source ledmodule.tcl
diff --git a/ledmodule.tcl b/ledmodule.tcl
new file mode 100644
index 0000000..90bc013
--- /dev/null
+++ b/ledmodule.tcl
@@ -0,0 +1,327 @@
+# 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