~mdw / ircbot / blame
| 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 | |
| 40 | ||
| 41 | # variables | |
| 42 | # | |
| 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 | |
| 51 | # | |
| 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 | |
| 57 | # | |
| 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 | |
| 62 | ||
| 63 | proc list_objs {vp} { | |
| 64 | set l {} | |
| 65 | foreach v [info globals] { | |
| 66 | if {![regsub ^$vp/ $v {} v]} continue | |
| 67 | lappend l $v | |
| 68 | } | |
| 69 | return $l | |
| 70 | } | |
| 71 | ||
| 72 | proc privmsg_unlogged {prefix ischan params} { | |
| 73 | if {!$ischan} { | |
| 74 | prefix_nick | |
| 75 | execute_usercommand $p PRIVMSG $n $n \ | |
| 76 | [lindex $params 0] [lindex $params 1] | |
| 77 | return 0 | |
| 78 | } | |
| 79 | ||
| 80 | foreach m [list_objs monitor] { | |
| 81 | mon_speech $m [irctolower [lindex $params 0]] [irctolower $n] | |
| 82 | } | |
| 83 | return 1; | |
| 84 | } | |
| 85 | ||
| 86 | proc reporterr {m} { | |
| 87 | global errchan | |
| 88 | sendprivmsg $errchan $m | |
| 89 | } | |
| 90 | ||
| 91 | proc proc_mon {name argl body} { | |
| 92 | proc mon_$name [concat m $argl] " | |
| 93 | upvar #0 monitor/\$m mm | |
| 94 | $body" | |
| 95 | } | |
| 96 | ||
| 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 } | |
| 103 | mon_updateall $m | |
| 104 | } | |
| 105 | ||
| 106 | proc_mon calcstate {} { | |
| 107 | set s " " | |
| 108 | if {[llength $mm(present)]} { append s "present " } | |
| 109 | set now [clock seconds] | |
| 110 | for p {{} pref} { | |
| 111 | foreach t {{} now} { | |
| 112 | set since [expr {$now - $mm(time-recent$t)}] | |
| 113 | if {[expr {$mm(last-talk$pref) < $since}]} continue | |
| 114 | append s "${p}talk${t} " | |
| 115 | } | |
| 116 | } | |
| 117 | return $s | |
| 118 | } | |
| 119 | ||
| 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 | |
| 125 | dset_setbystate $s | |
| 126 | } | |
| 127 | } | |
| 128 | ||
| 129 | proc_mon destroy {} { | |
| 130 | catch { unset mm } | |
| 131 | } | |
| 132 | ||
| 133 | proc proc_dset {name argl body} { | |
| 134 | proc dset_$name [concat d $argl] " | |
| 135 | upvar #0 deviceset/\$d dd | |
| 136 | if {[catch { | |
| 137 | $body | |
| 138 | } emsg]} { | |
| 139 | reporterr \"error on \$d: \$emsg\" | |
| 140 | }" | |
| 141 | } | |
| 142 | ||
| 143 | proc_dset setbystate {s} { | |
| 144 | set lv {} | |
| 145 | foreach {sq v} { | |
| 146 | if {![string match *$sq* $s]} continue | |
| 147 | set lv $v; break | |
| 148 | } | |
| 149 | puts $dd(fchan) $lv | |
| 150 | } | |
| 151 | ||
| 152 | proc dset_destroy {} { | |
| 153 | catch { after cancel $dd(retry) } | |
| 154 | catch { close $dd(fchan) } | |
| 155 | catch { unset dd } | |
| 156 | } | |
| 157 | ||
| 158 | proc reloaduser {username} { | |
| 159 | check_username $username | |
| 160 | if {[catch { | |
| 161 | set cfg [exec userv --timeout 3 $username irc-ledcontrol-config \ | |
| 162 | < /dev/null] | |
| 163 | set pw [exec userv --timeout 3 $username irc-ledcontrol-passwords \ | |
| 164 | < /dev/null > pwdb/p$username] | |
| 165 | } emsg]} { | |
| 166 | reporterr "error reloading $username: $emsg" | |
| 167 | } | |
| 168 | for d [list_objs deviceset] { | |
| 169 | if {![string match $username:* $d]} continue | |
| 170 | dset_destroy $d | |
| 171 | } | |
| 172 | for m [list_objs monitor] { | |
| 173 | if {![string match $username* $m]} continue | |
| 174 | mon_destroy $m | |
| 175 | } | |
| 176 | if {![string length $cfg]} { | |
| 177 | file remove pwdb/$username | |
| 178 | } elseif {[catch { | |
| 179 | foreach cv {ignore nopresence prefer} { set cc($cv) {} } | |
| 180 | set cc(time-recentnow) 120 | |
| 181 | set cc(time-recent) 450 | |
| 182 | set pline 0 | |
| 183 | foreach l [split $cfg "\n"] { | |
| 184 | incr pline | |
| 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]} { | |
| 189 | set cc($kind) {} | |
| 190 | foreach gl [split $globs " "] { | |
| 191 | if {![string length $gl]} continue | |
| 192 | string match $gl {} | |
| 193 | lappend cc($kind) $gl | |
| 194 | } | |
| 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]} { | |
| 198 | set cc(chans) {} | |
| 199 | if {![string match $username:* $m]} { | |
| 200 | error "monname must start with $username:" | |
| 201 | } | |
| 202 | foreach ch [split $cl " "] { | |
| 203 | if {![string length $ch]} continue | |
| 204 | check_nick $ch | |
| 205 | if {![ischan $ch]} { error "invalid channel $ch" } | |
| 206 | lappend cc(chans) [irctolower $ch] | |
| 207 | } | |
| 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 } | |
| 211 | } elseif {[regexp \ | |
| 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 | |
| 215 | set sl {} | |
| 216 | foreach sv [split $states " "] { | |
| 217 | if {![string length $sv]} continue | |
| 218 | if {![regexp \ | |
| 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" | |
| 222 | } | |
| 223 | lappend sl $lhs $rhs | |
| 224 | } | |
| 225 | upvar #0 deviceset/$d dd | |
| 226 | set dd(monname) $m | |
| 227 | set dd(states) $sl | |
| 228 | set dd(group) $g | |
| 229 | dset_start $d | |
| 230 | } | |
| 231 | } | |
| 232 | } emsg]} { | |
| 233 | reporterr "setup error $username:$pline:$emsg" | |
| 234 | } | |
| 235 | } | |
| 236 | ||
| 237 | proc_dset start {} { | |
| 238 | catch { unset dd(retry) } | |
| 239 | if {[catch { | |
| 240 | set fchan [open [list | \ | |
| 241 | remoteleds 2>&1 --pipe $g \ | |
| 242 | --passfile-only pwdb/p$username \ | |
| 243 | |& cat \ | |
| 244 | ]] | |
| 245 | fconfigure $fchan -blocking 0 | |
| 246 | fileevent $fchan readable [list dset_rledout $d] | |
| 247 | set dd(fchan) $fchan | |
| 248 | } emsg]} { | |
| 249 | reporterr "remoteleds startup $d: $emsg" | |
| 250 | dset_trylater $d | |
| 251 | } | |
| 252 | } | |
| 253 | ||
| 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) } | |
| 259 | unset dd(fchan) | |
| 260 | reporterr "remoteleds on $d died" | |
| 261 | dset_trylater $d | |
| 262 | } | |
| 263 | ||
| 264 | proc_dset trylater {} { | |
| 265 | set dd(retry) [after $retry_after [list proc_dset start $d]] | |
| 266 | } | |
| 267 | ||
| 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 } | |
| 274 | } | |
| 275 | set onchans($ch) mustleave | |
| 276 | } | |
| 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) { | |
| 282 | sendout JOIN $ch | |
| 283 | chan_shortly $ch | |
| 284 | } | |
| 285 | } | |
| 286 | foreach ch [array names onchans] { | |
| 287 | if {"[lindex $onchans($ch) 0]" != "mustleave"} continue | |
| 288 | sendout PART $ch | |
| 289 | unset onchans($ch) | |
| 290 | } | |
| 291 | after $chans_retry config_change | |
| 292 | } | |
| 293 | ||
| 294 | proc chan_shortly {ch} { | |
| 295 | global chan_after | |
| 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]] | |
| 300 | } | |
| 301 | ||
| 302 | proc chan_sendnames {ch} { | |
| 303 | upvar #0 onchans($ch) oc | |
| 304 | sendout NAMES $ch | |
| 305 | set oc idle | |
| 306 | } | |
| 307 | ||
| 308 | def_ucmd reload {} { | |
| 309 | set username [ta_word] | |
| 310 | ta_nomore | |
| 311 | reloaduser $username | |
| 312 | config_change | |
| 313 | } | |
| 314 | ||
| 315 | proc connected { | |
| 316 | foreach f [glob -nocomplain pwdb/p*] { | |
| 317 | regexp {^pwdb/p(.*)$} $f dummy username | |
| 318 | check_username $username | |
| 319 | reloaduser $username | |
| 320 | } | |
| 321 | config_change | |
| 322 | } | |
| 323 | ||
| 324 | # fixme | |
| 325 | # 353 | |
| 326 | # JOIN PART | |
| 327 | # KICK KILL QUIT |