bugfixes. before ledbot fchan reorg

diff --git a/.cvsignore b/.cvsignore
index 1aaf75e92101b7d5efdf68aba8a6a0989af9ae09..e50d556a8c08d918814bbc418a4732d99ba438b8 100644 (file)
--- a/.cvsignore
+++ b/.cvsignore
@@ -1,5 +1,6 @@
 summon
 users
 chans
 summon
 users
 chans

+pwdb

 botpass.tcl
 telling.ps
 botpass.tcl
 telling.ps

diff --git a/bot.tcl b/bot.tcl
index 9b73cc94f3f452a6278b622c9710267705eaa34e..b7063129502c7ca662dc84bc85978a9af267b708 100755 (executable)
--- a/bot.tcl
+++ b/bot.tcl
@@ -5,6 +5,7 @@ set helpfile helpinfos
 source irccore.tcl
 source parsecmd.tcl
 source stdhelp.tcl
 source irccore.tcl
 source parsecmd.tcl
 source stdhelp.tcl

+source userv.tcl

 
 defset marktime_min 300
 defset marktime_join_startdelay 5000
 
 defset marktime_min 300
 defset marktime_join_startdelay 5000


@@ -794,14 +795,6 @@ proc msg_366 {p c args} {
     unset names_chans
 }
 
     unset names_chans
 }
 

