chiark / gitweb /
get crlf right; allow % in patterns; permit --me mode to execute tcl
authorian <ian>
Tue, 27 May 2008 20:55:22 +0000 (20:55 +0000)
committerian <ian>
Tue, 27 May 2008 20:55:22 +0000 (20:55 +0000)
hostside/README.commands
hostside/multiplex

index 36309ef9d5d905a6b2325a2601a88bd4f977b808..afa30aa31a114c2e3747da13e19b39c1b873830d 100644 (file)
@@ -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
index f3f86ef7d57ac2cccaf97b8621a3da9cf850f716..cd04917abe8711ec9cbd8fc49828ff7069920b8e 100755 (executable)
@@ -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)]