From 95256adcb4d5e6f2c06c630d5fbdd2f79cfb6ba8 Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Sat, 3 Oct 2026 18:25:21 +0200 Subject: [PATCH 1/2] Read numeric header fields by their grammar, not strtol MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Int.from-string is C's (int)strtol. It reads an empty string as 0, accepts a sign and leading whitespace, and on LP64 truncates values past Int (4294967296 becomes 0). A shared parse-digits reads 1*DIGIT and saturates at Int.MAX instead. - Response.parse: the status code must be 3DIGIT (RFC 9112 §4). - Set-Cookie Max-Age: an optional "-" then 1*DIGIT (RFC 6265 §5.2.2). An empty or "+"-signed value now gets the existing malformed-value error instead of expiring the cookie or being accepted. - Cache-Control max-age/s-maxage: 1*DIGIT, saturating at Int.MAX (RFC 9111 §1.2.2). Empty or signed values are now Nothing. - q values: a NaN or empty q falls back to the documented default weight of 1, instead of NaN (order-dependent negotiation) or 0. --- http.carp | 45 ++++++++++++++++----- test/http.carp | 104 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 140 insertions(+), 9 deletions(-) diff --git a/http.carp b/http.carp index c528753..04712de 100644 --- a/http.carp +++ b/http.carp @@ -30,6 +30,22 @@ Returns -1 if not found.") m (length sub)] (and (>= n m) (= sub &(byte-slice s (- n m) n)))))) +(private parse-digits) +(hidden parse-digits) +; 1*DIGIT as an Int, saturating at Int.MAX +(defn parse-digits [s] + (let-do [len (String.length s) + acc 0 + ok (> len 0)] + (for [i 0 len] + (let [c (String.char-at s i) + d (- (Char.to-int c) 48)] + (cond + (not (Char.num? c)) (do (set! ok false) (break)) + (> acc (/ (- Int.MAX d) 10)) (set! acc Int.MAX) + (set! acc (+ (* acc 10) d))))) + (if ok (Maybe.Just acc) (Maybe.Nothing)))) + (doc HttpDate "reads and writes HTTP-date values (RFC 9110 §5.6.7), the timestamp form used by `Date`, `Expires`, `Last-Modified`, `If-Modified-Since` and the `Expires` attribute of a `Set-Cookie` header.") @@ -214,7 +230,13 @@ instants, not as wall-clock readings.") (if l<2 (Result.Error @"malformed max-age property in set-cookie, no value") - (let [mi (Int.from-string &(join "=" &(Array.suffix splt 1)))] + (let [v (trim &(join "=" &(Array.suffix splt 1))) + mi (if (String.byte-starts-with? &v "-") + (Maybe.apply + (parse-digits + &(String.byte-slice &v 1 (String.length &v))) + &Int.neg) + (parse-digits &v))] (match mi (Maybe.Nothing) (Result.Error @"malformed max-age value in set-cookie") @@ -561,7 +583,9 @@ it will return a `(Success Response)`.") message &(String.byte-slice first-line (Int.inc sp2) (String.length first-line))] - (match (Int.from-string code-str) + (match (if (= (String.length code-str) 3) + (parse-digits code-str) + (Maybe.Nothing)) (Maybe.Nothing) (Result.Error (fmt @@ -1129,7 +1153,8 @@ media range, content coding or language range — and its quality `q` between (defmodule Weighted (hidden clamp-q) (private clamp-q) - (defn clamp-q [d] (cond (Double.< d 0.0) 0.0 (Double.> d 1.0) 1.0 d)) + ; NaN falls through to 1.0 + (defn clamp-q [d] (cond (Double.< d 0.0) 0.0 (Double.< d 1.0) d 1.0)) (hidden q-of) (private q-of) @@ -1139,9 +1164,11 @@ media range, content coding or language range — and its quality `q` between (match (Map.get-maybe &(MediaType.parse-params s) "q") (Maybe.Nothing) 1.0 (Maybe.Just qs) - (match (Double.from-string &qs) - (Maybe.Nothing) 1.0 - (Maybe.Just d) (clamp-q d)))) + (if (String.empty? &qs) + 1.0 + (match (Double.from-string &qs) + (Maybe.Nothing) 1.0 + (Maybe.Just d) (clamp-q d))))) (doc parse-list "parses a weighted, comma-separated header list into its entries, in header order. Each entry's `value` is the lower-cased text before @@ -1459,15 +1486,15 @@ value as `(Maybe String)`. A present valueless directive yields `(Just @\"\")`." (private int-directive) (defn int-directive [m name] (match (directive m name) - (Maybe.Just v) (Int.from-string &v) + (Maybe.Just v) (parse-digits &v) (Maybe.Nothing) (Maybe.Nothing))) (doc max-age "the `max-age` delta-seconds as `(Maybe Int)`, when present and -numeric.") +all digits. A value too large for an `Int` reads as `Int.MAX`.") (defn max-age [m] (int-directive m "max-age")) (doc s-maxage "the `s-maxage` delta-seconds as `(Maybe Int)`, when present and -numeric.") +all digits. A value too large for an `Int` reads as `Int.MAX`.") (defn s-maxage [m] (int-directive m "s-maxage")) (doc no-cache? "whether the `no-cache` directive is present.") diff --git a/test/http.carp b/test/http.carp index a55791c..9a23cb6 100644 --- a/test/http.carp +++ b/test/http.carp @@ -417,6 +417,9 @@ (defn cc-directive [s k] (Maybe.from (Map.get-maybe &(CacheControl.parse s) k) @"")) +(defn cc-max-age [s] + (Maybe.from (CacheControl.max-age &(CacheControl.parse s)) -1)) + (defn cookie-summary [s] (match (Cookie.parse-set s) (Result.Success c) (fmt "%s=%s" (Cookie.name &c) (Cookie.value &c)) @@ -495,6 +498,31 @@ (resp-code "HTTP/1.1 404 Not Found\r\n\r\n") "parse 404 response") + (assert-equal test + -1 + (resp-code "HTTP/1.1 2000 OK\r\n\r\n") + "a four-digit status code is malformed") + + (assert-equal test + -1 + (resp-code "HTTP/1.1 20 OK\r\n\r\n") + "a two-digit status code is malformed") + + (assert-equal test + -1 + (resp-code "HTTP/1.1 +200 OK\r\n\r\n") + "a status code with a plus sign is malformed") + + (assert-equal test + -1 + (resp-code "HTTP/1.1 -200 OK\r\n\r\n") + "a negative status code is malformed") + + (assert-equal test + -1 + (resp-code "HTTP/1.1 200 OK\r\n\r\n") + "a status code after a doubled space is malformed") + (assert-true test (Response.ok? &(Response.init 200 @"OK" @"HTTP/1.1" [] {} @"")) "ok? true for 200") @@ -1549,6 +1577,10 @@ "text/html" &(pick "text/html;q=bogus, image/png;q=0.5" &[@"text/html" @"image/png"]) "an unparseable q falls back to weight 1") + (assert-equal test + "text/html" + &(pick "text/html;q=nan, text/html;q=0.5" &[@"text/html"]) + "a NaN q falls back to weight 1 whatever the order of the ranges") (assert-true test (= 3 (Array.length @@ -1640,6 +1672,22 @@ "gzip@0.5" &(weighted-entry &(AcceptEncoding.parse "br, GZIP;q=0.5") 1) "parse lower-cases a coding and keeps its weight") + (assert-equal test + "gzip@1.0" + &(weighted-entry &(AcceptEncoding.parse "gzip;q=nan") 0) + "a NaN q falls back to weight 1") + (assert-equal test + "gzip" + &(pick-enc "gzip;q=" &[@"gzip"]) + "an empty q falls back to weight 1 instead of refusing the coding") + (assert-equal test + "gzip@1.0" + &(weighted-entry &(AcceptEncoding.parse "gzip;q=2") 0) + "a q above 1 is clamped to 1") + (assert-equal test + "gzip@0.0" + &(weighted-entry &(AcceptEncoding.parse "gzip;q=-1") 0) + "a q below 0 is clamped to 0") (assert-equal test "gzip" &(req-pick-enc (the (Map String (Array String)) {}) &[@"gzip" @"identity"]) @@ -2516,6 +2564,38 @@ (let [m (CacheControl.parse "public, s-maxage=120")] (Maybe.from (CacheControl.s-maxage &m) -1)) "CacheControl.s-maxage is parsed as an Int") + (assert-equal test + -1 + (cc-max-age "max-age=") + "CacheControl.max-age is Nothing for an empty value") + (assert-equal test + -1 + (cc-max-age "max-age=-5") + "CacheControl.max-age is Nothing for a negative value") + (assert-equal test + -1 + (cc-max-age "max-age=+5") + "CacheControl.max-age is Nothing for a value with a plus sign") + (assert-equal test + 7 + (cc-max-age "max-age=007") + "CacheControl.max-age reads leading zeros") + (assert-equal test + Int.MAX + (cc-max-age "max-age=2147483647") + "CacheControl.max-age reads Int.MAX exactly") + (assert-equal test + Int.MAX + (cc-max-age "max-age=2147483648") + "CacheControl.max-age saturates one past Int.MAX") + (assert-equal test + Int.MAX + (cc-max-age "max-age=4294967296") + "CacheControl.max-age saturates 2^32 instead of wrapping to 0") + (assert-equal test + Int.MAX + (cc-max-age "max-age=99999999999999999999") + "CacheControl.max-age saturates a value past 64 bits") (assert-equal test 2 (Map.length &(CacheControl.parse "no-cache=\"Set-Cookie, X\", max-age=5")) @@ -2702,6 +2782,30 @@ "live" &(expiry-verdict "id=abc; Max-Age=3600") "a positive Max-Age keeps the cookie alive") + (assert-equal test + "malformed max-age value in set-cookie" + &(expiry-verdict "id=abc; Max-Age=") + "an empty Max-Age is malformed rather than expiring the cookie") + (assert-equal test + "malformed max-age value in set-cookie" + &(expiry-verdict "id=abc; Max-Age=+60") + "a Max-Age with a plus sign is malformed") + (assert-equal test + "live" + &(expiry-verdict "id=abc; Max-Age=0060") + "a Max-Age with leading zeros keeps the cookie alive") + (assert-equal test + "live" + &(expiry-verdict "id=abc; Max-Age= 60") + "whitespace before a Max-Age value is ignored") + (assert-equal test + "live" + &(expiry-verdict "id=abc; Max-Age=4294967296") + "a Max-Age too large for an Int saturates instead of wrapping") + (assert-equal test + "expired" + &(expiry-verdict "id=abc; Max-Age=-99999999999999999999") + "a Max-Age too negative for an Int still expires the cookie") (assert-equal test "expired" &(expiry-verdict "id=abc; Expires=Wed, 09 Jun 2021 10:18:14 GMT") From 37326883963786a129b8f491551d5924163babc0 Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Sun, 4 Oct 2026 01:30:09 +0200 Subject: [PATCH 2/2] Skip spaces before the status code, accept a plus-signed Max-Age A run of SP after the HTTP-version is skipped before the three status digits are read, as Go's ReadResponse does, so `HTTP/1.1 200 OK` parses as 200 again. A tab, a sign, or anything but three digits stays an error. Max-Age now reads `["+" / "-"] 1*DIGIT`, so `Max-Age=+60` gives a 60 s cookie again instead of failing the whole response. A max-age=2147483646 test pins the saturation guard's `>` against `>=`. --- http.carp | 28 ++++++++++++++++++---------- test/http.carp | 22 ++++++++++++++++++---- 2 files changed, 36 insertions(+), 14 deletions(-) diff --git a/http.carp b/http.carp index 04712de..2e8411b 100644 --- a/http.carp +++ b/http.carp @@ -231,12 +231,12 @@ instants, not as wall-clock readings.") (Result.Error @"malformed max-age property in set-cookie, no value") (let [v (trim &(join "=" &(Array.suffix splt 1))) - mi (if (String.byte-starts-with? &v "-") - (Maybe.apply - (parse-digits - &(String.byte-slice &v 1 (String.length &v))) - &Int.neg) - (parse-digits &v))] + negative (String.byte-starts-with? &v "-") + digits (if (or negative (String.byte-starts-with? &v "+")) + (parse-digits + &(String.byte-slice &v 1 (String.length &v))) + (parse-digits &v)) + mi (if negative (Maybe.apply digits &Int.neg) digits)] (match mi (Maybe.Nothing) (Result.Error @"malformed max-age value in set-cookie") @@ -557,6 +557,15 @@ such a body with `TransferEncoding.dechunk`.") (doc server-error? "checks whether the status code is between 500 and 600.") (defn server-error? [r] (let [c @(code r)] (and (<= 500 c) (< c 600)))) + (hidden skip-sp) + (private skip-sp) + (defn skip-sp [s i] + (let-do [j i + len (String.length s)] + (while (and (< j len) (= (String.char-at s j) \space)) + (set! j (Int.inc j))) + j)) + (doc parse "parses a HTTP response from a string `txt`. Returns a `(Error String)` holding the error message if it fails, otherwise @@ -572,14 +581,13 @@ it will return a `(Success Response)`.") (if (= sp1 -1) (Result.Error (fmt "Malformed response: found first line '%s'" first-line)) - (let [sp2 (String.index-of-from first-line \space (Int.inc sp1))] + (let [code-start (skip-sp first-line (Int.inc sp1)) + sp2 (String.index-of-from first-line \space code-start)] (if (= sp2 -1) (Result.Error (fmt "Malformed response: found first line '%s'" first-line)) (let [version &(String.byte-slice first-line 0 sp1) - code-str &(String.byte-slice first-line - (Int.inc sp1) - sp2) + code-str &(String.byte-slice first-line code-start sp2) message &(String.byte-slice first-line (Int.inc sp2) (String.length first-line))] diff --git a/test/http.carp b/test/http.carp index 9a23cb6..cc4e7e6 100644 --- a/test/http.carp +++ b/test/http.carp @@ -519,9 +519,19 @@ "a negative status code is malformed") (assert-equal test - -1 + 200 (resp-code "HTTP/1.1 200 OK\r\n\r\n") - "a status code after a doubled space is malformed") + "a doubled space before the status code is skipped") + + (assert-equal test + 200 + (resp-code "HTTP/1.1 200 OK\r\n\r\n") + "three spaces before the status code are skipped") + + (assert-equal test + -1 + (resp-code "HTTP/1.1 \t200 OK\r\n\r\n") + "a tab before the status code is malformed") (assert-true test (Response.ok? &(Response.init 200 @"OK" @"HTTP/1.1" [] {} @"")) @@ -2580,6 +2590,10 @@ 7 (cc-max-age "max-age=007") "CacheControl.max-age reads leading zeros") + (assert-equal test + 2147483646 + (cc-max-age "max-age=2147483646") + "CacheControl.max-age reads one below Int.MAX exactly") (assert-equal test Int.MAX (cc-max-age "max-age=2147483647") @@ -2787,9 +2801,9 @@ &(expiry-verdict "id=abc; Max-Age=") "an empty Max-Age is malformed rather than expiring the cookie") (assert-equal test - "malformed max-age value in set-cookie" + "live" &(expiry-verdict "id=abc; Max-Age=+60") - "a Max-Age with a plus sign is malformed") + "a Max-Age with a plus sign keeps the cookie alive") (assert-equal test "live" &(expiry-verdict "id=abc; Max-Age=0060")