#!/usr/bin/expect --
# som-mfg-f7 -- program an Emcraft STM32F7 SOM end to end from this station,
# unattended: U-Boot into the eNVM over JTAG, the kernel into NOR over TFTP from
# this station, the board booted and its link tested over its serial console,
# and the environment it ships with. Ends with one PASS or FAIL line.
#
# The VF6 manufacturing station's run for this SOM (manufacturing/expect:
# mfg.exp som-stm32f7, target_som-stm32f7.exp, lib.exp),
# step for step, with this station's own tools: som-program-f7 for the JTAG
# half, som-console to find the board's console, in.tftpd-hpa for the kernel.
# The station directory's mac/maclist and mac/lastmac are the VF6 SD card's,
# with the same formats and the same rules (its getmac).

set PROG som-mfg-f7
set STATION_DIR [expr {[info exists env(SOM_STATION_DIR)] ? $env(SOM_STATION_DIR) : "/var/lib/brintos-som"}]
set OVERRIDE $STATION_DIR/som-mfg-f7.exp
# Where an operator's own images go; som-program-f7 looks there for U-Boot too.
set MEDIA_DIR [expr {[info exists env(SOM_MEDIA_DIR)] ? $env(SOM_MEDIA_DIR) : "/mnt/media/stm32f7"}]

proc sha256_of {f} {
    if {[catch {exec sha256sum $f 2>/dev/null} r] || ![regexp {^[0-9a-f]{64}} $r h]} { return unknown }
    return $h
}

# A fixed copy of this script in the station directory runs in place of the
# installed one, as the VF6 station took expect/*.exp from its SD card: a fix
# needs no new image. Every run names the script it is, with its sha256.
set SELF [file normalize [info script]]
if {[lsearch -exact $argv --no-override] < 0 && [file isfile $OVERRIDE]
    && $SELF ne [file normalize $OVERRIDE]} {
    puts "$PROG: running the override $OVERRIDE in place of $SELF"
    flush stdout
    if {[catch {source $OVERRIDE} err]} {
        puts "$PROG: FAIL -- the override $OVERRIDE stopped: $err"
        exit 1
    }
    exit 0
}

# ============================================================================
# The frame: options, output, step timing, the MAC list. Nothing here is
# specific to the F7.
# ============================================================================

proc usage {{ch stdout}} {
    global PROG STATION_DIR MEDIA_DIR
    puts $ch "usage: $PROG \[options\]

Programs one STM32F7 SOM: U-Boot into its eNVM (som-program-f7), the kernel into
NOR (U-Boot's update, from this station's TFTP server), boots it, pings this
station from the board, and leaves the environment it ships with.

  --mac MAC        give the board this MAC; the MAC list is not touched
  --keep-mac       keep the MAC the board already has (re-programming a board)
                   default: the next MAC from $STATION_DIR/mac/maclist
  --console DEV    the board's console (default: som-console --find)
  --netif IF       the USB Ethernet adapter (default: the one USB network interface)
  --station-ip A   this station's address on the cable (default 192.168.7.1)
  --board-ip A     the board's address while it is programmed (default 192.168.7.2)
  --no-net         leave the adapter's address and the TFTP server as they are
  --adapter NAME, --transport T, --speed KHZ, --image FILE
                   passed to som-program-f7 (see som-program-f7 --help)
  --kernel FILE    the kernel to write into NOR, any name. Default:
                   $MEDIA_DIR/rootfs.uImage when there is one, else the
                   built-in copy. Its record is FILE.PROVENANCE beside it,
                   else the built-in one (som-provenance-f7 writes it)
  --reset-test     at the end, wait for the board's reset button to be pressed
  --log FILE       the console transcript (default /tmp/$PROG-<time>.log)
  --dry-run        check the set-up and say what would be done; touch no board
  --no-override    run this script even when $STATION_DIR/$PROG.exp exists
  -v               show the board's console as the run goes

The MAC list: the first line of mac/maclist that is not a comment is the range,
FROM and TO; mac/lastmac holds the last MAC handed out. The next one is
lastmac + 1, or FROM when there is no lastmac. It is written to lastmac before
it is given to the board, so a run that fails afterwards has used its MAC and
the next board gets the one after. One list serves one station at a time, and
--mac is not checked against it.

Exit status: 0 PASS, 1 FAIL, 2 usage."
}

array set opt {mac "" keepmac 0 console "" netif "" station 192.168.7.1 board 192.168.7.2
               nonet 0 resettest 0 log "" verbose 0 dryrun 0 kernel ""}
