#!/usr/bin/tcl

# per connection:
#    c/$conn(super)          0 or 1
#    c/$conn(ipaddr)
#    [msel/$conn "$msg "]    0 or 1
#    [mreplay/$conn "$msg "] 0 or 1 during replay only
#    c/$conn(q)              [list $inputline ...]
#
# globals:
#    $queueing            [list $conn ...]
#    $master              socket
#    $permissions         [list allow|super|deny $ipaddrhex $maskhex ...]
#    $realtime            pipes
#    $realtime_retry      [list $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
#
# configs set directly in multiplex-config:
#    $records          [list filename.record ...]
#    $detectlag        <ms>
#
# $conn is in $queueing iff c/$conn(q) is nonempty
#
# globals relating to realtime's command execution state:
#                           awaiting        awaiting  executing global
#                   idle     executing/nak   ack       internal cmd     dead
#
#    $realtime       set      set            set          ?             unset
#    $currentcmd     unset    $cmd           $cmd         $cmd          unset
#    $currentconn    unset    $conn or {}    $conn or {}  $conn         unset
#    $executing      0        0              1            2             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
#    41 warning save-dump-failed
#    42 info save-dump
#    50 resolution ....
#    55 picio out on|off
#    60 movpos ...
#       train ...
#       picio out polarity ...
#    70 detect <seg> 0|1

set libdir .
catch { set libdir $env(TRAINS_HOSTSIDE) }
source $libdir/lib.tcl

#---------- replay, general utilities, etc. ----------

proc compile-glob-patterns {pats procname} {
    if {[llength $pats] > 20 || [string length $pats] > 200} {
	cmderr LimitExceeded "too many, or too long, patterns"
    }
    set def "\n"
    append def "    switch -regexp -- \$m {\n"
    foreach pat $pats {
	set neg [regsub {^~} $pat {} pat]
	if {[regexp {[^-+./&|:=0-9a-zA-Z_*?]} $pat]} {
	    cmderr BadCmd "pattern contains invalid character"
	}
	regsub -all {[-+./&|:=]} $pat {\\&} pat
	regsub -all {_} $pat {\s+} pat
	regsub -all {\*} $pat {\S+} pat
	regsub -all {\?} $pat {.} pat
	append pat {\s}
	append def "    [list ^$pat " return [expr {!$neg}] "]\n"
    }
    append def {    {^[-&]\S|^\+debug\s} { return 0 }} "\n"
    append def "    }\n"
    append def "    return 1\n"
    proc $procname {m} $def
}

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 lputs {m} {
    global lputs
    if {!$lputs} return
    if {[regexp \
 {^\<[<&] picioh (?:in msg|out) 8[89a-f]|^\<[<&] picio (?:in pong|out ping)} \
            $m]} \
	return
    puts $m
}

proc xmit-relevantly {m} {
    global executing currentconn conns
    if {$executing} {
	puts "<* $m"
	set myconn $currentconn
	if {[string length $currentconn]} {
	    trapping xmit-only-noreport $currentconn +$m
	}
	set othersm -$m
    } else {
	lputs "<& $m"
	set myconn {}
	set othersm &$m
    }
    foreach conn [array names conns] {
	if {[string compare $myconn $conn]} {
	    trapping xmit-only-noreport $conn $othersm
	}
    }
}

proc xmit-relevantly-savereplay {pri key rhs} {
    set pk "$pri $key"
    upvar #0 replay($pk) rep
    set rep $rhs
    xmit-relevantly "$key $rhs"
}

proc savereplay-clear {pk} {
    upvar #0 replay($pk) rep; catch { unset rep }
}

proc savereplay-clear-re {re} { # re is anchored at start
    global replay
    if {![info exists replay]} return
    foreach pk [array names replay] {
	if {[regexp -- ^$re "$pk "]} { unset replay($pk) }
    }
}

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} {
    upvar #0 c/$conn c
    compile-glob-patterns $args msel/$conn
}

