Fix WebSocket 64-bit payload truncation and chunked status text

CHANGELOG.md

@@ -4,6 +4,20 @@
 
 ### Fixed
 
+- **WebSocket `decode-frame` 64-bit payload length truncation.**
+  `decode-frame` silently ignored the high 4 bytes (offsets 2–5) of
+  64-bit extended payload lengths (RFC 6455 §5.2), reading only the low
+  32 bits. A remote peer sending a frame header with non-zero high bytes
+  would cause the decoder to compute a wrong payload length, potentially
+  desynchronizing the frame parser. The decoder now checks the high bytes
+  and rejects frames whose payload length exceeds 32-bit `Int` range.
+
+- **`Response.chunked` hardcoded status text.** `Response.chunked` always
+  set the reason phrase to `"OK"` regardless of the status code passed.
+  A `(Response.chunked 404 ...)` would produce `HTTP/1.1 404 OK` on the
+  wire. Now uses `Status.reason` from the http library to derive the
+  correct phrase.
+
 - **WebSocket RFC 6455 protocol compliance.**
   - Protocol error paths (unexpected fragments, unknown opcodes) now send
     a 1002 close frame before disconnecting, as required by RFC 6455 §7.2.

test/web.carp

@@ -417,14 +417,16 @@
     (FormPart.body
       (Array.unsafe-nth
         &(Form.decode-multipart-request
-          &(parse-req "POST / HTTP/1.1\r\nContent-Type: multipart/form-data; Boundary=xyz\r\n\r\n--xyz\r\nContent-Disposition: form-data; name=\"msg\"\r\n\r\nhello\r\n--xyz--"))
+          &(parse-req
+            "POST / HTTP/1.1\r\nContent-Type: multipart/form-data; Boundary=xyz\r\n\r\n--xyz\r\nContent-Disposition: form-data; name=\"msg\"\r\n\r\nhello\r\n--xyz--"))
         0))
     "decode-multipart-request handles uppercase Boundary param")
 
   ; -- multipart? --
   (assert-true test
     (Form.multipart?
-      &(parse-req "POST / HTTP/1.1\r\nContent-Type: multipart/form-data; boundary=abc\r\n\r\n"))
+      &(parse-req
+        "POST / HTTP/1.1\r\nContent-Type: multipart/form-data; boundary=abc\r\n\r\n"))
     "multipart? detects multipart content type")
 
   (assert-false test
@@ -433,8 +435,7 @@
     "multipart? false for non-multipart")
 
   (assert-false test
-    (Form.multipart?
-      &(parse-req "GET / HTTP/1.1\r\nHost: x\r\n\r\n"))
+    (Form.multipart? &(parse-req "GET / HTTP/1.1\r\nHost: x\r\n\r\n"))
     "multipart? false when no content-type")
 
   ; -- decode-multipart-request --
@@ -443,17 +444,38 @@
     (FormPart.body
       (Array.unsafe-nth
         &(Form.decode-multipart-request
-          &(parse-req "POST / HTTP/1.1\r\nContent-Type: multipart/form-data; boundary=xyz\r\n\r\n--xyz\r\nContent-Disposition: form-data; name=\"msg\"\r\n\r\nhello\r\n--xyz--"))
+          &(parse-req
+            "POST / HTTP/1.1\r\nContent-Type: multipart/form-data; boundary=xyz\r\n\r\n--xyz\r\nContent-Disposition: form-data; name=\"msg\"\r\n\r\nhello\r\n--xyz--"))
         0))
     "decode-multipart-request parses from request")
 
   (assert-equal test
     0
     (Array.length
       &(Form.decode-multipart-request
-        &(parse-req "POST / HTTP/1.1\r\nContent-Type: application/json\r\n\r\n{}")))
+        &(parse-req
+          "POST / HTTP/1.1\r\nContent-Type: application/json\r\n\r\n{}")))
     "decode-multipart-request empty for non-multipart")
 
