From: ian <ian>
Date: Tue, 27 May 2008 20:55:22 +0000 (+0000)
Subject: get crlf right; allow % in patterns; permit --me mode to execute tcl
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=c6d3f2562d38f16dbd3c2964dbdfc7584ac2b24e;p=trains.git

get crlf right; allow % in patterns; permit --me mode to execute tcl
---

diff --git a/hostside/README.commands b/hostside/README.commands
index 36309ef..afa30aa 100644
--- a/hostside/README.commands
+++ b/hostside/README.commands
@@ -133,7 +133,7 @@ MULTIPLEXER FACILITIES
  L> select [~]<pattern>...
     first match wins; ~ discards the message.
     in pattern
-        -+./:0-9a-zA-Z   match themselves
+        -+./:=0-9a-zA-Z  match themselves
         _                matches nonempty sequence of whitespace
 	*                matches any non-whitespace
         ?                matches any single character
diff --git a/hostside/multiplex b/hostside/multiplex
index f3f86ef..cd04917 100755
--- a/hostside/multiplex
+++ b/hostside/multiplex
@@ -53,10 +53,10 @@ proc compile-glob-patterns {pats procname} {
     append def "    switch -regexp -- \$m {\n"
     foreach pat $pats {
 	set neg [regsub {^~} $pat {} pat]
-	if {[regexp {[^-+./:0-9a-zA-Z_*?]} $pat]} {
+	if {[regexp {[^-+./:=0-9a-zA-Z_*?]} $pat]} {
 	    cmderr BadCmd "pattern contains invalid character"
 	}
-	regsub -all {[-+./:]} $pat {\\&} pat
+	regsub -all {[-+./:=]} $pat {\\&} pat
 	regsub -all {_} $pat {\s+} pat
 	regsub -all {\*} $pat {\S+} pat
 	regsub -all {\?} $pat {.} pat
@@ -168,6 +168,7 @@ proc global/!save-dump {conn args} {
 }
 
 proc do-replay {conn} {
+    global replay
     foreach pk [lsort [array names replay]] {
 	set m "+[string range $pk 3 end] $replay($pk)"
 	xmit-only $conn $m
@@ -175,7 +176,6 @@ proc do-replay {conn} {
 }
 
 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
@@ -518,9 +518,15 @@ proc clear-replay-detects {} {
 }
 
 proc realtime-inputline {dummy l} {
-    global detectlag replay
+    global detectlag replay me
     global executing currentcmd currentconn
 
+    if {$me && [regexp {^%(.*)} $l dummy rhs]} {
+	set r [catch { uplevel #0 $rhs } emsg]
+	if {$r} { puts "** $emsg\n" } else { puts "=> $emsg\n" }
+	return
+    }
+
     puts "<< $l"
 
     if {[regexp {^(detect (\w+)) ([01])$} $l dummy key seg value]} {
@@ -593,7 +599,7 @@ proc find-permission {ipaddr} {
 proc connected {conn} {
     global conns
     upvar #0 c/$conn c
-    fconfigure $conn -blocking 0 -buffering none -translation auto
+    fconfigure $conn -blocking 0 -buffering none -translation {auto lf}
     set c(q) {}
     set conns($conn) 1
     set perm [find-permission $c(ipaddr)]