-proc check_username {target} {
-    if {
-       [string length $target] > 8 ||
-        [regexp {[^-0-9a-z]} $target] ||
-        ![regexp {^[a-z]} $target]
-    } { error "invalid username" }
-}
-

 proc somedb__head {} {
     uplevel 1 {
        set idl [irctolower $id]
 proc somedb__head {} {
     uplevel 1 {
        set idl [irctolower $id]

diff --git a/irccore.tcl b/irccore.tcl
index c3ee5446e5e44696edd361a4dad62d44d54dacad..34836e2a7c7a01468e6e06e8cb0d63bc77bfc2f8 100644 (file)
--- a/irccore.tcl
+++ b/irccore.tcl
@@ -247,6 +247,13 @@ proc check_nick {n} {
     if {[string length $n] > 18} { error "nick too long" }
 }
 
     if {[string length $n] > 18} { error "nick too long" }
 }
 

+proc check_chan {n} {
+    if {![regsub {^\#} $n {} n]} { error "bad chan start" }
+    if {[regexp -nocase {[^][\\`_^{|}a-z0-9-]} $n]} { error "bad char in chan" }
+    if {[regexp {^[-0-9]} $n]} { error "bad chan name start" }
+    if {[string length $n] > 18} { error "chan name too long" }
+}
+

 proc ischan {dest} {
     return [regexp {^[&#+!]} $dest]
 }
 proc ischan {dest} {
     return [regexp {^[&#+!]} $dest]
 }

diff --git a/ledconfig.tcl b/ledconfig.tcl
index ae3a72d9d1d252b7b9f78fe17b68f10b28fac72d..3d0a6b423024c0572b4ceb5ad88095a38cb2e674 100644 (file)
--- a/ledconfig.tcl
+++ b/ledconfig.tcl
@@ -1,11 +1,11 @@
 # Configuration for ledbot
 
 # Configuration for ledbot
 

-set host chiark.greenend.org.uk
-set nick ledcontrol
+set host chiark-tunnel.greenend.org.uk
+set nick ledctrl

 set ownfullname "activity LEDs"
 set ownmailaddr ijackson@chiark.greenend.org.uk
 set socketargs {}
 set ownfullname "activity LEDs"
 set ownmailaddr ijackson@chiark.greenend.org.uk
 set socketargs {}

-set errchan #ledcontrol
+set errchan #$nick

 set retry_after 300000
 set chan_after 3000
 set chans_retry 3600000
 set retry_after 300000
 set chan_after 3000
 set chans_retry 3600000

diff --git a/ledhelp b/ledhelp
new file mode 100644 (file)
index 0000000..b5ba083
--- /dev/null
+++ b/ledhelp
@@ -0,0 +1,10 @@
+:
+Commands:
+ reload <username>   reload configuration from <username>
+ help                display this help
+See
+ http://... for full information
+
+# Local variables:
+# fill-column: 69
+# End:

diff --git a/ledmodule.tcl b/ledmodule.tcl
index 90bc013fa62a447f4b6758a79d513177403a364c..3986863885124a08d7ee0031583eba2589f4f284 100644 (file)
--- a/ledmodule.tcl
+++ b/ledmodule.tcl
@@ -37,6 +37,7 @@ set helpfile ledhelp
 source irccore.tcl
 source parsecmd.tcl
 source stdhelp.tcl
 source irccore.tcl
 source parsecmd.tcl
 source stdhelp.tcl

+source userv.tcl

 
 # variables
 #
 
 # variables
 #


@@ -49,11 +50,12 @@ source stdhelp.tcl
 #   monitor/$monname(time-recent)     -> $seconds
 #   monitor/$monname(time-recentnow)  -> $seconds
 #
 #   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
+#   deviceset/$username:$lno(monname)  -> $monname
+#   deviceset/$username:$lno(group)    -> $led_group
+#   deviceset/$username:$lno(username) -> $username
+#   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 mustleave]                 # in config_chane
 #   onchans($chan)        [list idle]


@@ -69,16 +71,18 @@ proc list_objs {vp} {
     return $l
 }
 
     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
-    }
+proc privmsg_unlogged {p ischan params} {
+    global errorInfo
+    if {!$ischan} { return 0 }

 
 

-    foreach m [list_objs monitor] {
-       mon_speech $m [irctolower [lindex $params 0]] [irctolower $n]
+    # on-channel message
+    if {[catch {
+       prefix_nick
+       foreach m [list_objs monitor] {
+           mon_speech $m [irctolower [lindex $params 0]] [irctolower $n]
+       }
+    } emsg]} {
+       log "processing error: $emsg\n$errorInfo"

     }
     return 1;
 }
     }
     return 1;
 }


@@ -88,18 +92,31 @@ proc reporterr {m} {
     sendprivmsg $errchan $m
 }
 
     sendprivmsg $errchan $m
 }
 

+proc msg_PRIVMSG {p c dest text} {
+    global errchan
+    prefix_nick
+    execute_usercommand $p $c $n $errchan $dest $text
+}
+

 proc proc_mon {name argl body} {
     proc mon_$name [concat m $argl] "
     upvar #0 monitor/\$m mm
     $body"
 }
 
 proc proc_mon {name argl body} {
     proc mon_$name [concat m $argl] "
     upvar #0 monitor/\$m mm
     $body"
 }
 

+proc mon_nick_is {globlist ln} {
+    foreach gl $globlist {
+       if {[string match $gl $ln]} { return 1 }
+    }
+    return 0
+}
+

 proc_mon speech {chan ln} {
 proc_mon speech {chan ln} {

-    if {[search -exact $mm(chans) $chan] == -1} return
+    if {[lsearch -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(ignore) $ln]} return
     set now [clock seconds]
     set mm(last-talk) $now

-    if {[mon_nick_is $mm(prefer)]} { set mm(last-talkpref) $now }
+    if {[mon_nick_is $mm(prefer) $ln]} { set mm(last-talkpref) $now }

     mon_updateall $m
 }
 
     mon_updateall $m
 }
 


@@ -107,10 +124,10 @@ proc_mon calcstate {} {
     set s " "
     if {[llength $mm(present)]} { append s "present " }
     set now [clock seconds]
     set s " "
     if {[llength $mm(present)]} { append s "present " }
     set now [clock seconds]

-    for p {{} pref} {
+    foreach p {{} pref} {

        foreach t {{} now} {
            set since [expr {$now - $mm(time-recent$t)}]
        foreach t {{} now} {
            set since [expr {$now - $mm(time-recent$t)}]

-           if {[expr {$mm(last-talk$pref) < $since}]} continue
+           if {[expr {$mm(last-talk$p) < $since}]} continue

            append s "${p}talk${t} "
        }
     }
            append s "${p}talk${t} "
        }
     }


@@ -119,10 +136,10 @@ proc_mon calcstate {} {
 
 proc_mon updateall {} {
     set s [mon_calcstate $m]
 
 proc_mon updateall {} {
     set s [mon_calcstate $m]

-    for d [list_objs deviceset] {
+    foreach d [list_objs deviceset] {

        upvar #0 deviceset/$d dd
        if {[string compare $m $dd(monname)]} continue
        upvar #0 deviceset/$d dd
        if {[string compare $m $dd(monname)]} continue

-       dset_setbystate $s
+       dset_setbystate $d $s

     }
 }
 
     }
 }
 


@@ -133,25 +150,33 @@ proc_mon destroy {} {
 proc proc_dset {name argl body} {
     proc dset_$name [concat d $argl] "
     upvar #0 deviceset/\$d dd
 proc proc_dset {name argl body} {
     proc dset_$name [concat d $argl] "
     upvar #0 deviceset/\$d dd

-    if {[catch {
+    if {\[catch {

         $body
         $body

-    } emsg]} {
+    } emsg\]} {

        reporterr \"error on \$d: \$emsg\"
     }"
 }
 
        reporterr \"error on \$d: \$emsg\"
     }"
 }
 

+proc timed_log {m} {
+    log "[clock seconds] $m"
+}
+

 proc_dset setbystate {s} {
     set lv {}
 proc_dset setbystate {s} {
     set lv {}

-    foreach {sq v} {
+    foreach {sq v} $s {

        if {![string match *$sq* $s]} continue
        set lv $v; break
     }
        if {![string match *$sq* $s]} continue
        set lv $v; break
     }

+    timed_log "->$d $lv"

     puts $dd(fchan) $lv
 }
 
     puts $dd(fchan) $lv
 }
 

-proc dset_destroy {} {
+proc_dset destroy {} {

     catch { after cancel $dd(retry) }
     catch { after cancel $dd(retry) }

-    catch { close $dd(fchan) }
+    catch {
+       if {[info exists dd(fchan)]} { timed_log ">\$$d destroy" }
+       close $dd(fchan)
+    }

     catch { unset dd }
 }
 
     catch { unset dd }
 }
 


@@ -160,28 +185,35 @@ proc reloaduser {username} {
     if {[catch {
        set cfg [exec userv --timeout 3 $username irc-ledcontrol-config \
                < /dev/null]
     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]} {
     } emsg]} {

+       regsub "\n" $emsg " // " emsg

        reporterr "error reloading $username: $emsg"
        reporterr "error reloading $username: $emsg"

+       return ""

     }
     }

-    for d [list_objs deviceset] {
+    foreach d [list_objs deviceset] {

        if {![string match $username:* $d]} continue
        dset_destroy $d
     }
        if {![string match $username:* $d]} continue
        dset_destroy $d
     }

-    for m [list_objs monitor] {
+    foreach m [list_objs monitor] {

        if {![string match $username* $m]} continue
        mon_destroy $m
     }
     if {![string length $cfg]} {
        file remove pwdb/$username
        if {![string match $username* $m]} continue
        mon_destroy $m
     }
     if {![string length $cfg]} {
        file remove pwdb/$username

+       return "no config from $username"
+    } elseif {[catch {
+       exec userv --timeout 3 $username irc-ledcontrol-passwords \
+               < /dev/null > pwdb/p$username
+    } emsg]} {
+       reporterr "error reading passwords for $username: $emsg"
+       return ""

     } elseif {[catch {
        foreach cv {ignore nopresence prefer} { set cc($cv) {} }
        set cc(time-recentnow) 120
        set cc(time-recent) 450
     } elseif {[catch {
        foreach cv {ignore nopresence prefer} { set cc($cv) {} }
        set cc(time-recentnow) 120
        set cc(time-recent) 450

-       set pline 0
+       set lno 0

        foreach l [split $cfg "\n"] {
        foreach l [split $cfg "\n"] {

-           incr pline
+           incr lno

            set l [string trim $l]
            if {[regexp {^\#} $l]} {
            } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \
            set l [string trim $l]
            if {[regexp {^\#} $l]} {
            } elseif {[regexp {^nick\s+(ignore|nopresence|prefer)\s+(\S.*)$} \


@@ -199,20 +231,24 @@ proc reloaduser {username} {
                if {![string match $username:* $m]} {
                    error "monname must start with $username:"
                }
                if {![string match $username:* $m]} {
                    error "monname must start with $username:"
                }

+               check_monname $m

                foreach ch [split $cl " "] {
                    if {![string length $ch]} continue
                foreach ch [split $cl " "] {
                    if {![string length $ch]} continue

-                   check_nick $ch
+                   check_chan $ch

                    if {![ischan $ch]} { error "invalid channel $ch" }
                    lappend cc(chans) [irctolower $ch]
                    if {![ischan $ch]} { error "invalid channel $ch" }
                    lappend cc(chans) [irctolower $ch]

+                   chan_shortly $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 }
                }
                upvar #0 monitor/$m mm
                foreach cv [array names cc] { set mm($cv) $cc($cv) }
                foreach cv {{} pref} { set mm(last-talk$cv) 0 }

+               set mm(present) {}

            } 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 {}
            } 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 {}

+               check_monname $m

                foreach sv [split $states " "] {
                    if {![string length $sv]} continue
                    if {![regexp \
                foreach sv [split $states " "] {
                    if {![string length $sv]} continue
                    if {![regexp \


@@ -226,22 +262,35 @@ proc reloaduser {username} {
                set dd(monname) $m
                set dd(states) $sl
                set dd(group) $g
                set dd(monname) $m
                set dd(states) $sl
                set dd(group) $g

+               set dd(username) $username

                dset_start $d
            }
        }
     } emsg]} {
                dset_start $d
            }
        }
     } emsg]} {

-       reporterr "setup error $username:$pline:$emsg"
+       reporterr "setup error $username:$lno:$emsg"
+       return ""
+    } else {
+       return "reloaded $username"
+    }
+}
+
+proc check_monname {m} {
+    if {[regexp {[^-_+:.#0-9a-zA-Z]} $m badchar]} {
+       error "char $badchar not allowed in monnames"
+    }
+    if {![regexp {^[0-9a-zA-Z]} $m]} {
+       error "monname must start with alphanum"

     }
 }
 
 proc_dset start {} {
     catch { unset dd(retry) }
     }
 }
 
 proc_dset start {} {
     catch { unset dd(retry) }

+    set username $dd(username)

     if {[catch {
     if {[catch {

-       set fchan [open [list | \
-               remoteleds 2>&1 --pipe $g \
-               --passfile-only pwdb/p$username \
-               |& cat \
-               ]]
+       set cmdl [list remoteleds --pipe $dd(group) \
+                      --passfile-only pwdb/p$username]
+       timed_log "!-$d [join $cmdl " "]"
+       set fchan [open |[concat $cmdl {|& cat}] r+]

        fconfigure $fchan -blocking 0
        fileevent $fchan readable [list dset_rledout $d]
        set dd(fchan) $fchan
        fconfigure $fchan -blocking 0
        fileevent $fchan readable [list dset_rledout $d]
        set dd(fchan) $fchan


@@ -252,17 +301,21 @@ proc_dset start {} {
 }
 
 proc_dset rledout {} {
 }
 
 proc_dset rledout {} {

-    global errchan retry_after
+    global errchan

     while {[gets $dd(fchan) l] != -1} { reporterr "remoteleds on $d: $l" }
     if {[fblocked $dd(fchan)]} return
     while {[gets $dd(fchan) l] != -1} { reporterr "remoteleds on $d: $l" }
     if {[fblocked $dd(fchan)]} return

-    catch { close $dd(fchan) }
+    catch {
+       timed_log ">\$$d failure";
+       close $dd(fchan)
+    }

     unset dd(fchan)
     reporterr "remoteleds on $d died"
     dset_trylater $d
 }
 
 proc_dset trylater {} {
     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]]
+    global retry_after
+    set dd(retry) [after $retry_after [list dset_start $d]]

 }
 
 proc config_change {} {
 }
 
 proc config_change {} {


@@ -274,8 +327,8 @@ proc config_change {} {
        }
        set onchans($ch) mustleave
     }
        }
        set onchans($ch) mustleave
     }

-    set ch($errchan) forced

     sendout JOIN $errchan
     sendout JOIN $errchan

+    chan_shortly $errchan

     foreach m [list_objs monitor] {
        upvar #0 monitor/$m mm
        foreach ch $mm(chans) {
     foreach m [list_objs monitor] {
        upvar #0 monitor/$m mm
        foreach ch $mm(chans) {


@@ -294,8 +347,10 @@ proc config_change {} {
 proc chan_shortly {ch} {
     global chan_after
     upvar #0 onchans($ch) oc
 proc chan_shortly {ch} {
     global chan_after
     upvar #0 onchans($ch) oc

-    manyset $oc status after
-    if {"$status" != "idle"} return
+    if {[info exists oc]} {
+       manyset $oc status after
+       if {"$status" == "shortly"} return
+    }

     set oc [list shortly [after $chan_after chan_sendnames $ch]]
 }
 
     set oc [list shortly [after $chan_after chan_sendnames $ch]]
 }
 


@@ -305,18 +360,31 @@ proc chan_sendnames {ch} {
     set oc idle
 }
 
     set oc idle
 }
 

-def_ucmd reload {} {
+def_ucmd reload {

     set username [ta_word]
     ta_nomore
     set username [ta_word]
     ta_nomore

-    reloaduser $username
+    set m [reloaduser $username]

     config_change
     config_change

+    ucmdr {} $m

 }
 
 }
 

-proc connected {
+def_ucmd who {
+    set r {}
+    foreach m [list_objs monitor] {
+       upvar #0 monitor/$m mm
+       lappend r "monitoring $mm(chans) for $m"
+    }
+    foreach d [list_objs deviceset] {
+       upvar #0 deviceset/$d dd
+       regexp {^[^:]*\:[^:]*} $dd(group) dest
+       lappend r "sending $dd(monname) to $dest"
+    }
+}
+
+proc connected {} {

     foreach f [glob -nocomplain pwdb/p*] {
        regexp {^pwdb/p(.*)$} $f dummy username
     foreach f [glob -nocomplain pwdb/p*] {
        regexp {^pwdb/p(.*)$} $f dummy username

-       check_username $username
-       reloaduser $username
+       set m [reloaduser $username]

     }
     config_change
 }
     }
     config_change
 }


@@ -325,3 +393,10 @@ proc connected {
 # 353
 # JOIN PART
 # KICK KILL QUIT
 # 353
 # JOIN PART
 # KICK KILL QUIT

+
+if {[catch {
+    loadhelp
+    ensure_connecting
+} emsg]} {
+    fail "startup: $emsg"
+}

diff --git a/userv.tcl b/userv.tcl
new file mode 100644 (file)
index 0000000..bbb0204
--- /dev/null
+++ b/userv.tcl
@@ -0,0 +1,8 @@
+
+proc check_username {target} {
+    if {
+       [string length $target] > 8 ||
+        [regexp {[^-0-9a-z]} $target] ||
+        ![regexp {^[a-z]} $target]
+    } { error "invalid username" }
+}