saving dumps

diff --git a/hostside/README.commands b/hostside/README.commands
index 7580a79fbdc004533d443eb178d9bc1b11a7699b..270401ecb740d252354ed655d1c55843fe9f85c5 100644 (file)
--- a/hostside/README.commands
+++ b/hostside/README.commands
@@ -59,9 +59,12 @@ POSSIBLY-ASYNCHRONOUS REPORTING OF MESSAGES TO/FROM (MASTER) PIC
  U< ?warning <type>[ <arguments>] :  <warning message>
  U< ?warning watchdog : PIC watchdog timer triggered
  U< ?warning spurious <count> : spurious short circuit (fault) etc.
- U< ?warning realtime-stopped SIG*|exit*|E*|... : <explanation>
- U< ?warning realtime-stderr : <emsg>
- U< ?warning realtime-stderr-unavailable : <emsg>
+
+ U< ?warning realtime-failed reason SIG*|exit*|E*|... : <explanation>
+ U< ?warning realtime-failed stderr : <emsg>
+ U< ?warning realtime-failed stderr-unreadable : <emsg>
+ U< ?warning save-dump-failed [<filename> [<errno>]] : <emsg>
+ U< ?info save-dump <dumpdir>
 
  U< ?train <train> signalling-problem ....
  U< ?train <train> signalling-problem <problematic-segment> : <message>
@@ -151,7 +154,7 @@ MULTIPLEXER-IMPLEMENTED FUNCTIONALITY AFFECTING WHOLE SYSTEM
  O< ?nak|executing...ack...  as above
 
  C> !realtime kill|start|start-manual
- C> !dump
+ C> !save-dump
 
 
 ======================================================================

diff --git a/hostside/multiplex b/hostside/multiplex
index f0964a1168ac006707b2e1e6c74e499d844c8106..b7326debf7f7331fbd6216c6f035efc711b3e433 100755 (executable)
--- a/hostside/multiplex
+++ b/hostside/multiplex
@@ -33,6 +33,9 @@
 #
 # replay priorities and messages:
 #    10 stastate
+#    40 warning realtime-failed
+#    41 warning save-dump-failed
+#    42 info save-dump
 #    50 resolution ....
 #    60 movpos ...
 #       train ...
@@ -69,6 +72,8 @@ proc nargs {l {n 0}} {
     if {[llength $l]!=$n} { cmderr BadCmd "wrong number of arguments" }
 }
 
+proc cmderr {ecode emsg} { error $emsg "" [list TRAIN CMDERR $ecode] }
+
 proc xmit-relevantly {m} {
     global executing currentconn conns
     if {$executing} {
@@ -88,6 +93,65 @@ proc xmit-relevantly {m} {
     }
 }
 
+proc xmit-relevantly-savereplay {pri key rhs} {
+    set pk "$pri $key"
+    upvar #0 replay($pk) rep
+    append rep $rhs
+    xmit-relevantly "$key $rhs"
+}
+
+proc savereplay-clear {pk} {
+    upvar #0 replay($pk) rep; catch { unset rep }
+}
+
+proc save-dump-failed-warn {fpre howpre emsg} {
+    global errorCode
+    switch -glob $errorCode {
+       {POSIX *} {
+           set k [lindex $errorCode 1]
+           set m [lindex $errorCode 2]
+           xmit-relevantly-savereplay 41 \
+                   "warning save-dump-failed" "$fpre$k : $howpre$m"
+       }
+       * {
+           xmit-relevantly-savereplay 41 \
+                   "warning save-dump-failed" "$fpre: $emsg"
+       }
+    }
+}
+
+proc save-dump {} {
+    global errorCode
+    
+    savereplay-clear "41 warning save-dump-failed"
+    savereplay-clear "42 info save-dump"
+    
+    set now [clock seconds]
+    set now [clock format $now -format %Y-%m-%dT%H-%M-%S%z]
+    set dumpdir +dump.$now
+
+    if {[catch {
+       file mkdir $dumpdir
+    } emsg]} {
+       save-dump-failed-warn "" "mkdir $dumpdir: " $emsg
+       error $emsg "" {TRAIN REPORTED}
+    }
+
+    foreach f {
+       +realtime.log
+       +persist.data +persist.data.new +persist.data.old
+       +persist.conv +persist.conv.new +persist.conv.old
+    } {
+       if {[catch { link $f $dumpdir/$f } emsg]} {
+           switch -glob $errorCode {
+               {POSIX ENOENT *} { }
+               * { save-dump-failed-warn "$f " "link $f $dumpdir/: " $emsg }
+           }
+       }
+    }
+    xmit-relevantly-savereplay 42 "info save-dump" "$dumpdir"
+}
+
 #---------- multiplexer-implemented command ----------
 
 proc local/select {conn args} {
@@ -95,7 +159,7 @@ proc local/select {conn args} {
     compile-glob-patterns $args msel/$conn
 }
 
-proc global/!dump {conn args} {
+proc global/!save-dump {conn args} {
     nargs $args
     if {[catch { save-dump } emsg]} {
        cmderr HostSupportSystemsProblem "failed to save dump: $emsg"
@@ -234,6 +298,9 @@ proc process-command {conn l} {
        {TRAIN CMDERR*} {
            set el [concat [list +ack $cmd] [lrange $errorCode 2 end]]
            xmit-only $conn "$el : $emsg"
+           set executing 0
+           catch { unset currentconn }
+           catch { unset currentcmd }
        }
        * {
            set ei $errorInfo; set ec $errorCode
@@ -342,7 +409,7 @@ proc trapping {proc conn args} {
 
 proc realtime-failed {k m} {
     global realtime currentcmd currentconn executing
-    global errorInfo errorCode
+    global errorInfo errorCode replay
     # if $m is "", use wait status
     if {![string length $m]} {
        set r [catch {
@@ -370,22 +437,21 @@ proc realtime-failed {k m} {
     if {[catch {
        set sef [open +realtime.stderr r]
        while {[gets $sef l] >= 0} {
-           xmit-relevantly "warning realtime-stderr : $l"
+           xmit-relevantly-savereplay 40 \
+                   "warning realtime-failed" "stderr : $l"
        }
        close $sef
        unset sef
     } emsg]} {
        if {![string match {POSIX ENOENT *} $errorCode]} {
-           xmit-relevantly "warning realtime-stderr-unreadable : $emsg"
+           xmit-relevantly-savereplay 40 \
+                   "warning realtime-failed" "stderr-unreadable : $emsg"
        }
        catch { close $sef }
     }
-    xmit-relevantly "warning realtime-stopped $k : $m"
-    if {[catch {
-       save-dump
-    } emsg]} {
-       xmit-relevantly "warning dump-failed : $emsg"
-    }
+    xmit-relevantly-savereplay 40 \
+           "warning realtime-failed" "reason $k : $m"
+    catch { save-dump }
     if {$executing} {
        xmit-relevantly "ack $currentcmd SystemFailed realtime : $m"
        set executing 0
@@ -398,7 +464,7 @@ proc realtime-failed {k m} {
 }
 
 proc realtime-notrunning-init {} {
-    realtime-inputline dummy "stastate -" ;# fake this up
+    xmit-relevantly-savereplay 10 stastate -
 }
 
 proc realtime-start {xopts} {
@@ -409,6 +475,7 @@ proc realtime-start {xopts} {
     set cl [concat \
            [list 2> +realtime.stderr ./realtime -v2] \
            $xopts $records]
+    savereplay-clear "40 warning realtime-failed"
     if {[catch {
        set realtime [open |$cl r+]
        fconfigure $realtime -translation binary -buffering line -blocking 0