proc global/!save-dump {conn args} {
    nargs $args
    if {[catch { save-dump } emsg]} {
	cmderr HostSupportSystemsProblem "failed to save dump: $emsg"
    }
}

proc do-replay {conn} {
    global replay
    foreach pk [lsort [array names replay]] {
	set pri [string range $pk 0 2]
	set lhs [string range $pk 3 end]
	set r [string trimright $replay($pk) "\n"]
	foreach m [split $r "\n"] {
	    puts "<$conn|$pri|$lhs $m"
	    xmit-only-noreport $conn "|$lhs $m"
	}
    }
}

proc local/replay {conn args} {
    if {[llength $args]} {
	rename msel/$conn mreplay/$conn ;# park it here for a moment
	compile-glob-patterns $args msel/$conn
    }
    do-replay $conn
    if {[llength $args]} {
	rename msel/$conn {}
	rename mreplay/$conn msel/$conn
    }
}

proc local/select-replay {conn args} {
    upvar #0 c/$conn c
    compile-glob-patterns $args msel/$conn
    do-replay $conn
}

#---------- automatic realtime restart ----------

proc global/!realtime {conn args} {
    global realtime realtime_retry
    nargs $args 1
    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 serchan
    if {![info exists realtime_retry]} return
    if {![llength $realtime_retry]} return
    manyset $realtime_retry timeoutid
    fileevent $serchan readable {}
    after cancel $timeoutid
    set realtime_retry {}
}

proc realtime-retry-check {} {
    global realtime_retry realtime
    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 serchan
    if {![info exists realtime_retry]} return
    if {[llength $realtime_retry]} { error "huh? $realtime_retry" }
    fileevent $serchan readable realtime-retry-serchan-readable
    set after [after 500 realtime-retry-send-ping]
    set realtime_retry [list $after {} {}]
}

proc realtime-retry-send-ping {} {
    global realtime_retry urandom serchan
    manyset $realtime_retry 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 $after $pong {}]
}

proc realtime-retry-serchan-readable {} {
    global realtime_retry serchan
    manyset $realtime_retry 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 $after {} {}]
	    return
	}
    }
    set realtime_retry [list $after $pong $buf]
}

proc realtime-retry-now-off {} {
    realtime-retry-reset
    realtime-retry-check
}

#---------- connection and commands ----------

proc client-inputline {conn l} {
    global queueing
    upvar #0 c/$conn c
    puts "$conn> $l"
    client-disable-readable $conn
    if {![llength $c(q)]} { lappend queueing $conn }
    lappend c(q) $l
    after idle process-queues
}

proc process-queues {} {
    global queueing currentcmd
    while {![info exists currentcmd] && [llength $queueing]} {
	set conn [lindex $queueing 0]
	set queueing [lrange $queueing 1 end]

	upvar #0 c/$conn c
	if {![llength $c(q)]} continue

	set l [lindex $c(q) 0]
	set c(q) [lrange $c(q) 1 end]
	if {[llength $c(q)]} {
	    lappend queueing $conn
	} else {
	    client-enable-readable $conn
	}

	trapping process-command $conn $l
    }
}