+  ; ---------------------------------------------------------------------------
+  ; Response.chunked status text
+  ; ---------------------------------------------------------------------------
+
+  (assert-equal test
+    "OK"
+    (Response.message &(Response.chunked 200 @"text/plain" &[@"hi"]))
+    "chunked 200 has reason phrase OK")
+
+  (assert-equal test
+    "Not Found"
+    (Response.message &(Response.chunked 404 @"text/plain" &[@"oops"]))
+    "chunked 404 has reason phrase Not Found")
+
+  (assert-equal test
+    "Internal Server Error"
+    (Response.message &(Response.chunked 500 @"text/plain" &[@"err"]))
+    "chunked 500 has reason phrase Internal Server Error")
+
   ; ---------------------------------------------------------------------------
   ; Response finalization tests
   ; ---------------------------------------------------------------------------
@@ -630,14 +652,16 @@
 
   ; -- web-etag-match? returns true on match --
   (assert-true test
-    (let [req (parse-req "GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"abc\"\r\n\r\n")
+    (let [req (parse-req
+            "GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"abc\"\r\n\r\n")
           resp (Response.with-header (Response.text @"hi") @"ETag" @"\"abc\"")]
       (web-etag-match? &req &resp))
     "etag-match? true when ETags match")
 
   ; -- web-etag-match? returns false on mismatch --
   (assert-false test
-    (let [req (parse-req "GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"xyz\"\r\n\r\n")
+    (let [req (parse-req
+            "GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"xyz\"\r\n\r\n")
           resp (Response.with-header (Response.text @"hi") @"ETag" @"\"abc\"")]
       (web-etag-match? &req &resp))
     "etag-match? false when ETags differ")

test/websocket.carp

@@ -442,6 +442,50 @@
       (- (Array.length &f) 4))
     "encode-binary 16-bit payload length correct")
 
+  ; ---------------------------------------------------------------------------
+  ; 64-bit payload length encoding
+  ; ---------------------------------------------------------------------------
+
+  ; encode-text uses 64-bit length indicator for payloads >= 65536
+  (assert-equal test
+    (Byte.from-int 127)
+    (let [f (WebSocket.encode-text &(String.allocate 65536 \x))]
+      @(Array.unsafe-nth &f 1))
+    "encode-text uses 64-bit length for >= 65536 bytes")
+
+  ; 64-bit encode/decode round-trip
+  (assert-equal test
+    65536
+    (let [f (WebSocket.encode-text &(String.allocate 65536 \x))]
+      (match (WebSocket.decode-frame &f 0)
+        (Maybe.Just frame) (Array.length (WSFrame.payload &frame))
+        (Maybe.Nothing) -1))
+    "64-bit frame round-trips with correct payload length")
+
+  ; High 32 bits in 64-bit header are not truncated.
+  ; Craft a raw frame header with byte 5 = 1 (plen high word = 2^32).
+  ; The buffer is tiny, so decode must return Nothing.
+  ; Old code ignored bytes 2-5 and would read plen=0, returning a
+  ; zero-payload frame instead.
+  (assert-true test
+    (let [buf (the (Array Byte)
+                   [(Byte.from-int 130)
+                    ; FIN + binary, unmasked
+                    (Byte.from-int 127)
+                    ; 64-bit length indicator
+                    (Byte.from-int 0)
+                    (Byte.from-int 0)
+                    (Byte.from-int 0)
+                    (Byte.from-int 1)
+                    ; bytes 2-5: plen = 1 * 2^32 = 4294967296
+                    (Byte.from-int 0)
+                    (Byte.from-int 0)
+                    (Byte.from-int 0)
+                    (Byte.from-int 0)])]
+      ; bytes 6-9: low word = 0
+      (Maybe.nothing? &(WebSocket.decode-frame &buf 0)))
+    "64-bit length high bytes are not truncated")
+
   ; ---------------------------------------------------------------------------
   ; FIN bit extraction
   ; ---------------------------------------------------------------------------