set progargs {}
proc optval {i} {
    global argv PROG
    if {$i >= [llength $argv]} {
        puts stderr "$PROG: [lindex $argv [expr {$i - 1}]] needs a value"
        usage stderr; exit 2
    }
    return [lindex $argv $i]
}
for {set i 0} {$i < [llength $argv]} {incr i} {
    set a [lindex $argv $i]
    switch -- $a {
        --mac        { set opt(mac) [optval [incr i]] }
        --keep-mac   { set opt(keepmac) 1 }
        --console    { set opt(console) [optval [incr i]] }
        --netif      { set opt(netif) [optval [incr i]] }
        --station-ip { set opt(station) [optval [incr i]] }
        --board-ip   { set opt(board) [optval [incr i]] }
        --no-net     { set opt(nonet) 1 }
        --reset-test { set opt(resettest) 1 }
        --log        { set opt(log) [optval [incr i]] }
        --kernel     { set opt(kernel) [optval [incr i]] }
        --dry-run    { set opt(dryrun) 1 }
        --no-override { }
        -v - --verbose { set opt(verbose) 1 }
        --adapter - --transport - --speed - --image { lappend progargs $a [optval [incr i]] }
        -h - --help  { usage; exit 0 }
        default {
            puts stderr "$PROG: unknown argument: $a"
            usage stderr; exit 2
        }
    }
}
foreach k {station board} {
    if {![regexp {^[0-9]{1,3}(\.[0-9]{1,3}){3}$} $opt($k)]} {
        puts stderr "$PROG: --$k-ip: not an IPv4 address: $opt($k)"; exit 2
    }
}
if {$opt(mac) ne "" && $opt(keepmac)} {
    puts stderr "$PROG: --mac and --keep-mac exclude each other"; exit 2
}

set steps {}
set cur {}
set wrote 0
set logopen 0
log_user $opt(verbose)
match_max 200000

proc say {msg} {
    global PROG
    puts "$PROG: $msg"
    flush stdout
    send_log "\n$PROG: $msg\n"
}
proc secs {from} { expr {([clock milliseconds] - $from) / 1000.0} }

proc step {n name} {
    global cur cs
    set cur [list $n $name]
    set cs [clock milliseconds]
    say "step $n: $name"
}
proc done {} {
    global cur cs steps
    set d [secs $cs]
    lappend steps [list {*}$cur $d]
    say [format "step %s done, %.1f s" [lindex $cur 0] $d]
    set cur {}
}

# The run ends here on any failure: what failed, where, and the last of what
# the board printed.
proc die {msg} {
    global PROG cur wrote opt
    if {[llength $cur]} {
        set where "step [lindex $cur 0] ([lindex $cur 1]): "
    } else {
        set where ""
    }
    if {$::logopen && [file readable $opt(log)]} {
        log_file
        if {![catch {open $opt(log) r} fh]} {
            set lines [split [string map {"\r" ""} [read $fh]] "\n"]
            close $fh
            puts "$PROG: the last of the transcript ($opt(log)):"
            foreach l [lrange $lines end-15 end] { puts "  | $l" }
        }
    }
    if {!$wrote} { append msg "; nothing was written to the board" }
    puts "$PROG: FAIL -- $where$msg"
    flush stdout
    exit 1
}

# --- the MAC list ---------------------------------------------------------------
# getmac's rules: FROM and TO share their first three octets, FROM <= TO, and a
# lastmac lies in [FROM, TO); the next MAC is lastmac + 1, else FROM.
proc mac_split {s} {
    set x {([0-9A-Fa-f]{1,2})}
    if {![regexp "^$x:$x:$x:$x:$x:$x\$" $s -> a b c d e f]} { return {} }
    lassign [lmap v [list $a $b $c $d $e $f] { scan $v %x }] a b c d e f
    return [list [expr {($a << 16) | ($b << 8) | $c}] [expr {($d << 16) | ($e << 8) | $f}]]
}
proc mac_join {hi lo} {
    format %02X:%02X:%02X:%02X:%02X:%02X [expr {($hi >> 16) & 255}] [expr {($hi >> 8) & 255}] \
        [expr {$hi & 255}] [expr {($lo >> 16) & 255}] [expr {($lo >> 8) & 255}] [expr {$lo & 255}]
}
proc first_line {f} {
    if {[catch {open $f r} fh]} { return -code error "cannot read $f: $fh" }
    set d [read $fh]
    close $fh
    foreach l [split $d "\n"] {
        set l [string trim $l " \t\r"]
        if {$l eq "" || [string index $l 0] eq "#"} continue
        return $l
    }
    return ""
}
# Returns {mac from to last} without writing anything.
proc mac_next {} {
    global STATION_DIR
    set listf $STATION_DIR/mac/maclist
    set lastf $STATION_DIR/mac/lastmac
    if {![file exists $listf]} {
        die "no MAC list at $listf: put the range there (one line: FROM TO), or give --mac, or --keep-mac for a board that already has its MAC"
    }
    if {[catch {first_line $listf} line]} { die $line }
    set w [regexp -inline -all {\S+} $line]
    if {[llength $w] < 2} { die "$listf: no range in it (want one line: FROM TO)" }
    set f [mac_split [lindex $w 0]]
    set t [mac_split [lindex $w 1]]
    if {![llength $f] || ![llength $t]} { die "$listf: not two MAC addresses: '$line'" }
    if {[lindex $f 0] != [lindex $t 0]} { die "$listf: the first three octets of FROM and TO differ" }
    if {[lindex $f 1] > [lindex $t 1]} { die "$listf: FROM is above TO" }
    set last ""
    set l ""
    if {[file exists $lastf]} {
        if {[catch {first_line $lastf} l]} { die $l }
        # An emptied lastmac would hand FROM out again: getmac refuses it too.
        if {$l eq ""} { die "$lastf exists but holds no MAC: put the last MAC given out there, or remove the file if none has been" }
    }
    if {$l ne ""} {
        set p [mac_split [lindex [regexp -inline -all {\S+} $l] 0]]
        if {![llength $p]} { die "$lastf: not a MAC address: '$l'" }
        if {[lindex $p 0] != [lindex $f 0]} { die "$lastf: [mac_join {*}$p] is not in the range's first three octets" }
        if {[lindex $p 1] == [lindex $t 1]} { die "the MAC list is used up: lastmac [mac_join {*}$p] is the end of the range $line" }
        if {[lindex $p 1] > [lindex $t 1] || [lindex $p 1] < [lindex $f 1]} {
            die "$lastf: [mac_join {*}$p] lies outside the range $line"
        }
        set last [mac_join {*}$p]
        set next [mac_join [lindex $f 0] [expr {[lindex $p 1] + 1}]]
        set left [expr {[lindex $t 1] - [lindex $p 1]}]
    } else {
        set next [mac_join {*}$f]
        set left [expr {[lindex $t 1] - [lindex $f 1] + 1}]
    }
    return [list $next [mac_join {*}$f] [mac_join {*}$t] $last $left]
}
proc mac_record {mac} {
    global STATION_DIR
    set lastf $STATION_DIR/mac/lastmac
    # Written in place: a rename on this machine's stored root costs about 10 s
    # a board, and a write cut short leaves an empty lastmac, which mac_next
    # refuses rather than handing FROM out again.
    if {[catch {
        set fh [open $lastf w]
        puts $fh $mac
        close $fh
    } err]} { die "cannot record $mac in $lastf, so it was not given to the board: $err" }
    if {[catch {first_line $lastf} got] || $got ne $mac} {
        die "$lastf reads back '$got', not $mac; the MAC was not given to the board"
    }
}

