# netcat-loopback.tcl -- the network half of tests/61-netcat.test: a tcl peer and
# the netcat runs against it, in ONE process. Prints tagged `N-<key> <value>`
# lines the .test asserts on.
#
# One process is not a convenience. This target has no working relative timer --
# sleep is a no-op and timeout(1) never fires -- so a shell that backgrounds a
# peer and then runs the other side has no way to wait for the listening socket.
# Binding the tcl peer BEFORE any netcat exists makes that ordering structural.
# The one place netcat itself is the listener (section 6) has no peer to bind
# first, so the race is closed by retrying connect(2) until it succeeds:
# ECONNREFUSED until netcat binds, measured at ~15 attempts / 0.4 s on target.
#
# The peer's three ACCEPT MODES are load-bearing, not incidental. A peer that
# reads to EOF deadlocks against a netcat that is not closing (no -c), and a
# peer that writes and then reads deadlocks against one that is; each section
# below names the mode that terminates for the shape it is testing.
#
# Every address here is a dotted quad. The resolver cases live in the .test,
# where being a name IS the case.

proc emit {k v} { puts "N-$k $v" }
proc oneline {s} { string map [list \r "" \n " "] [string trim $s] }

set ::SERVED 0
set ::GOT ""
set ::PEERADDR ""
set ::PEERPORT ""
set ::REPLY ""
set ::MODE read-close

proc accept {ch addr port} {
    incr ::SERVED
    set ::PEERADDR $addr
    set ::PEERPORT $port
    fconfigure $ch -translation binary -blocking 1
    switch -- $::MODE {
        read-close  { set ::GOT [read $ch] }
        write-close { catch {puts -nonewline $ch $::REPLY; flush $ch} }
    }
    catch {close $ch}
}

# runcmd -- run one command to completion, event-driven, so accept can still
# fire while it runs. The exit status is only reported on a BLOCKING close.
proc runcmd {argv} {
    set ::buf ""; set ::fin 0
    if {[catch {set f [open "|$argv 2>@1" r]} err]} { return [list -99 $err] }
    fconfigure $f -blocking 0 -translation binary
    fileevent $f readable [list drain $f]
    vwait ::fin
    return [list $::rc $::buf]
}
proc drain {f} {
    if {[eof $f]} {
        fconfigure $f -blocking 1
        set rc 0
        if {[catch {close $f}]} {
            if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
                set rc [lindex $::errorCode 2]
            } else { set rc -1 }
        }
        set ::rc $rc; set ::fin 1
    } else { append ::buf [read $f] }
}
proc slurp {p} {
    if {![file exists $p]} { return "<missing>" }
    set f [open $p r]; fconfigure $f -translation binary
    set d [read $f]; close $f; return $d
}

set TMP /tmp/bst-netcat.[pid]
file delete -force $TMP
file mkdir $TMP

set fh [open $TMP/in w]; fconfigure $fh -translation binary
puts -nonewline $fh "nc-client-ok\n"; close $fh

set srv [socket -server accept -myaddr 127.0.0.1 0]
set PORT [lindex [fconfigure $srv -sockname] 2]
emit port $PORT

# A port with nothing on it: bind one, read its number, drop it. It never
# accepted a connection, so it is free immediately.
set dead [socket -server {apply {{a b c} {}}} -myaddr 127.0.0.1 0]
set DEADPORT [lindex [fconfigure $dead -sockname] 2]
close $dead
emit deadport $DEADPORT

# what /bin/sh actually is decides how -e behaves (section 8)
emit sh [file tail [file readlink /bin/sh]]

# --- 1. netcat as CLIENT: stdin reaches the peer byte-for-byte ---------------
set ::MODE read-close
lassign [runcmd "nc -n -w 2 -c 127.0.0.1 $PORT < $TMP/in"] rc out
emit client-rc $rc
emit client-served $::SERVED
emit client-got [oneline $::GOT]

