# $master socket
# $permissions [list allow|super|deny $ipaddrhex $maskhex ...]
# $realtime pipes
+# $realtime_retry [list $serialchan $timeoutid $awaitedpongmsg|{} $buf]
# $replay("$pri $key") $rhs $pri is \d\d; causes replay of "$key $rhs"
# $detect0($seg) unset -> 1 or irrelevant; [after ...]
# $conns($conn) 1
# $currentconn unset $conn or {} $conn or {} $conn unset
# $executing 0 0 1 1 0
#
+# globals relating to realtime start/stop:
+# manual ready to running awaiting off
+# $realtime any unset set unset
+# $realtime_retry unset {} {} [list ...]
+#
# replay priorities and messages:
# 10 stastate
# 40 warning realtime-failed
proc xmit-relevantly-savereplay {pri key rhs} {
set pk "$pri $key"
upvar #0 replay($pk) rep
- append rep $rhs
+ set rep $rhs
xmit-relevantly "$key $rhs"
}
do-replay $conn
}
+#---------- automatic realtime restart ----------
+
proc global/!realtime {conn args} {
+ global realtime realtime_retry
nargs $args 1
- switch -exact [lindex $args 0] {
- kill { realtime-failed killed "termination requested by command" }
- start { realtime-start {} }
- start-manual { realtime-start -m }
- default { cmderr BadCmd "unknown !realtime subcommand" }
+ set how [lindex $args 0]
+
+ # perhaps kill the running instance
+ # this switch also checks the argument
+ switch -exact -- $how {
+ kill - stop - restart - start - start-manual {
+ if {[info exists realtime]} {
+ realtime-failed killed "termination requested by command"
+ }
+ }
+ auto {
+ }
+ default {
+ cmderr BadCmd "unknown !realtime subcommand"
+ }
}
+
+ # set the operating mode
+ switch -exact -- $how {
+ auto {
+ realtime-retry-reset
+ set realtime_retry {}
+ }
+ stop - start - start-manual {
+ realtime-retry-reset
+ catch { unset realtime_retry }
+ }
+ }
+
+ # (re)start if applicable
+ switch -exact -- $how {
+ start - restart {
+ realtime-start {}
+ }
+ start-manual {
+ realtime-start -m
+ }
+ default {
+ after idle realtime-retry-check
+ }
+ }
+}
+
+proc realtime-retry-reset {} {
+ global realtime_retry
+ if {![info exists realtime_retry]} return
+ if {![llength $realtime_retry]} return
+ manyset $realtime_retry serchan timeoutid
+ catch { close $serchan }
+ after cancel $timeoutid
+ set realtime_retry {}
+}
+
+proc realtime-retry-check {} {
+ global realtime_retry
+ if {![info exists realtime_retry]} return
+ if {[llength $realtime_retry]} return
+ if {[info exists realtime]} return
+ realtime-start {}
+}
+
+proc realtime-retry-realtime-failed {} {
+ global realtime_retry dev_railway
+ if {![info exists realtime_retry]} return
+ if {[llength $realtime_retry]} { error "huh? $realtime_retry" }
+ set serchan [open $dev_railway r+]
+ fconfigure $serchan -translation binary -buffering none -blocking 0
+ fileevent $serchan readable realtime-retry-serchan-readable
+ set realtime_retry [list $serchan x {} {}]
+ realtime-retry-send-ping
+}
+
+proc realtime-retry-send-ping {} {
+ global realtime_retry urandom
+ manyset $realtime_retry serchan after pong buf
+ set x [read $urandom 2]
+ binary scan $x H* x
+ if {[string length $x] != 4} { error "urandom short read `$x'" }
+ set x [expr "0x$x & 0x077f"]
+ set ping [format %04x [expr {0x8800 ^ $x}]]
+ set pong [format %04x [expr {0x885a ^ $x}]]
+ puts "<! picioh out await-off $pong (await $pong)"
+ puts -nonewline $serchan [binary format H* $ping]
+ set after [after 700 realtime-retry-now-off]
+ set realtime_retry [list $serchan $after $pong {}]
+}
+
+proc realtime-retry-serchan-readable {} {
+ global realtime_retry
+ manyset $realtime_retry serchan after pong buf
+ set x [read $serchan]
+ binary scan $x H* x
+ puts "<! picioh in await-off $x"
+ if {![string length $x] && [eof $serchan]} { error "eof on serial port" }
+ append buf $x
+ while {[regexp {^((?:[89a-f].)*[0-7].)(.*)$} $buf dummy msg buf]} {
+ if {![string compare 09 $msg]} {
+ realtime-retry-now-off
+ return
+ }
+ if {![string compare $pong $msg]} {
+ after cancel $after
+ set after [after 200 realtime-retry-send-ping]
+ set realtime_retry [list $serchan $after {} {}]
+ return
+ }
+ }
+ set realtime_retry [list $serchan $after $pong $buf]
+}
+
+proc realtime-retry-now-off {} {
+ realtime-retry-reset
+ realtime-retry-check
}
#---------- connection and commands ----------
set sef [open +realtime.stderr r]
while {[gets $sef l] >= 0} {
xmit-relevantly-savereplay 40 \
- "warning realtime-failed" "stderr : $l"
+ "warning realtime-failed stderr" ": $l"
}
close $sef
unset sef
} emsg]} {
if {![string match {POSIX ENOENT *} $errorCode]} {
xmit-relevantly-savereplay 40 \
- "warning realtime-failed" "stderr-unreadable : $emsg"
+ "warning realtime-failed stderr" "unreadable : $emsg"
}
catch { close $sef }
}
unset currentcmd
unset currentconn
}
- realtime-notrunning-init
+ realtime-notrunning
+ realtime-retry-realtime-failed
}
-proc realtime-notrunning-init {} {
- xmit-relevantly-savereplay 10 stastate -
+proc realtime-notrunning {} {
+ xmit-relevantly-savereplay 10 stastate Crashed
}
proc realtime-start {xopts} {
- global realtime records
- if {[info exists realtime]} {
- cmderr InvalidState "realtime already running"
- }
+ global realtime records realtime_xopts dev_railway
+ if {[info exists realtime]} { error "realtime already running" }
+ realtime-retry-reset
set cl [concat \
- [list 2> +realtime.stderr ./realtime -v2] \
- $xopts $records]
- savereplay-clear "40 warning realtime-failed"
+ [list 2> +realtime.stderr ./realtime -v2 -s$dev_railway] \
+ $realtime_xopts $xopts $records]
+ puts "<> $cl"
+ savereplay-clear-re "40 warning realtime-failed"
if {[catch {
set realtime [open |$cl r+]
fconfigure $realtime -translation binary -buffering line -blocking 0
}
proc startup {} {
- global queueing executing testmode realtime port realtime_xopts
+ global queueing executing testmode realtime port urandom
catch { close $master }; catch { unset master }
setting testmode 0 {[01]}
uplevel #0 source multiplex-config
set queueing {}
set executing 0
- realtime-notrunning-init
+ set urandom [open /dev/urandom r]
+ fconfigure $urandom -buffering none -translation binary
+ realtime-notrunning
if {!$testmode} {
start_commandloop
- realtime-start $realtime_xopts
+ after idle realtime-retry-check
} else {
fconfig-trainproto stdin
fconfig-trainproto stdout
~ijackson / trains.git / commitdiff