proc read_prov {f} {
    if {[catch {open $f r} fh]} { die "cannot read $f" }
    set d [read $fh]
    close $fh
    set r [dict create]
    foreach l [split $d "\n"] {
        if {[regexp {^([a-z0-9]+):\s+(.*?)\s*$} $l -> k v]} { dict set r $k $v }
    }
    return $r
}
proc rx_quote {s} { regsub -all {[][\\.^$*+?(){}|]} $s {\\&} }

# ============================================================================
# The F7: what target_som-stm32f7.exp and params.exp set.
# ============================================================================

# Overridable so the run can be exercised off-target against a constructed tree.
set F7_DIR    [expr {[info exists env(SOM_FIRMWARE_DIR)] ? $env(SOM_FIRMWARE_DIR) : "/usr/share/brintos-som/stm32f7"}]
set TFTP_ROOT [expr {[info exists env(SOM_TFTP_ROOT)] ? $env(SOM_TFTP_ROOT) : "/var/lib/tftpboot"}]
# U-Boot's built-in ethaddr, the same on every board with no saved environment.
set DEFAULT_MAC  C0:B1:3C:88:88:85
# The environment the board ships with (params.exp).
set SHIP_IPADDR  192.168.0.2
set SHIP_SERVER  192.168.0.1
set SHIP_GATEWAY 192.168.0.1
set SHIP_IMAGE   rootfs.uImage
set SHIP_BOOTDELAY 3
set LPROMPT      "/ # "

say "script: $SELF (sha256 [sha256_of $SELF])"

if {$opt(mac) ne ""} {
    set p [mac_split $opt(mac)]
    if {![llength $p]} { puts stderr "$PROG: --mac: not a MAC address: $opt(mac)"; exit 2 }
    set opt(mac) [mac_join {*}$p]
    if {$opt(mac) eq $DEFAULT_MAC} {
        puts stderr "$PROG: --mac $DEFAULT_MAC is U-Boot's built-in address, the same on every board"; exit 2
    }
}

