From: ian <ian>
Date: Tue, 27 May 2008 19:34:03 +0000 (+0000)
Subject: Better default selections; better replay support; report binding to stdout
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=44ebe3b4195e94b825a2aba7963e1dbdabf25875;p=trains.git

Better default selections; better replay support; report binding to stdout
---

diff --git a/hostside/README.commands b/hostside/README.commands
index b4c23e1..36309ef 100644
--- a/hostside/README.commands
+++ b/hostside/README.commands
@@ -139,7 +139,10 @@ MULTIPLEXER FACILITIES
         ?                matches any single character
     <pattern>_ is matched against <message><spc>
     if no match, it is as if the following patterns were appended
-       ?info ?warning ~-* ~&* ~+debug *
+       ~-* ~&* ~+debug *
+    default, on initial connection, is
+       ?info ?warning
+    (plus the above)
 
  L> replay [[~]<glob-pattern>...]     if none, uses result from select
  O< +executing replay
@@ -147,6 +150,9 @@ MULTIPLEXER FACILITIES
       matching the patterns, all of which will be prefixed with + this time>
  O< +ack replay ok
 
+ L> select-replay [~]<glob-pattern>...
+      like select and replay combined
+
 
 MULTIPLEXER-IMPLEMENTED FUNCTIONALITY AFFECTING WHOLE SYSTEM
 
diff --git a/hostside/multiplex b/hostside/multiplex
index cca1a2c..f3f86ef 100755
--- a/hostside/multiplex
+++ b/hostside/multiplex
@@ -63,7 +63,6 @@ proc compile-glob-patterns {pats procname} {
 	append pat {\s}
 	append def "    [list ^$pat " return [expr {!$neg}] "]\n"
     }
-    append def {    {^.(?:info|warning)\s} { return 1 }} "\n"
     append def {    {^[-&]\S|^\+debug\s} { return 0 }} "\n"
     append def "    }\n"
     append def "    return 1\n"
@@ -168,22 +167,32 @@ proc global/!save-dump {conn args} {
     }
 }
 
+proc do-replay {conn} {
+    foreach pk [lsort [array names replay]] {
+	set m "+[string range $pk 3 end] $replay($pk)"
+	xmit-only $conn $m
+    }
+}
+
 proc local/replay {conn args} {
     global replay
     if {[llength $args]} {
 	rename msel/$conn mreplay/$conn ;# park it here for a moment
 	compile-glob-patterns $args msel/$conn
     }
-    foreach pk [lsort [array names replay]] {
-	set m "+[string range $pk 3 end] $replay($pk)"
-	xmit-only $conn $m
-    }
+    do-replay $conn
     if {[llength $args]} {
 	rename msel/$conn {}
 	rename mreplay/$conn msel/$conn
     }
 }
 
+proc local/select-replay {conn args} {
+    upvar #0 c/$conn c
+    compile-glob-patterns $args msel/$conn
+    do-replay $conn
+}
+
 proc global/!realtime {conn args} {
     nargs $args 1
     switch -exact [lindex $args 0] {
@@ -594,7 +603,7 @@ proc connected {conn} {
 	super { set c(super) 1 }
 	default { error "$perm ?" }
     }
-    compile-glob-patterns {} msel/$conn
+    compile-glob-patterns {?info ?warning} msel/$conn
     
     xmit-only-always $conn =connected
     xmit-only-always $conn "=permission [lindex {normal super} $c(super)]"
@@ -610,9 +619,9 @@ proc newconn {conn ipaddr port} {
 }
 
 proc try-bind {addr} {
-    global master errorInfo errorCode
+    global master errorInfo errorCode port
     if {![catch {
-	set master [socket -server newconn -myaddr $addr 2883]
+	set master [socket -server newconn -myaddr $addr $port]
     } emsg]} { return 1 }
     if {[string match {POSIX EADDRNOTAVAIL *} $errorCode]} { return 0 }
     error $emsg $errorInfo $errorCode
@@ -631,9 +640,10 @@ proc ipaddr2hex {addr} {
 }
 
 proc binding {addr blist} {
-    global master permissions
+    global master permissions port
     if {[info exists master]} return
     if {![try-bind $addr]} return
+    puts "bound to $addr,$port"
     set permissions {}
     foreach {keyword pattern} $blist {
 	switch -exact $keyword allow - super - deny { } \
@@ -652,8 +662,9 @@ proc binding {addr blist} {
 }
 
 proc startup {} {
-    global queueing executing argv me realtime
+    global queueing executing argv me realtime port
     catch { close $master }; catch { unset master }
+    set port 2883
     uplevel #0 source multiplex-config
     set queueing {}
     set executing 0