proc process-command {conn l} {
    global currentcmd currentconn realtime executing
    global errorInfo errorCode
    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 BadCmd}
	}
	if {[regexp {[^ \t!-~]} $l]} {
	    error "improper character" {} {TRAIN CMDNAK BadCmd}
	}
	if {[string length $priv] && !$c(super)} {
	    error "" {} {TRAIN CMDNAK PermissionDenied}
	}

	if {![catch { info args global/$cmd }]} {
	    set currentcmd $cmd
	    set currentconn $conn
	    set executing 2
	    xmit-relevantly "executing $cmd"
	    eval [list global/$cmd $conn] [lrange [split $l] 1 end]
	} elseif {![catch { info args local/$cmd }]} {
	    xmit-only $conn "+executing $cmd"
	    eval [list local/$cmd $conn] [lrange [split $l] 1 end]
	} elseif {![info exists realtime]} {
	    error "" {} {TRAIN CMDNAK realtime-not-running}
	} else {
	    set currentcmd $cmd
	    set currentconn $conn
	    if {[catch {
		puts ">> $l"
		puts $realtime $l
	    } emsg]} {
		if {[string match {POSIX EPIPE *} $errorCode]} {
		    realtime-failed EPIPE ""
		} elseif {[string match {POSIX *} $errorCode]} {
		    realtime-failed [lindex $errorCode 1] \
			    "write failed: [lindex $errorCode 2]"
		} else {
		    realtime-failed ?write-[lindex $errorCode 0] \
			    "puts failed ($errorCode): $emsg"
		}
	    }
	    return
	}
    } emsg]
    if {$r==2} return
    if {$r==0} {
	set m "ack $cmd ok"
	if {$executing} {
	    xmit-relevantly $m
	    set executing 0
	    unset currentconn
	    unset currentcmd
	} else {
	    xmit-only $conn +$m
	}
	return
    }
    switch -glob $errorCode {
	{TRAIN REPORTED*} {
	}
	{TRAIN CMDNAK*} {
	    set el [concat [list +nack] [lrange $errorCode 2 end]]
	    if {[string length $emsg]} { append el ": " $emsg }
	    xmit-only $conn "$el"
	}
	{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
	    kill-conn-ierr $conn
	    error $emsg $ei $ec
	}
    }
}

proc client-eof {conn} {
    puts "$conn>\$"
    kill-conn $conn ""
}

proc client-enable-readable {conn} {
    fileevent $conn readable [list trapping readable client $conn]
}
proc client-disable-readable {conn} {
    fileevent $conn readable {}
}

#---------- general IO ----------

proc xmit-puts {conn msg} {
    global conns errorInfo
    if {![info exists conns($conn)]} return
    if {[catch { puts -nonewline $conn $msg } emsg]} {
	kill-conn $conn "=failed client-io : $emsg"
	error $emsg $errorInfo {TRAIN REPORTED}
    }
}

proc xmit-only-always {conn msg} {
    puts "<$conn $msg"
    xmit-puts $conn "$msg\n"
}
proc xmit-only-noreport {conn msg} {
    append msg "\n"
    if {[msel/$conn $msg]} { xmit-puts $conn $msg }
}
proc xmit-only {conn msg} {
    xmit-only-noreport $conn $msg
}

#---------- error handling ----------

proc kill-conn {conn msg} {
    global conns queueing currentconn
    upvar #0 c/$conn c
    catch { unset conns($conn) } ;# do this first to stop any recursion
    if {[info exists currentconn]} {
	if {![string compare $currentconn $conn]} { set currentconn {} }
    }
    puts "<$conn\$ closing : $msg"
    if {[string length $msg]} { catch { xmit-only-always $conn "$msg" } }
    catch { close $conn }
    if {[set ix [lsearch -exact $queueing $conn]] >= 0} {
	set queueing [lreplace $queueing $ix $ix]
    }
    catch { unset c }
    catch { rename msel/$conn {} }
    catch { rename mreplay/$conn {} }
    set qn {}
    set cmdqueue $qn
}

proc report-unexpected {headmsg emsg} {
    if {[catch {
	global errorInfo errorCode
	puts stderr \
"========== $headmsg ==========\n
$errorCode\n
$errorInfo\n
$emsg\n
========================================\n"
    } e]} { exit 16 }
}

proc bgerror {emsg} {
    global errorInfo errorCode
    catch { report-unexpected {UNEXPECTED UNTRAPPED ERROR} $emsg }
    exit 12
}

proc kill-conn-ierr {conn} {
    kill-conn $conn "=failed : Internal error"
}