# --- 2. the OTHER direction: the peer writes, netcat prints it ---------------
# No -c here, deliberately: -c closes on stdin EOF, and with /dev/null on stdin
# that EOF is immediate. See 2b.
set ::MODE write-close
set ::REPLY "server-said-hi\n"
lassign [runcmd "nc -n -w 2 127.0.0.1 $PORT < /dev/null"] rc out
emit reply-rc $rc
emit reply-out [oneline $out]

# a bigger reply, so the case covers a read loop rather than one short read
set ::REPLY [string repeat "0123456789abcdef" 256]
lassign [runcmd "nc -n -w 2 127.0.0.1 $PORT < /dev/null"] rc out
emit bigreply-rc $rc
emit bigreply-len [string length [string map [list \r "" \n ""] $out]]

# --- 2b. what -c COSTS: it closes before draining what is already inbound ----
# Same peer, same data, only -c added. Upstream semantics, and identical on a
# native x86_64 build -- worth pinning precisely because it looks like data loss.
set ::REPLY "server-said-hi\n"
lassign [runcmd "nc -n -w 2 -c 127.0.0.1 $PORT < /dev/null"] rc out
emit ceof-rc $rc
emit ceof-out [oneline $out]
set ::REPLY ""

# --- 3. -p local source port, and -s source address --------------------------
set ::MODE read-close
set LP [expr {$PORT + 101}]
lassign [runcmd "nc -n -w 2 -c -p $LP 127.0.0.1 $PORT < $TMP/in"] rc out
emit lport-rc $rc
emit lport-match [expr {$::PEERPORT == $LP}]

lassign [runcmd "nc -n -w 2 -c -s 127.0.0.1 127.0.0.1 $PORT < $TMP/in"] rc out
emit saddr-rc $rc
emit saddr-seen $::PEERADDR

# --- 4. binary transparency: all 256 byte values ------------------------------
set fh [open $TMP/bin w]; fconfigure $fh -translation binary
for {set i 0} {$i < 256} {incr i} { puts -nonewline $fh [binary format c $i] }
close $fh
set ::GOT ""
lassign [runcmd "nc -n -w 2 -c 127.0.0.1 $PORT < $TMP/bin"] rc out
emit bin-rc $rc
emit bin-len [string length $::GOT]
binary scan $::GOT H* hex
emit bin-head [string range $hex 0 15]
emit bin-tail [string range $hex end-15 end]

# --- 5. -o hexdump of the traffic --------------------------------------------
set ::GOT ""
lassign [runcmd "nc -n -w 2 -c -o $TMP/hex 127.0.0.1 $PORT < $TMP/in"] rc out
emit odump-rc $rc
emit odump-line1 [oneline [lindex [split [slurp $TMP/hex] \n] 0]]

# --- 6. netcat as LISTENER -- the capability this port ADDS -------------------
# busybox's applet is built with CONFIG_NC_SERVER unset, so nothing on this
# image could accept an inbound connection from the shell before netcat.
set P2 [expr {$PORT + 7}]
if {[catch {set lf [open "|nc -n -l -p $P2 2>@1" r]} err]} {
    emit listen-open-error [oneline $err]
    emit listen-connected 0
} else {
    fconfigure $lf -blocking 0 -translation binary
    fileevent $lf readable [list drain $lf]
    set ::buf ""; set ::fin 0
    set s ""; set tries 0
    for {set i 0} {$i < 4000} {incr i} {
        incr tries
        if {![catch {set s [socket 127.0.0.1 $P2]}]} { break }
        set s ""
    }
    emit listen-tries $tries
    if {$s eq ""} {
        emit listen-connected 0
        catch {close $lf}
    } else {
        emit listen-connected 1
        fconfigure $s -translation binary -blocking 1
        puts -nonewline $s "nc-listen-ok\n"; flush $s
        close $s
        vwait ::fin
        emit listen-rc $::rc
        emit listen-out [oneline $::buf]
    }
}

