multiplex wip

diff --git a/hostside/multiplex b/hostside/multiplex
index 5c75b85306a1d0dd7366424891f2ce1431c265aa..fb45a14a56b6311655d51482e4ee5d912f1579d4 100755 (executable)
--- a/hostside/multiplex
+++ b/hostside/multiplex
@@ -1,4 +1,120 @@
-#!/usr/bin/tclsh8.4
+x#!/usr/bin/tclsh8.4
+
+#---------- i/o to realtime ----------
+
+proc cmdqueue-check {args} { }
+
+proc compile-glob-patterns {pats procname} {
+    foreach pat $pats {
+       if {[catch { string match $pat "" } emsg]} {
+           
+
+proc cmd/select {args} {
+    upvar #0 c/$conn c
+    check-glob-patterns $args
+    set c(selected) $args
+}
+
+#---------- connection and commands ----------
+
+proc client-inputline {conn l} {
+    global errorInfo errorCode
+    global cmdqueue
+    upvar #0 c/$conn c
+    set cmd ?
+    set r [catch {
+       if {[regexp {^#}] $l} return; # comments ?!  ok then ...
+       set l [string trim $l]
+       if {![string length $l]} return
+       if {![regexp {^((!?)[-a-z0-9]+)(?:\s.*)?$} $l dummy cmd priv]} {
+           error "improper command name" {} {TRAIN CMDNAK invalid-syntax}
+       }
+       if {[regexp {[^ \t!-~]} $l]} {
+           error "improper character" {} {TRAIN CMDNAK invalid-syntax}
+       }
+       if {[string length $priv && !$c(super)]} {
+           error "" {} {TRAIN CMDNAK permission-denied}
+       }
+       if {![catch { info args cmd/$cmd }]} {
+           xmit $conn "+executing $cmd\n"
+           eval [list cmd/$cmd $conn] [split $l]
+       } else {
+           lappend cmdqueue $conn $l
+           after idle cmdqueue-check
+       }
+    } emsg]
+    if {$r==0 || $r==2} return
+    switch -glob $errorCode {
+       {TRAIN CMDNAK*} {
+           set el [concat [list +nack] [lrange $errorCode 2 end]]
+           if {[string length $emsg]} { append el ": " $emsg }
+           xmit $conn "$el\n"
+       }
+       {TRAIN CMDERR*} {
+           set el [concat [list +ack $cmd] [lrange $errorCode 2 end]]
+           xmit $conn "$el : $emsg\n"
+       }
+       * {
+           error $emsg $errorInfo $errorCode
+       }
+    }
+}
+
+proc client-eof {conn} { kill-conn $conn "" }
+
+#---------- general IO ----------
+
+proc readable {$conn whatfor} {
+    while {[gets $conn l]>=0} { $whatfor-inputline $conn $l }
+    if {[eof $conn]} { $whatfor-eof $conn }
+}
+
+proc xmit {conn msg} { puts -nonewline $conn $msg }
+
+#---------- error handling ----------
+
+proc kill-conn {conn msg} {
+    upvar #0 c/$conn c
+    global cmdqueue
+    if {[string length $msg]} { catch { client-out $conn $msg } }
+    catch { close $conn }
+    catch { unset c }
+    set qn {}
+    foreach tconn tl $cmdqueue {
+       if {[string compare $tconn $tl]} { lappend qn $tconn $tl }
+    }
+    set cmdqueue $qn
+    fixme delete compiled glob patterns proc
+}
+
+proc report-unexpected {headmsg emsg} {
+    puts stderr \
+"========== $headmsg ==========\n\
+$r\n\
+$errorInfo\n\
+$errorCode\n"
+}
+
+proc bgerror {emsg} {
+    global errorInfo errorCode
+    catch { report-unexpected {UNEXPECTED UNTRAPPED ERROR} $emsg }
+    exit 127
+}
+
+proc trapping {proc conn args} {
+    global errorInfo errorCode
+    if {![catch { eval #0 [list $proc $conn] $args } r]} { return $r }
+    switch -glob $errorCode {
+       {TRAIN EXPECTED*} { kill-conn $conn "=failed : $r\n" }
+       {TRAIN SILENT*} { kill-conn $conn }
+       * {
+           report-unexpected {UNEXPECTED ERROR} $r
+            kill-conn $conn "=failed : Internal error\n"
+       }
+    }
+}      
+
+#---------- new connections ----------
 
 proc find-permission {ipaddr} {
     global permissions
@@ -19,15 +135,14 @@ proc connected {conn} {
        super { set c(super) 1 }
        default { error "$perm ?" }
     }
-    xmit $conn =connected
-    xmit $conn =permission [lindex {normal super} $c(super)]
-    fileevent $conn readable [list trapping readable $conn]
+    set c(selected) {}   fixme make compiled globs
+    fixme list of things per conn
+    
+    xmit-always $conn =connected
+    xmit-always $conn =permission [lindex {normal super} $c(super)]
+    fileevent $conn readable [list trapping readable $conn client]
 }
 
-proc trapping {proc conn args} {
-    if {[catch {
-       eval $proc 
-
 proc newconn {conn ipaddr port} {
     upvar #0 c/$conn c
     catch { unset c }