# wget-httpd.tcl -- a loopback HTTP origin server AND the wget runs against it,
# in ONE process, for tests/60-wget.test. Prints tagged `W-<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
# server and then runs a client has no way to wait for the listening socket --
# the race cannot be closed from sh. Binding first and starting every client
# from inside the event loop makes the ordering structural instead of timed.
#
# Every URL below is a dotted quad. wget here is built --disable-ipv6, so it
# resolves a numeric host with inet_addr() and returns before getaddrinfo; a
# NAME would go to gethostbyname and the static-glibc NSS trap (BRINTOS-77),
# taking the process with it.

set BODY "wget-loopback-ok\n"
set BIGN 4096
set SERVED 0

proc reply {ch code reason ctype payload head_only extra} {
    fconfigure $ch -translation binary
    set hdr "HTTP/1.0 $code $reason\r\n"
    append hdr "Content-Type: $ctype\r\n"
    append hdr "Content-Length: [string length $payload]\r\n"
    append hdr $extra
    append hdr "\r\n"
    puts -nonewline $ch $hdr
    if {!$head_only} { puts -nonewline $ch $payload }
    flush $ch
}

proc accept {ch addr port} {
    global BODY BIGN SERVED PORT
    incr SERVED
    fconfigure $ch -translation crlf -blocking 1
    if {[gets $ch req] < 0} { close $ch; return }
    # drain the request headers; we answer from the request line alone
    while {[gets $ch h] >= 0 && $h ne ""} {}
    lassign [split [string trim $req] " "] meth path
    set head [expr {$meth eq "HEAD"}]
    switch -glob -- $path {
        /hello    { reply $ch 200 OK "text/plain" $BODY $head "" }
        /gzip     { reply $ch 200 OK "text/plain" [zlib gzip $BODY] $head \
                        "Content-Encoding: gzip\r\n" }
        /big      { reply $ch 200 OK "application/octet-stream" \
                        [string repeat "0123456789abcdef" [expr {$BIGN / 16}]] $head "" }
        /redirect { reply $ch 302 Found "text/plain" "" $head \
                        "Location: http://127.0.0.1:$PORT/hello\r\n" }
        default   { reply $ch 404 "Not Found" "text/plain" "no such object\n" $head "" }
    }
    close $ch
}

# --- client side: run one wget, event-driven so accept can still fire ---------
proc runcmd {argv} {
    set ::buf ""
    set ::fin 0
    set f [open "|$argv 2>@1" r]
    fconfigure $f -blocking 0
    fileevent $f readable [list drain $f]
    vwait ::fin
    return [list $::rc $::buf]
}

proc drain {f} {
    if {[eof $f]} {
        # the exit status is only reported on a BLOCKING close
        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 emit {key value} { puts "W-$key $value" }
proc oneline {s} { string map [list \r "" \n " "] [string trim $s] }

# --- bring the server up before any client exists -----------------------------
if {[catch {set srv [socket -server accept -myaddr 127.0.0.1 0]} err]} {
    emit listen-error [oneline $err]
    exit 1
}
set PORT [lindex [fconfigure $srv -sockname] 2]
emit port $PORT

# A port with nothing on it, for the connection-refused case: 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

set U "http://127.0.0.1:$PORT"
set OUT /tmp/bst-wget.[pid]

lassign [runcmd "wget -q -O - $U/hello"] rc out
emit get-rc $rc
emit get-body [oneline $out]

lassign [runcmd "wget -q -O $OUT.big $U/big"] rc out
emit big-rc $rc
emit big-size [expr {[file exists $OUT.big] ? [file size $OUT.big] : -1}]

lassign [runcmd "wget -O /dev/null $U/missing"] rc out
emit 404-rc $rc
emit 404-msg [oneline $out]

lassign [runcmd "wget --spider $U/hello"] rc out
emit spider-rc $rc

lassign [runcmd "wget -q -O - $U/redirect"] rc out
emit redirect-rc $rc
emit redirect-body [oneline $out]

# --compression exists only under HAVE_LIBZ, so this run is the zlib link
# assertion as well as a Content-Encoding one. Tcl's own zlib is what builds the
# payload; if this tclsh was built without it, say so rather than fail.
if {[catch {zlib gzip "probe"}]} {
    emit gzip-rc skip
    emit gzip-body skip
} else {
    lassign [runcmd "wget -q --compression=auto -O - $U/gzip"] rc out
    emit gzip-rc $rc
    emit gzip-body [oneline $out]
}

lassign [runcmd "wget -O /dev/null http://127.0.0.1:$DEADPORT/hello"] rc out
emit refused-rc $rc
emit refused-msg [oneline $out]

file delete -force $OUT.big
close $srv
emit served $SERVED
puts "ALL-WGET-OK"