# The kernel, in the order som-program-f7 takes U-Boot: --kernel, the operator's
# copy, the built-in one.
set KBUILTIN $F7_DIR/rootfs.uImage
if {$opt(kernel) ne ""} {
    set KFILE [file normalize $opt(kernel)]
    set ksrc argument
} elseif {[file readable $MEDIA_DIR/rootfs.uImage]} {
    set KFILE $MEDIA_DIR/rootfs.uImage
    set ksrc media
} else {
    set KFILE $KBUILTIN
    set ksrc built-in
}
if {![file isfile $KFILE] || ![file readable $KFILE]} { die "cannot read the kernel $KFILE" }
set kprovf $KFILE.PROVENANCE
if {![file readable $kprovf]} {
    say "no record beside $KFILE: checking against $KBUILTIN.PROVENANCE"
    set kprovf $KBUILTIN.PROVENANCE
}
set kprov [read_prov $kprovf]
foreach k {version size} {
    if {![dict exists $kprov $k]} { die "$kprovf has no $k: line" }
}
set KVERSION [dict get $kprov version]
set KSIZE [lindex [dict get $kprov size] 0]
regsub {^Linux-} $KVERSION {} kv
set LXCHECK "Linux version [rx_quote $kv]"
set IMGCHECK "Image Name: +[rx_quote $KVERSION]"
if {[file size $KFILE] != $KSIZE} {
    die "$KFILE is [file size $KFILE] bytes, its record $kprovf says $KSIZE"
}
# The built-in copy is served through the image's own link; any other through a
# link made for the run in RUN_DIR, which the TFTP root reaches as som-mfg-f7.
set RUN_DIR /tmp/som-mfg-f7
if {[file normalize $KFILE] eq [file normalize $KBUILTIN]} {
    set TFTP_KERNEL stm32f7/rootfs.uImage
    if {![file readable $TFTP_ROOT/$TFTP_KERNEL]} {
        die "the TFTP root does not reach the kernel: $TFTP_ROOT/$TFTP_KERNEL"
    }
    if {[file size $TFTP_ROOT/$TFTP_KERNEL] != $KSIZE} {
        die "$TFTP_ROOT/$TFTP_KERNEL is [file size $TFTP_ROOT/$TFTP_KERNEL] bytes, its record says $KSIZE"
    }
} else {
    set TFTP_KERNEL som-mfg-f7/rootfs.uImage
    # The image makes the packaged link relative, so it is compared resolved.
    if {[catch {file readlink $TFTP_ROOT/som-mfg-f7} l] ||
        [file normalize [file join $TFTP_ROOT $l]] ne [file normalize $RUN_DIR]} {
        die "the TFTP root has no link $TFTP_ROOT/som-mfg-f7 -> $RUN_DIR to serve $KFILE through"
    }
    # The run's ln -sf would replace a file there, and busybox's says nothing.
    set runlink [file join [file normalize $RUN_DIR] rootfs.uImage]
    if {[file normalize $KFILE] eq $runlink ||
        (![catch {file lstat $runlink st}] && $st(type) ne "link")} {
        die "$runlink is where each run links the kernel it serves: keep the kernel elsewhere and name it with --kernel"
    }
}
say "kernel: $KFILE ($ksrc, $KSIZE bytes), sha256 [sha256_of $KFILE]"
say "kernel record: $kprovf ($KVERSION); served as $TFTP_KERNEL"

# --- the MAC --------------------------------------------------------------------
if {$opt(mac) ne ""} {
    set MAC $opt(mac)
    say "mac: $MAC (--mac; the MAC list is not touched)"
} elseif {$opt(keepmac)} {
    set MAC ""
    say "mac: the board's own, read before its environment is erased (--keep-mac)"
} else {
    lassign [mac_next] MAC from to last left
    say "mac: $MAC, the next from the list $from..$to ([expr {$last eq "" ? "none handed out yet" : "lastmac $last"}]; $left left, this one included)"
}

# --- this station's side: the adapter, its address, the TFTP server -------------
proc usb_netifs {} {
    set r {}
    foreach p [lsort [glob -nocomplain /sys/class/net/*]] {
        if {[catch {file readlink $p} l]} continue
        if {[string match */usb* $l]} { lappend r [file tail $p] }
    }
    return $r
}
proc tftp_listening {} {
    if {[catch {open /proc/net/udp r} fh]} { return 0 }
    set d [read $fh]
    close $fh
    return [regexp {:0045 00000000:0000} $d]
}
proc netif_addrs {ifn} {
    if {[catch {exec ip -4 -o addr show dev $ifn 2>@1} r]} { return "" }
    return $r
}

set NETIF $opt(netif)
if {!$opt(nonet)} {
    if {$NETIF eq ""} {
        set c [usb_netifs]
        if {[llength $c] == 0} {
            die "no USB Ethernet adapter: attach it in the machine's USB devices tab, or name the interface with --netif"
        }
        if {[llength $c] > 1} { die "several USB network interfaces ([join $c {, }]): name one with --netif" }
        set NETIF [lindex $c 0]
    }
    if {![file isdirectory /sys/class/net/$NETIF]} { die "no network interface $NETIF" }
}

set CONSOLE $opt(console)
if {$CONSOLE eq ""} {
    if {[catch {exec som-console --find 2>@1} r]} {
        die "no console: som-console --find says: [string trim $r]"
    }
    set CONSOLE [string trim $r]
}
say "console: $CONSOLE"

if {$opt(dryrun)} {
    if {$opt(nonet)} {
        say "network: left as it is (--no-net)"
    } else {
        set a [netif_addrs $NETIF]
        say "network: $NETIF, [expr {[regexp "inet [rx_quote $opt(station)]/" $a] ? "has" : "would get"}] $opt(station)/24; TFTP server [expr {[tftp_listening] ? "listening" : "would be started"}]"
    }
    if {[catch {exec som-program-f7 --dry-run --no-backup --no-readback {*}$progargs 2>@1} r]} {
        foreach l [split $r "\n"] { puts "  | $l" }
        die "som-program-f7 --dry-run failed"
    }
    foreach l [split $r "\n"] { puts "  | $l" }
    say "PASS -- dry run, no board touched[expr {$MAC ne "" && $opt(mac) eq "" ? ", $MAC not recorded" : ""}]"
    exit 0
}

if {$opt(log) eq ""} {
    set opt(log) /tmp/$PROG-[clock format [clock seconds] -format %Y%m%dT%H%M%SZ -gmt 1].log
}
if {[catch {log_file -a -noappend $opt(log)} err]} {
    set l $opt(log)
    set opt(log) ""
    die "cannot write the transcript $l: $err"
}
set logopen 1
say "transcript: $opt(log)"