proc trapping {proc conn args} {
    global errorInfo errorCode
    if {![catch { uplevel #0 [list $proc $conn] $args } r]} { return $r }
    switch -glob $errorCode {
	{TRAIN EXPECTED*} { kill-conn $conn "=failed : $r" }
	{TRAIN REPORTED*} { kill-conn $conn "" }
	* {
	    report-unexpected {UNEXPECTED ERROR} $r
            kill-conn-ierr $conn
	}
    }
}	

#---------- realtime subprocess ----------

proc realtime-failed {k m} {
    global realtime currentcmd currentconn executing
    global errorInfo errorCode replay
    # if $m is "", use wait status
    if {![string length $m]} {
	set r [catch {
	    fconfigure $realtime -blocking 1
	    close $realtime
	} emsg]
	if {!$r} {
	    set m "unexpectedly closed pipe ?!"
	    set k unexpected
	} elseif {[string match {CHILDSTATUS*} $errorCode]} {
	    set m "exited with status [lindex $errorCode 2]"
	    set k "exit[lindex $errorCode 2]"
	} elseif {[string match {CHILDKILLED*} $errorCode]} {
	    set m "killed by signal [lindex $errorCode 3]"
	    set k [lindex $errorCode 2]
	} else {
	    set m "failed confusingly ($errorCode): $emsg"
	    set k ?wait-[lindex $errorCode 0]
	}
    } else {
	catch { close $realtime }
    }
    lputs "<<\$ $k : $m"
    catch { unset realtime }
    if {[catch {
	set sef [open +realtime.stderr r]
	while {[gets $sef l] >= 0} {
	    xmit-relevantly-savereplay 40 \
		    "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"
	}
	catch { close $sef }
    }
    xmit-relevantly-savereplay 40 \
	    "warning realtime-failed" "reason $k : $m"
    catch { save-dump }
    if {$executing==2} {
	# internal commands need to deal with it themselves
    } elseif {$executing} {
	xmit-relevantly "ack $currentcmd SystemFailed realtime : $m"
	set executing 0
    } elseif {[info exists currentcmd]} {
	xmit-relevantly "nak SystemFailed realtime : $m"
	unset currentcmd
	unset currentconn
    }
    realtime-notrunning
    realtime-retry-realtime-failed
}

proc realtime-notrunning {} {
    xmit-relevantly-savereplay 10 stastate Crashed
}

proc realtime-start {xopts} {
    global realtime records realtime_xopts dev_railway libdir
    if {[info exists realtime]} { error "realtime already running" }
    realtime-retry-reset
    set cl [concat \
	    [list 2> +realtime.stderr $libdir/realtime -v2 -s$dev_railway] \
	    $realtime_xopts $xopts]
    foreach f $records { lappend cl $libdir/$f }
    puts "<> $cl"
    savereplay-clear-re "40 warning realtime-failed"
    if {[catch {
	set realtime [open |$cl r+]
	fconfigure $realtime -translation binary -buffering line -blocking 0
	fileevent $realtime readable [list readable realtime $realtime]
    } emsg]} {
	realtime-failed start $emsg
	error "realtime failed : $emsg" "" {TRAIN REPORTED}
    }
}

proc realtime-eof {dummy} { realtime-failed EOF "" }

proc detect0timeout {seg} {
    global replay
    upvar #0 detect0($seg) d0
    unset d0
    set key "detect $seg"
    set pk "70 $key"
    set replay($pk) 0
    xmit-relevantly "$key 0"
}

proc clear-replay-detects {} {
    global replay
    foreach k [array names replay] {
	if {[regexp {^.. detect } $k]} { unset replay($k) }
    }
}

proc realtime-inputline {dummy l} {
    global detectlag replay testmode
    global executing currentcmd currentconn

    if {$testmode && [regexp {^%(.*)} $l dummy rhs]} {
	set r [catch { uplevel #0 $rhs } emsg]
	if {$r} { puts "** $emsg\n" } else { puts "=> $emsg\n" }
	return
    }

    lputs "<< $l"

    if {[regexp {^(detect (\w+)) ([01])$} $l dummy key seg value]} {
	upvar #0 detect0($seg) d0
	catch { after cancel $d0 }
	if {$value} {
	    if {[info exists d0]} { unset d0; return }
	} else {
	    set d0 [after $detectlag detect0timeout $seg]
	    return
	}
	set pri 70
    } elseif {[regexp {^(stastate) (.*)$} $l dummy key value]} {
	switch -exact -- $value {
	    Settling {
		clear-replay-detects
		savereplay-clear-re {^60 train \S+ speed }
	    }
	    Resolving {
		savereplay-clear-re {^50 resolution }
		savereplay-clear-re {^60 train \S+ (?:at|has) }
	    }
	}
	set pri 10
    } elseif {[regexp {^(resolution) (.*)$} $l dummy key addvalue]} {
	set pri 50
    } elseif {[regexp {^(picio out) (on|off)$} $l dummy key value]} {
	set pri 55
    } elseif {[regexp -expanded {
	^( movpos \s \S+ \s (?: feat \s \S+ | position) |
	   train  \s \S+ \s (?: has | at | speed \s commanding ) |
	   picio  \s out \s polarity
	) \s (.*) $
              } $l dummy key value]} {
        set pri 60
    }
    if {[info exists key]} {
	set pk "$pri $key"
	upvar #0 replay($pk) rep
	if {[info exists value]} {
	    set rep $value
	} else {
	    append rep $addvalue "\n"
	}
    }

    switch -regexp -- $l {
	{^executing\s|^nak\s} {
	    set executing 1
	}
    }

    xmit-relevantly $l

    switch -regexp -- $l {
	{^ack\s|^nak\s} {
	    set executing 0
	    unset currentcmd
	    unset currentconn
	    after idle process-queues
	}
    }
}

#---------- new connections ----------

proc find-permission {ipaddr} {
    global permissions
    set ipaddr [ipaddr2hex $ipaddr]
    foreach {keyword paddr pmask} $permissions {
	if {[expr {($ipaddr & $pmask) == $paddr}]} { return $keyword }
    }
    return deny
}

proc connected {conn} {
    global conns
    upvar #0 c/$conn c
    fconfig-trainproto $conn
    set c(q) {}
    set conns($conn) 1
    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 ?" }
    }
    compile-glob-patterns {?info ?warning} msel/$conn
    
    xmit-only-always $conn =connected
    xmit-only-always $conn "=permission [lindex {normal super} $c(super)]"
    client-enable-readable $conn
}

proc newconn {conn ipaddr port} {
    upvar #0 c/$conn c
    catch { unset c }
    puts "$conn new-client $conn $ipaddr,$port"
    set c(ipaddr) $ipaddr
    trapping connected $conn
}

proc try-bind {addr} {
    global master errorInfo errorCode port
    if {![catch {
	set master [socket -server newconn -myaddr $addr $port]
    } 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 {addr blist} {
    global master permissions port
    if {[info exists master]} return
    if {![try-bind $addr]} return
    puts "bound to $addr,$port"
    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)}]
	set mask [format %#10x $mask]
	if {$ipaddr & ~$mask} {
	    error "non-zero bits outside mask in $pattern ($ipaddr/$mask)"
	}
	lappend permissions $keyword $ipaddr $mask
    }
}

proc startup {} {
    global queueing executing testmode realtime port urandom serchan
    global dev_railway libdir lputs
    catch { close $master }; catch { unset master }

    setting testmode 0 {[01]}
    setting lputs 0 {[01]}
    setting dev_railway {} {/.*}
    parse-argv {}
    
    uplevel #0 source $libdir/multiplex-config
    set queueing {}
    set executing 0

    set urandom [open /dev/urandom r]
    fconfigure $urandom -buffering none -translation binary

    set serchan [open $dev_railway {RDWR NOCTTY NONBLOCK}]
    fconfigure $serchan -translation binary -buffering none -blocking 0

    realtime-notrunning

    if {!$testmode} {
	start_commandloop
	after idle realtime-retry-check
    } else {
	fconfig-trainproto stdin
	fconfig-trainproto stdout
	fileevent stdin readable [list readable realtime stdin]
	set realtime stdout
    }
}

startup
vwait end