security: reject duplicate Transfer-Encoding + close WASM parser fallback bypass

ober

8d335c1b2a7fe2501c75a89d315734d92e83df3e

diff --git a/lib/jerboa-https/httpd.sls b/lib/jerboa-https/httpd.sls
index aa7c2a2..6268b05 100644
--- a/lib/jerboa-https/httpd.sls
+++ b/lib/jerboa-https/httpd.sls
@@ -425,10 +425,13 @@
   (def (read-request-body reader headers)
        (let ([cl (assoc "content-length" headers)]
              [te (assoc "transfer-encoding" headers)]
-             [cl-count (header-count "content-length" headers)])
+             [cl-count (header-count "content-length" headers)]
+             [te-count (header-count "transfer-encoding" headers)])
          (cond
            [(> cl-count 1)
             (error 'read-request-body "duplicate content-length")]
+           [(> te-count 1)
+            (error 'read-request-body "duplicate transfer-encoding")]
            [(and cl te)
             (error 'read-request-body
               "conflicting content-length and transfer-encoding")]
diff --git a/lib/jerboa-https/wasm-http.sls b/lib/jerboa-https/wasm-http.sls
index 561d8ee..0986e83 100644
--- a/lib/jerboa-https/wasm-http.sls
+++ b/lib/jerboa-https/wasm-http.sls
@@ -241,10 +241,19 @@
                      (cond
                        [(or (eq? n (void)) (not (integer? n)))
                         (error 'http-parser "sandbox returned no value")]
-                       [(sandbox-error? n) (fallback fallback-line)]
+                       [(sandbox-error? n)
+                        (if (require-http-parser-sandbox?)
+                            (error 'http-parser
+                              "strict http parser rejected input"
+                              n)
+                            (fallback fallback-line))]
                        [(negative? n)
                         (error 'http-parser "sandbox runtime error" n)]
-                       [(zero? n) (fallback fallback-line)]
+                       [(zero? n)
+                        (if (require-http-parser-sandbox?)
+                            (error 'http-parser
+                              "strict http parser produced no output")
+                            (fallback fallback-line))]
                        [else
                         (decoder
                           (wasm-sandbox-memory-read inst out-ptr n)
@@ -293,11 +302,20 @@
                 (string-downcase (substring line 0 colon))
                 (string-trim-left
                   (substring line (+ colon 1) (string-length line)))))))
+  (def (hex-digit-char? c)
+       (or (char<=? #\0 c #\9)
+           (char<=? #\a c #\f)
+           (char<=? #\A c #\F)))
   (def (parse-chunk-size-fallback line)
        (let* ([semi (string-index line #\;)]
-              [token (string-trim
-                       (if semi (substring line 0 semi) line))])
-         (string->number token 16)))
+              [token (string-trim (if semi (substring line 0 semi) line))]
+              [n (string-length token)])
+         (and (> n 0)
+              (let loop ([i 0])
+                (or (= i n)
+                    (and (hex-digit-char? (string-ref token i))
+                         (loop (+ i 1)))))
+              (string->number token 16))))
   (def (parse-request-line-sandboxed line)
        (call-parser line MAX-LINE "parse_request_line"
          decode-request-output parse-request-line-fallback))
diff --git a/src/jerboa-https/httpd.ss b/src/jerboa-https/httpd.ss
index 77c515a..5ccf2d0 100644
--- a/src/jerboa-https/httpd.ss
+++ b/src/jerboa-https/httpd.ss
@@ -520,10 +520,19 @@
     ;; Returns bytevector or #f.
     (let ([cl (assoc "content-length" headers)]
           [te (assoc "transfer-encoding" headers)]
-          [cl-count (header-count "content-length" headers)])
+          [cl-count (header-count "content-length" headers)]
+          [te-count (header-count "transfer-encoding" headers)])
       (cond
         [(> cl-count 1)
          (error 'read-request-body "duplicate content-length")]
+        ;; RFC 7230 §3.3.1: a sender MUST NOT apply multiple Transfer-Encoding
+        ;; codings unless chunked is the outermost, and a server that cannot
+        ;; determine framing must reject. assoc returns only the FIRST TE header,
+        ;; so a second one would be silently ignored here while a front-end proxy
+        ;; may honor the last/combined value -- a classic TE-TE desync. Reject any
+        ;; duplicate outright, matching the response validator below.
+        [(> te-count 1)
+         (error 'read-request-body "duplicate transfer-encoding")]
         [(and cl te)
          (error 'read-request-body "conflicting content-length and transfer-encoding")]
         [(and te (not (header-ci=? (cdr te) "chunked")))
diff --git a/src/jerboa-https/wasm-http.ss b/src/jerboa-https/wasm-http.ss
index a4b7b72..feaf2a1 100644
--- a/src/jerboa-https/wasm-http.ss
+++ b/src/jerboa-https/wasm-http.ss
@@ -258,10 +258,23 @@
                   (cond
                     [(or (eq? n (void)) (not (integer? n)))
                      (error 'http-parser "sandbox returned no value")]
-                    [(sandbox-error? n) (fallback fallback-line)]
+                    ;; A negative sandbox-error code means the STRICT parser
+                    ;; rejected the input as malformed. When the sandbox is
+                    ;; required we must fail closed here: falling back to the
+                    ;; lenient Scheme parser would let an attacker bypass the
+                    ;; strictness the WASM module exists to enforce simply by
+                    ;; sending input it rejects (e.g. a signed chunk size), even
+                    ;; with JHTTPS_REQUIRE_WASM_HTTP=1.
+                    [(sandbox-error? n)
+                     (if (require-http-parser-sandbox?)
+                         (error 'http-parser "strict http parser rejected input" n)
+                         (fallback fallback-line))]
                     [(negative? n)
                      (error 'http-parser "sandbox runtime error" n)]
-                    [(zero? n) (fallback fallback-line)]
+                    [(zero? n)
+                     (if (require-http-parser-sandbox?)
+                         (error 'http-parser "strict http parser produced no output")
+                         (fallback fallback-line))]
                     [else
                      (decoder (wasm-sandbox-memory-read inst out-ptr n) n)]))))))))
 
@@ -300,13 +313,29 @@
                  (string-trim-left
                   (substring line (+ colon 1) (string-length line)))))))
 
+  (def (hex-digit-char? c)
+    (or (char<=? #\0 c #\9)
+        (char<=? #\a c #\f)
+        (char<=? #\A c #\F)))
+
   (def (parse-chunk-size-fallback line)
+    ;; Match the strict WASM parser (do_parse_chunk_size): a chunk size is a
+    ;; non-empty run of hex digits only. string->number would also accept a
+    ;; leading +/- sign in radix 16 (e.g. "+5" -> 5, "-5" -> -5), which the
+    ;; sandbox rejects; accepting it here would let a signed chunk size slip
+    ;; through whenever the fallback runs, diverging from the sandbox verdict.
     (let* ([semi (string-index line #\;)]
            [token (string-trim
                    (if semi
                        (substring line 0 semi)
-                       line))])
-      (string->number token 16)))
+                       line))]
+           [n (string-length token)])
+      (and (> n 0)
+           (let loop ([i 0])
+             (or (= i n)
+                 (and (hex-digit-char? (string-ref token i))
+                      (loop (+ i 1)))))
+           (string->number token 16))))
 
   (def (parse-request-line-sandboxed line)
     (call-parser line MAX-LINE "parse_request_line"
diff --git a/tests/httpd-fuzz-test.ss b/tests/httpd-fuzz-test.ss
index de26f01..b1ed8e8 100644
--- a/tests/httpd-fuzz-test.ss
+++ b/tests/httpd-fuzz-test.ss
@@ -413,6 +413,30 @@
      400
      "status")))
 
+(test "duplicate transfer-encoding is rejected"
+  (lambda ()
+    ;; A second Transfer-Encoding header used to be silently ignored (assoc
+    ;; returns the first), so the server framed on "chunked" while a front-end
+    ;; proxy could honor the last value -- a TE-TE desync. Must reject, matching
+    ;; the duplicate Content-Length check and the response validator.
+    (assert-equal
+     (status-of test-port
+       "POST /echo HTTP/1.1\r\nHost: 127.0.0.1\r\nTransfer-Encoding: chunked\r\nTransfer-Encoding: identity\r\nConnection: close\r\n\r\n0\r\n\r\n")
+     400
+     "status")))
+
+(test "signed chunk size is rejected (no sandbox-fallback divergence)"
+  (lambda ()
+    ;; The strict WASM parser rejects a leading sign in a chunk size, but the
+    ;; lenient Scheme fallback used to accept (string->number "+5" 16) -> 5,
+    ;; so a signed size parsed to 200 whenever the fallback ran. The fallback
+    ;; must match the sandbox and reject, so this is 400 either way.
+    (assert-equal
+     (status-of test-port
+       "POST /echo HTTP/1.1\r\nHost: 127.0.0.1\r\nTransfer-Encoding: chunked\r\nConnection: close\r\n\r\n+5\r\nhello\r\n0\r\n\r\n")
+     400
+     "status")))
+
 (test "encoded dot traversal is rejected"
   (lambda ()
     (assert-equal