step 0 "this station: network, TFTP server, console"
if {$opt(nonet)} {
    say "network: left as it is (--no-net)"
} else {
    if {[catch {exec ip link set $NETIF up 2>@1} r]} { die "ip link set $NETIF up: $r" }
    if {![regexp "inet [rx_quote $opt(station)]/" [netif_addrs $NETIF]]} {
        if {[catch {exec ip addr add $opt(station)/24 dev $NETIF 2>@1} r]} {
            die "ip addr add $opt(station)/24 dev $NETIF: $r"
        }
    }
    if {![regexp "inet [rx_quote $opt(station)]/" [netif_addrs $NETIF]]} {
        die "$NETIF does not show $opt(station) after ip addr add"
    }
    if {![tftp_listening]} {
        # The daemon must not inherit a pipe of ours, or exec waits for it forever.
        catch {exec /etc/init.d/tftpd-hpa start </dev/null >/dev/null 2>/dev/null}
        for {set i 0} {$i < 20 && ![tftp_listening]} {incr i} { after 500 }
        if {![tftp_listening]} { die "the TFTP server is not listening on UDP 69 after /etc/init.d/tftpd-hpa start" }
    }
    say "network: $NETIF $opt(station)/24, TFTP server listening"
}
if {$TFTP_KERNEL ne "stm32f7/rootfs.uImage"} {
    if {[catch {file mkdir $RUN_DIR} err]} { die "cannot make $RUN_DIR: $err" }
    # BRINTOS-WORKAROUND: glibc#14 revisit — ln can fail with "Unknown error 517" after making the link, so the link is read back instead
    catch {exec ln -sfn $KFILE $RUN_DIR/rootfs.uImage 2>@1}
    if {[catch {file readlink $RUN_DIR/rootfs.uImage} l] || $l ne $KFILE} {
        die "cannot link $RUN_DIR/rootfs.uImage to $KFILE"
    }
    if {![file readable $TFTP_ROOT/$TFTP_KERNEL] || [file size $TFTP_ROOT/$TFTP_KERNEL] != $KSIZE} {
        die "the TFTP root does not reach $KFILE as $TFTP_ROOT/$TFTP_KERNEL"
    }
    say "kernel: $TFTP_ROOT/$TFTP_KERNEL -> $KFILE"
}
# Raw, as U-Boot and the board's shell expect a terminal; open(2) of a tty can
# fail EINTR in this guest, so the open is retried.
if {[catch {exec stty -F $CONSOLE 115200 raw -echo -echoe -echok 2>@1} r]} {
    die "stty -F $CONSOLE: $r"
}
set fh ""
for {set i 0} {$i < 5} {incr i} {
    if {![catch {open $CONSOLE {RDWR NOCTTY}} fh]} break
    set fh ""
    after 200
}
if {$fh eq ""} { die "cannot open the console $CONSOLE" }
fconfigure $fh -translation binary -buffering none
spawn -noecho -open $fh
set con $spawn_id
done

# --- console helpers --------------------------------------------------------------

# saveenv is done when U-Boot says it wrote the sector, not when a prompt comes.
proc saveenv {} {
    global UPROMPT
    sw "saveenv" {Writing to Flash\.\.\. done} 30 {Error[^\r\n]*|not [Ee]rased[^\r\n]*|[Ff]ailed[^\r\n]*}
    w [rx_quote $UPROMPT] 10 "the prompt after saveenv"
}

