U< ?resolving <some message about resolution algorithm>
- U< ?resolution inexplicable <segment>
- U< ?resolution mispositioned head|tail <train> <crush-ending-seg> <distance>
-
U< ?resolution movpos-change-failed <segment>/<poscombname>
- U< ?resolution problems <number-of-problems>
+ S< ?resolution inexplicable <segment>
+ S< ?resolution mispositioned head|tail <train> <crush-ending-seg> <distance>
+
S< ?resolution movpos-change-failed <segment>/<poscombname>
+ S< ?resolution problems <number-of-problems>
- U< ?stastate <state>
+ S< ?stastate <state>
U< ?warning <type>[ <arguments>] : <warning message>
U< ?warning watchdog : PIC watchdog timer triggered
U< ?train <train> signalling-problem ....
U< ?train <train> signalling-problem <problematic-segment> : <message>
- U< ?train <train> forwards|backwards at [-]<segment>:<maxinto>+-<uncertainty>
- U< ?train <train> has <markchar>[-]<segment>[/<movposcomb>]....
+ S< ?train <train> forwards|backwards at [-]<segment>:<maxinto>+-<uncertainty>
+ S< ?train <train> has <markchar>[-]<segment>[/<movposcomb>]....
<markchar> is * for det_expected
! for foredetect
@ for det_ignore
-
U< ?movpos <segment> feat <feat><posn> point|relay
- U< ?movpos <segment> position <overallposn> moving
- U< ?movpos <segment> position <overallposn> stable
+
S< ?movpos <segment> feat <feat><posn> point|relay
+ S< ?movpos <segment> position <overallposn> moving
+ S< ?movpos <segment> position <overallposn> stable
<overallposn> may be ? for unknown
U< ?debug <context> : <debug message>
MESSAGES TO SIMULATION LOG
- S picioh in suppressed <byte> [<byte>...]
-
S command-in <command> <args>....
- S timestamp <seconds>.<microseconds>
- S timer-event <class>.<instance>
+ L picioh in suppressed <byte> [<byte>...]
+
L command-in <command> <args>....
+ L timestamp <seconds>.<microseconds>
+ L timer-event <class>.<instance>
======================================================================
<ack> inclusive, is prefixed with `-' if they are not due to
this client or `+' if they are.
- Some commands have ! at the end of their name
+ Some commands have ! at the start of their name
- that means they are privileged.
======================================================================
MULTIPLEXER FACILITIES
- M< = indicates messages to and from the multiplexer about this
+ M< = indicates messages from the multiplexer about this
M> = specific client connection
M< =connected
M< =failing : <message>
otherwise there is no need to quit - just send eof
- M< =select [~]<glob-pattern>...
+ M< select [~]<glob-pattern>...
first match wins; ~ discards the message; if nothing matches,
all are selected; patterns are matched against message with
_ replacing spaces and added to the end; patterns which contain
is limited for safety and if it is too long it is truncated.
M> =select
- M< =replay [~]<glob-pattern>...
-
-broadcast messages start with %
-
- C> $replay% <selector>[!]
-
- M< %<selector>[!] <stuff>... <stuff> depends on <selector>
- <selector> must be [a-z][-0-9a-z]*
- M> %<selector>[!] <stuff>... echoed to all clients
+ M< replay [~]<glob-pattern>...
+ M> <all saved messages, ie those marked with S< above>
+ M> =replay
MULTIPLEXER-IMPLEMENTED FUNCTIONALITY AFFECTING WHOLE SYSTEM
- P>
$<command>[!] <args>...
- R< ?executing $<command>[!]
- R< ?ack $<command>[!] ok
+ P>
[!]<command> <args>...
+ R< ?executing [!]<command>
+ R< ?ack [!]<command> ok
- C> $realtime! kill|finish|start|start-manual
- C> $save!
+ C> !realtime kill|finish|start|start-manual
+ C> !save
- C> $reserve
======================================================================
--- /dev/null
+#!/usr/bin/tclsh8.4
+
+proc find-permission {ipaddr} {
+ global permissions
+ set ipaddr [ipaddr2hex $ipaddr]
+ foreach keyword paddr pmask {
+ if {[expr {($ipaddr & $pmask) == $paddr}]} { return $keyword }
+ }
+ return deny
+}
+
+proc connected {conn} {
+ upvar #0 c/$conn c
+ fconfigure $conn -blocking 0 -buffering none -translation auto
+ set perm [find-permission $c(ipaddr)]
+ switch -exact $perm {
+ deny { finally $conn =denied; return }
+ allow { set c(super) 0 }
+ 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]
+}
+
+proc trapping {proc conn args} {
+ if {[catch {
+ eval $proc
+
+proc newconn {conn ipaddr port} {
+ upvar #0 c/$conn c
+ catch { unset c }
+ set c(ipaddr) $ipaddr
+ trapping connected $conn
+}
+
+proc try-bind {$addr} {
+ global master errorInfo errorCode
+ if {![catch {
+ set master [socket -server newconn -myaddr $addr 2883]
+ } emsg]} { return 1 }
+ if {[string match {POSIX EADDRNOTAVAIL *} $errorCode]} { return 0 }
+ error $emsg $errorInfo $errorCode
+}
+
+proc ipaddr2hex {addr} {
+ if {![regexp {^\d+\.\d+\.\d+\.\d+$} $addr]} {
+ error "invalid ip address $addr"
+ }
+ set val 0x
+ foreach octet [split $addr .] { append val [format %02x $octet] }
+ if {[string length $val != 10]} {
+ error "invalid numbers in ip address $addr (calculated $val ?!)"
+ }
+ return $val
+}
+
+proc binding {address blist} {
+ global master permissions
+ if {[info exists master]} return
+ if {![try-bind $address]} return
+ set permissions {}
+ foreach {keyword pattern} $blist {
+ switch -exact $keyword allow - super - deny { } \
+ default { error "unknown binding keyword $keyword" }
+ if {![regexp {^(.*)/(\d+)$} $pattern dummy host masklen]} {
+ set host $pattern; set masklen 32
+ }
+ set ipaddr [ipaddr2hex $host]
+ set mask [expr {$masklen==0 ? 0 : 0xffffffff << (32-$masklen)}]
+ if {$ipaddr & $mask} { error "non-zero bits outside mask in $pattern" }
+ lappend permissions $keyword $ipaddr $mask
+ }
+}
+
+proc readconfig {} {
+ catch { close $master }; catch { unset master }
+ source multiplex-config
+}
~ijackson / trains.git / commitdiff