# --- 7. UDP, both directions --------------------------------------------------
# The listener writes to a FILE, so its pipe is write-only and Tcl never tries
# to read a redirected stdout. It is reaped by pid, not by EOF: a UDP listener
# has no peer close to end it.
set P3 [expr {$PORT + 23}]
if {[catch {set uf [open "|nc -u -n -l -p $P3 > $TMP/uout 2>$TMP/uerr" w]} err]} {
    emit udp-open-error [oneline $err]
} else {
    set upids [pid $uf]
    lassign [runcmd "nc -u -n -w 2 -c 127.0.0.1 $P3 < $TMP/in"] rc out
    emit udp-c1-rc $rc
    # A GNU netcat UDP listener connect(2)s to the first peer it hears, so a
    # SECOND sender's datagram draws ICMP port-unreachable. Documented one-peer
    # semantics, not a failure -- assert it rather than leave it a surprise.
    lassign [runcmd "nc -u -n -w 2 -c 127.0.0.1 $P3 < $TMP/in"] rc out
    emit udp-c2-rc $rc
    foreach p $upids { catch {exec kill -TERM $p} }
    catch {close $uf}
    emit udp-got [oneline [slurp $TMP/uout]]
}

# --- 8. -e: exec a program on connect, its stdout IS the socket ---------------
# netcat runs `execl("/bin/sh", basename(PROGRAM), "-c", PROGRAM)` -- it passes
# the program's BASENAME as the shell's argv[0]. bash and dash ignore argv[0];
# busybox DISPATCHES on it. So on a busybox-/bin/sh image the payload has to be
# named `sh`, and (measured) needs a shebang. Both spellings are run here and
# the .test asserts whichever contract /bin/sh implies.
file mkdir $TMP/d
set fh [open $TMP/d/sh w]; puts $fh "#!/bin/sh"; puts $fh "echo nc-exec-ok"; close $fh
file attributes $TMP/d/sh -permissions 0755
set ::GOT ""
lassign [runcmd "nc -n -w 2 -e $TMP/d/sh 127.0.0.1 $PORT"] rc out
emit exec-rc $rc
emit exec-got [oneline $::GOT]

# the same script under a name that is NOT a shell: this is where the argv[0]
# hand-off becomes visible.
set fh [open $TMP/e.sh w]; puts $fh "#!/bin/sh"; puts $fh "echo nc-exec-ok"; close $fh
file attributes $TMP/e.sh -permissions 0755
set ::GOT ""
lassign [runcmd "nc -n -w 2 -e $TMP/e.sh 127.0.0.1 $PORT"] rc out
emit execbad-rc $rc
emit execbad-got [oneline $::GOT]
emit execbad-out [oneline [string range $out 0 120]]

# --- 9. -z port scanning, and the statistics -v -v prints ---------------------
lassign [runcmd "nc -z -v -n -w 2 127.0.0.1 $PORT"] rc out
emit scan-open-rc $rc
emit scan-open-out [oneline $out]

lassign [runcmd "nc -z -v -n -w 2 127.0.0.1 $DEADPORT"] rc out
emit scan-closed-rc $rc

set lo [expr {$PORT - 2}]; set hi [expr {$PORT + 2}]
lassign [runcmd "nc -z -v -n -w 2 127.0.0.1 $lo-$hi"] rc out
emit range-open-rc $rc
emit range-open-out [oneline [string range $out 0 120]]

set dlo [expr {$DEADPORT - 4}]; set dhi $DEADPORT
lassign [runcmd "nc -z -v -n -w 2 127.0.0.1 $dlo-$dhi"] rc out
emit range-closed-rc $rc

set ::GOT ""
lassign [runcmd "nc -n -v -v -w 2 -c 127.0.0.1 $PORT < $TMP/in"] rc out
emit vv-rc $rc
emit vv-out [oneline [string range $out 0 160]]

# --- 10. -T telnet negotiation ------------------------------------------------
set ::GOT ""
lassign [runcmd "nc -n -w 2 -c -T 127.0.0.1 $PORT < $TMP/in"] rc out
emit telnet-rc $rc
emit telnet-got [oneline $::GOT]

close $srv
emit served $::SERVED
file delete -force $TMP
puts "ALL-NETCAT-OK"