# Send a line to the board and wait for a pattern; a listed failure pattern ends
# the run with what the board printed.
proc sw {cmd pat tmo {bad {}}} {
    global con
    send -i $con -- "$cmd\r"
    # Anchored on the board's echo of the line, so a prompt left over from before
    # the command cannot stand in for the one after it.
    set timeout 10
    expect {
        -i $con -ex $cmd { }
        -i $con timeout  { die "the board did not echo '$cmd'" }
        -i $con eof      { die "the console closed after '$cmd'" }
    }
    w $pat $tmo "/$pat/ after '$cmd'" $bad
}
proc w {pat tmo what {bad {}}} {
    global con
    if {$bad eq ""} { set bad {\#\#\#\# NEVER \#\#\#\#} }
    set timeout $tmo
    # The expected pattern first: where both match, it wins.
    expect {
        -i $con -re $pat { return $expect_out(buffer) }
        -i $con -re $bad { die "$what: the board printed '[string trim $expect_out(0,string)]'" }
        -i $con timeout  { die "no $what in ${tmo} s" }
        -i $con eof      { die "the console closed waiting for $what" }
    }
}
proc wx {str tmo what} {
    global con
    set timeout $tmo
    expect {
        -i $con -ex $str { return }
        -i $con timeout  { die "no $what in ${tmo} s (want '$str')" }
        -i $con eof      { die "the console closed waiting for $what" }
    }
}
# Read until the console has been quiet for a second.
proc drain {} {
    global con
    set timeout 1
    expect {
        -i $con -re {.+} { exp_continue }
        -i $con timeout { }
        -i $con eof { die "the console closed" }
    }
}

# Run a JTAG command to completion while a Ctrl-C goes to the console every
# second: the board resets as it finishes, and with a short bootdelay a
# countdown cannot be caught by reacting to it -- a key has to be waiting when
# U-Boot looks.
proc jtag_run {argl okpat what tmo} {
    global con jout opt
    set jout ""
    if {[catch {spawn -noecho {*}$argl} err]} { die "$what: $err" }
    set j $spawn_id
    set end [expr {[clock seconds] + $tmo}]
    set last 0
    while {1} {
        set timeout 1
        expect {
            -i $j -re {([^\r\n]*)[\r\n]+} {
                set l $expect_out(1,string)
                append jout "$l\n"
                if {$l ne "" && !$opt(verbose)} { puts "  | $l"; flush stdout }
                if {[regexp $okpat $l]} { break }
                if {[regexp {FAIL --} $l]} { die "$what: $l" }
            }
            -i $j eof { die "$what ended without /$okpat/" }
            -i $con -re {.+} { }
            -i $con eof { die "the console closed during $what, which was stopped mid-way: run again" }
            timeout { }
        }
        if {[clock milliseconds] - $last >= 1000} { send -i $con -- "\003"; set last [clock milliseconds] }
        if {[clock seconds] > $end} { die "$what did not finish in $tmo s" }
    }
    catch {close -i $j}
    catch {wait -i $j}
}

# The U-Boot prompt from wherever the board is: at the prompt, counting down,
# or booting or booted into Linux (target_som-stm32f7.exp,
# get_target_console_prompt). Ctrl-C, never a bare Enter: U-Boot repeats the
# last command on an empty line.
proc to_uboot {} {
    global con UPROMPT LPROMPT
    set timeout 4
    send -i $con -- "\003"
    expect {
        -i $con -re "Hit any key to stop autoboot" { send -i $con -- " "; settle; return }
        -i $con -ex $UPROMPT { settle; return }
        -i $con -ex $LPROMPT { }
        -i $con -re {.+} { }
        -i $con timeout { die "the console is silent: is it the board's console, and is the board powered?" }
        -i $con eof { die "the console closed" }
    }
    set timeout 40
    send -i $con -- "\003"
    expect {
        -i $con -ex $UPROMPT { settle; return }
        -i $con -ex $LPROMPT { }
        -i $con timeout { die "no U-Boot or Linux prompt on the console" }
        -i $con eof { die "the console closed" }
    }
    send -i $con -- "reboot -f\r"
    w "Hit any key to stop autoboot" 40 "autoboot after reboot -f"
    send -i $con -- " "
    settle
}
# A prompt is trusted only once a Ctrl-C brings it straight back: a reset still
# in flight prints its banner after the first prompt, and its countdown would
# swallow the next command.
proc settle {} {
    global con UPROMPT
    for {set i 0} {$i < 6} {incr i} {
        drain
        send -i $con -- "\003"
        set timeout 3
        expect {
            -i $con -re {U-Boot 20} { continue }
            -i $con -re "Hit any key to stop autoboot" { send -i $con -- " "; continue }
            -i $con -ex $UPROMPT { return }
            -i $con timeout { }
            -i $con eof { die "the console closed" }
        }
    }
    die "the U-Boot prompt did not settle"
}

# A command that starts a TFTP fetch, timed in parts from the console: to the
# first block (U-Boot prints "T " per request that timed out), then the blocks.
# Returns {ok <total> <to-first-block> <blocks> <timeouts-before> <timeouts-during>},
# or {retry} when U-Boot gave the fetch up, before its first block or during the
# blocks: it would start it again by itself, so it is stopped with a Ctrl-C,
# which also ends the rest of the command (the NOR erase and write of update),
# and the caller runs the command again (lib.exp tftp_load_uboot).
proc ntimeouts {str} { regexp -all {(?:^|[^A-Za-z0-9])T(?= )} $str }
proc tftp_timed {cmd} {
    global con KSIZE NETIF
    set giveup {(ARP )?Retry count exceeded}
    set bad {TFTP error[^\r\n]*|File not found[^\r\n]*}
    set t0 [clock milliseconds]
    send -i $con -- "$cmd\r"
    set timeout 10
    expect {
        -i $con -ex $cmd { }
        -i $con timeout  { stop_board; die "the board did not echo '$cmd'" }
        -i $con eof      { die "the console closed after '$cmd'" }
    }
    set timeout 120
    expect {
        -i $con -re {Loading: ([^#]*)#} {
            set t1 [clock milliseconds]
            set pre [ntimeouts $expect_out(1,string)]
        }
        -i $con -re $giveup { stop_board; settle; return retry }
        -i $con -re $bad { stop_board; die "the fetch: the board printed '[string trim $expect_out(0,string)]'[carrier_note]" }
        -i $con timeout  { stop_board; die "no first block from this station's TFTP server in 120 s[carrier_note]" }
        -i $con eof      { die "the console closed during the fetch" }
    }
    set timeout 600
    expect {
        -i $con -re "Bytes transferred = $KSIZE " { set t2 [clock milliseconds]; set mid [ntimeouts $expect_out(buffer)] }
        # The size only counts once its " (" has come: the console can split the line.
        -i $con -re {Bytes transferred = ([0-9]+) \(} { stop_board; die "the board received $expect_out(1,string) bytes, want $KSIZE" }
        -i $con -re $giveup { stop_board; settle; return retry }
        -i $con -re $bad { stop_board; die "the fetch: the board printed '[string trim $expect_out(0,string)]'[carrier_note]" }
        -i $con timeout  { stop_board; die "the fetch did not end in 600 s" }
        -i $con eof      { die "the console closed during the fetch" }
    }
    lassign [list [expr {($t2 - $t0) / 1000.0}] [expr {($t1 - $t0) / 1000.0}] [expr {($t2 - $t1) / 1000.0}]] fd f1 f2
    say [format "SPLIT tftp: fetch %.1f s = first block %.1f s (%d timeouts) + blocks %.1f s (%d timeouts)" $fd $f1 $pre $f2 $mid]
    return [list ok $fd $f1 $f2 $pre $mid]
}
# A Ctrl-C stops whatever U-Boot is running and the commands chained after it,
# so a failed run never leaves the board to go on writing NOR by itself.
proc stop_board {} {
    global con
    catch {send -i $con -- "\003"}
}
proc carrier_note {} {
    global NETIF
    if {$NETIF eq "" || [catch {open /sys/class/net/$NETIF/carrier r} fh]} { return "" }
    set c [string trim [read $fh]]
    close $fh
    if {$c eq "1"} { return "; $NETIF has a carrier" }
    return "; $NETIF has NO carrier: is the cable in the board's RJ-45?"
}

# ============================================================================
# The run: target_som-stm32f7, step for step.
# ============================================================================

# 1. U-Boot into the eNVM over JTAG. openocd verifies the write; a bad one shows
#    itself in step 2, where U-Boot would not reach its prompt.
step 1 "U-Boot into the eNVM (som-program-f7)"
set wrote 1
jtag_run [list som-program-f7 --no-backup --no-readback {*}$progargs] {PASS -- wrote} "som-program-f7" 600
set uimg $F7_DIR/u-boot.bin
regexp -line {image:\s+(\S+)} $jout -> uimg
set uprov [file dirname $uimg]/PROVENANCE
if {![file readable $uprov]} {
    say "no PROVENANCE beside $uimg: checking against $F7_DIR/PROVENANCE"
    set uprov $F7_DIR/PROVENANCE
}
set up [read_prov $uprov]
foreach k {version prompt} {
    if {![dict exists $up $k]} { die "$uprov has no $k: line" }
}
set UPROMPT [dict get $up prompt]
set UBVERSION [dict get $up version]
done

# 2. The U-Boot prompt, and the MAC the board has now.
step 2 "the U-Boot prompt"
to_uboot
set e [sw "printenv ethaddr" [rx_quote $UPROMPT] 10]
set had ""
regexp {ethaddr=([0-9A-Fa-f:]{17})} $e -> had
set had [string toupper $had]
say "the board's ethaddr: [expr {$had eq "" ? "none" : $had}]"
if {$opt(keepmac)} {
    if {$had eq "" || $had eq $DEFAULT_MAC} {
        die "--keep-mac, but the board has no MAC of its own ([expr {$had eq "" ? "none set" : "U-Boot's built-in $had"}]): give one with --mac, or use the MAC list"
    }
    set MAC $had
}
done

# 3. Erase the saved environment, and the sector after it (lib.exp
#    som_stm32f7_erase_nor).
step 3 "erase the environment in NOR"
sw "prot off all" [rx_quote $UPROMPT] 10
sw "erase 60000000 +20001" [rx_quote $UPROMPT] 30 {Error[^\r\n]*|[Ff]ailed[^\r\n]*}
done

# 4. Reset into the default environment, customise it, save it (lib.exp
#    som_customise_env). The MAC is recorded as handed out here, before it is
#    given to the board, as getmac's caller does.
step 4 "the environment: addresses, MAC $MAC"
send -i $con -- "reset\r"
w "bad CRC" 20 "the default-environment warning after the erase"
w "Hit any key to stop autoboot" 10 "autoboot"
send -i $con -- " "
w [rx_quote $UPROMPT] 5 "the U-Boot prompt"
if {$opt(mac) eq "" && !$opt(keepmac)} {
    mac_record $MAC
    say "lastmac: $MAC recorded"
}
sw "setenv serverip $opt(station)" [rx_quote $UPROMPT] 5
sw "setenv ipaddr $opt(board)" [rx_quote $UPROMPT] 5
sw "setenv ethaddr $MAC" [rx_quote $UPROMPT] 5
sw "setenv bootdelay 1" [rx_quote $UPROMPT] 5
saveenv
done

# 5. The kernel into NOR from this station's TFTP server (lib.exp
#    som_program_uimage). Its CRC is checked by bootm when step 6 boots it.
step 5 "the kernel into NOR (run update)"
sw "setenv image $TFTP_KERNEL" [rx_quote $UPROMPT] 5
# The board's first ARP often beats the adapter's link-up report and is lost: retry in 1 s.
sw "setenv tftptimeout 1000" [rx_quote $UPROMPT] 5
for {set attempt 1} {1} {incr attempt} {
    set s5 [clock milliseconds]
    set f [tftp_timed "run update"]
    if {[lindex $f 0] eq "ok"} break
    if {$attempt >= 5} { die "U-Boot gave the fetch up $attempt times (Retry count exceeded)[carrier_note]" }
    say "fetch $attempt: U-Boot gave it up (Retry count exceeded); stopped it, running update again"
}
set nor {Error[^\r\n]*|ERROR[^\r\n]*|not [Ee]rased[^\r\n]*|[Ff]ailed[^\r\n]*}
w {Un-Protected [0-9]+ sectors} 120 "'Un-Protected' after the fetch" $nor
set tp [clock milliseconds]
w {Erased [0-9]+ sectors} 300 "the NOR erase" $nor
set te [clock milliseconds]
w {Copy to Flash\.\.\. done} 300 "the NOR copy" $nor
set tc [clock milliseconds]
w {Writing to Flash\.\.\. done} 60 "update's saveenv" $nor
w [rx_quote $UPROMPT] 60 "the prompt after update's saveenv"
set ts [clock milliseconds]
set tf [expr {$s5 + int([lindex $f 1] * 1000)}]
say [format "SPLIT 5: fetch %.1f s, prot off %.1f s, erase %.1f s, copy %.1f s, saveenv %.1f s" \
    [lindex $f 1] [expr {($tp - $tf) / 1000.0}] [expr {($te - $tp) / 1000.0}] \
    [expr {($tc - $te) / 1000.0}] [expr {($ts - $tc) / 1000.0}]]
done

# 6. Boot what was written; the versions; the link; the board pings this
#    station (lib.exp som_test_io).
step 6 "boot it; versions, link, the board pings $opt(station)"
send -i $con -- "reset\r"
wx $UBVERSION 15 "the U-Boot banner"
w $IMGCHECK 30 "the kernel's image name ($KVERSION)"
w {Verifying Checksum \.\.\. OK} 60 "bootm's checksum of the kernel in NOR" {Bad Data CRC|Bad Header Checksum|ERROR[^\r\n]*}
w $LXCHECK 60 "the Linux banner"
# lib.exp waits up to 15 s for the PHY's link line before it pings.
set timeout 15
set linkline 0
expect {
    -i $con -re {[^\r\n]*[Ll]ink is [Uu]p[^\r\n]*} { set linkline 1; say "link: [string trim $expect_out(0,string)]" }
    -i $con timeout { say "no link line in 15 s" }
    -i $con eof { die "the console closed" }
}
set ok 0
for {set i 0} {$i < 10 && !$ok} {incr i} {
    set timeout 5
    send -i $con -- "\003"
    expect {
        -i $con -ex $LPROMPT { set ok 1 }
        -i $con timeout { }
        -i $con eof { die "the console closed" }
    }
}
if {!$ok} { die "no Linux shell prompt" }
# Where no link line came, one ping at a time until one is answered stands in
# for that wait.
set up $linkline
for {set i 0} {$i < 15 && !$up} {incr i} {
    send -i $con -- "ping -c 1 $opt(station)\r"
    set timeout 15
    expect {
        -i $con -re {, 1 packets received} { set up 1 }
        -i $con -re {, 0 packets received|[Uu]nreachable} { }
        -i $con timeout { die "no answer to a link ping in 15 s" }
        -i $con eof { die "the console closed" }
    }
    wx $LPROMPT 5 "the prompt after a link ping"
}
if {!$up} { die "the board's link did not come up[carrier_note]" }
sw "ping -c 3 $opt(station)" {3 packets transmitted, 3 packets received, 0% packet loss} 30 \
    {[0-9]+ packets transmitted, [0-2] packets received[^\r\n]*}
wx $LPROMPT 5 "the prompt after ping"
done

# 7. The environment the board ships with (lib.exp som_customise_env_final).
step 7 "the shipping environment"
send -i $con -- "reboot -f\r"
w "Hit any key to stop autoboot" 40 "autoboot after reboot -f"
send -i $con -- " "
w [rx_quote $UPROMPT] 5 "the U-Boot prompt"
sw "setenv serverip $SHIP_SERVER" [rx_quote $UPROMPT] 5
sw "setenv ipaddr $SHIP_IPADDR" [rx_quote $UPROMPT] 5
sw "setenv gatewayip $SHIP_GATEWAY" [rx_quote $UPROMPT] 5
sw "setenv image $SHIP_IMAGE" [rx_quote $UPROMPT] 5
sw "setenv bootdelay $SHIP_BOOTDELAY" [rx_quote $UPROMPT] 5
# Saved by update in step 5; the shipping environment has none.
sw "setenv tftptimeout" [rx_quote $UPROMPT] 5
saveenv
done

# 8. The reset button (lib.exp som_test_reset): a hand on the board.
if {$opt(resettest)} {
    step 8 "the reset button: press it now"
    wx $UBVERSION 300 "the U-Boot banner after the reset button"
    w $LXCHECK 60 "the Linux banner after the reset button"
    done
}

foreach s $steps {
    say [format "  %-2s %-58s %6.1f s" [lindex $s 0] [lindex $s 1] [lindex $s 2]]
}
set prog 0.0
foreach s $steps { if {[lindex $s 0] ne "0"} { set prog [expr {$prog + [lindex $s 2]}] } }
say [format "programming, steps 1-%s: %.1f s" [lindex [lindex $steps end] 0] $prog]
say [format "PASS -- %s programmed in %.1f s%s" $MAC $prog \
    [expr {$opt(resettest) ? "" : " (reset button not tested: --reset-test)"}]]
exit 0