Add chunked transfer-encoding decoding

README.md

@@ -43,6 +43,23 @@ An HTTP request/response parser and serializer for Carp.
   (Maybe.Nothing) (println* "no content-type"))
 ```
 
+### Chunked transfer decoding
+
+When a message uses `Transfer-Encoding: chunked`, the parsed body holds the raw
+chunk framing. Detect it with `chunked?` and decode it with
+`TransferEncoding.dechunk`:
+
+```clojure
+(match (Response.parse resp)
+  (Result.Success r)
+    (if (Response.chunked? &r)
+      (match (TransferEncoding.dechunk (Response.body &r))
+        (Result.Success body) (println* &body)
+        (Result.Error e) (IO.errorln &e))
+      (println* (Response.body &r)))
+  (Result.Error e) (IO.errorln &e))
+```
+
 ### Form body parsing
 
 ```clojure
@@ -73,6 +90,7 @@ Status.not-found    ; => 404
 | `MediaType` | `Content-Type` / media-type parser (type, subtype, parameters) |
 | `Multipart` | `multipart/form-data` body decoder |
 | `FormPart` | a single decoded multipart part (name, filename, content-type, body) |
+| `TransferEncoding` | Chunked transfer-encoding decoder |
 
 ## Testing
 

gendocs.carp

@@ -30,5 +30,5 @@ Status.not-found    ; => 404
 (Status.reason 200) ; => \"OK\"
 ```")
 
-(save-docs Request Response Cookie Status Form)
+(save-docs Request Response Cookie Status Form TransferEncoding)
 (quit)

http.carp

@@ -181,6 +181,16 @@ the type yourself, instead you can [parse](#parse) it.")
       (the (Maybe String) (Maybe.Nothing))
       hdrs)))
 
+(private transfer-encoding-chunked?)
+(hidden transfer-encoding-chunked?)
+(defn transfer-encoding-chunked? [hdrs]
+  (match (header-lookup hdrs "transfer-encoding")
+    (Maybe.Just v)
+      (Array.any?
+        &(fn [tok] (= &(String.trim tok) "chunked"))
+        &(String.split-by &(String.ascii-to-lower &v) &[\,]))
+    (Maybe.Nothing) false))
+
 (doc Request "is a request data type. It holds the `verb` of the request, the
 `version`, the `uri`, the `cookies`, the `headers`, and the `body`.")
 (deftype Request
@@ -341,7 +351,12 @@ it will return a `(Success Request)`.")
 
   (doc header "gets the first value of a header by name (case-insensitive).
 Returns `(Maybe String)`.")
-  (defn header [r name] (header-lookup (headers r) name)))
+  (defn header [r name] (header-lookup (headers r) name))
+
+  (doc chunked? "checks whether the request body is chunked transfer-encoded,
+i.e. its `Transfer-Encoding` header lists `chunked` (case-insensitively). Decode
+such a body with `TransferEncoding.dechunk`.")
+  (defn chunked? [r] (transfer-encoding-chunked? (headers r))))
 
 (doc Response "is a response data type. It holds the `code` of the request, the
 `version`, the `message`, the `cookies`, the `headers`, and the `body`.")
@@ -485,7 +500,107 @@ it will return a `(Success Response)`.")
 
   (doc header "gets the first value of a header by name (case-insensitive).
 Returns `(Maybe String)`.")
-  (defn header [r name] (header-lookup (headers r) name)))
+  (defn header [r name] (header-lookup (headers r) name))
+
+  (doc chunked? "checks whether the response body is chunked transfer-encoded,
+i.e. its `Transfer-Encoding` header lists `chunked` (case-insensitively). Decode
+such a body with `TransferEncoding.dechunk`.")
+  (defn chunked? [r] (transfer-encoding-chunked? (headers r))))
+
+(doc TransferEncoding "provides decoding for HTTP transfer codings.
+
+Use `Request.chunked?`/`Response.chunked?` to detect a chunked body, then
+[dechunk](#dechunk) to decode it.")
+(defmodule TransferEncoding
+  (private hex-nibble)
+  (hidden hex-nibble)
+  (defn hex-nibble [c]
+    (cond
+      (and (>= c \0) (<= c \9)) (- (Char.to-int c) 48)
+      (and (>= c \a) (<= c \f)) (+ 10 (- (Char.to-int c) 97))
+      (and (>= c \A) (<= c \F)) (+ 10 (- (Char.to-int c) 65))
+      -1))
+
+  (private parse-hex)
+  (hidden parse-hex)
+  (defn parse-hex [s]
+    (let-do [len (String.length s)
+             acc 0
+             ok (> len 0)]
+      (for [i 0 len]
+        (let [d (hex-nibble (String.char-at s i))]
+          (cond
+            (< d 0)
+            (do (set! ok false) (break))
+            ; reject a size that would overflow a signed 32-bit Int (acc*16+d),
+            ; which otherwise wraps to a negative or zero size and corrupts dechunk
+            (> acc (/ (- Int.MAX d) 16))
+            (do (set! ok false) (break))
+            (set! acc (+ (* acc 16) d)))))
+      (if ok (Maybe.Just acc) (Maybe.Nothing))))
+
+  (private crlf-at?)
+  (hidden crlf-at?)
+  (defn crlf-at? [s i]
+    (and (= (String.char-at s i) \return)
+         (= (String.char-at s (Int.inc i)) \newline)))
+
+  (doc dechunk "decodes a chunked transfer-encoded `body` per RFC 7230 §4.1.
+
+Each chunk is a hexadecimal size line — any chunk extension after a `;` is
+ignored — followed by that many bytes of data and a CRLF, repeating until a
+zero-size chunk. Optional trailer headers after the final chunk are ignored.
+Returns the decoded body, or an `(Error String)` on malformed framing such as a
+bad hex size or a truncated chunk.")
+  (defn dechunk [body]
+    (let-do [len (String.length body)
+             pos 0
+             sb (StringBuf.create)
+             err @""
+             terminated false]
+      (while (and (String.empty? &err) (not terminated) (< pos len))
+        (let [eol (String.find-crlf body pos len)]
+          (if (= eol -1)
+            (set! err @"malformed chunked body: unterminated chunk size line")
+            (let [size-line &(String.byte-slice body pos eol)
+                  semi (String.index-of size-line \;)
+                  hex &(String.trim
+                    &(if (= semi -1)
+                      @size-line
+                      (String.byte-slice size-line 0 semi)))]
+              (match (parse-hex hex)
+                (Maybe.Nothing)
+                  (set! err
+                        (fmt
+                          "malformed chunked body: invalid chunk size '%s'"
+                          hex))
+                (Maybe.Just size)
+                  (if (= size 0)
+                    (set! terminated true)
+                    (let [data-start (+ eol 2)
+                          avail (- len data-start)
+                          data-end (+ data-start size)]
+                      (cond
+                        ; a negative size can only arise from a parse-hex overflow
+                        ; (now rejected upstream); guard it anyway so a bad size can
+                        ; never become an out-of-bounds index into `body`
+                        (or (< avail 2) (< size 0) (> size (- avail 2)))
+                        (set! err
+                              @"malformed chunked body: truncated chunk data")
+                        (not (crlf-at? body data-end))
+                        (set! err
+                              @"malformed chunked body: chunk data missing CRLF")
+                        (do
+                          (StringBuf.append-str &sb
+                                                &(String.byte-slice body
+                                                                    data-start
+                                                                    data-end))
+                          (set! pos (+ data-end 2)))))))))))
+      (when (and (String.empty? &err) (not terminated))
+        (set! err @"malformed chunked body: missing terminating zero-size chunk"))
+      (let-do [decoded (StringBuf.to-string &sb)]
+        (StringBuf.delete sb)
+        (if (String.empty? &err) (Result.Success decoded) (Result.Error err))))))
 
 (doc Status "provides HTTP status code constants and reason phrases.")
 (defmodule Status

test/http.carp

@@ -67,6 +67,18 @@
     (match (Request.negotiate &r offers)
       (Maybe.Just m) m
       (Maybe.Nothing) @"NONE")))
+; ---- chunked transfer-encoding test helpers ----
+(defn dechunk-ok [s]
+  (match (TransferEncoding.dechunk s) (Result.Success b) b _ @"FAIL"))
+
+(defn dechunk-err? [s]
+  (match (TransferEncoding.dechunk s) (Result.Error _) true _ false))
+
+(defn resp-chunked? [s]
+  (match (Response.parse s) (Result.Success r) (Response.chunked? &r) _ false))
+
+(defn req-chunked? [s]
+  (match (Request.parse s) (Result.Success r) (Request.chunked? &r) _ false))
 
 (deftest test
   (assert-true test
@@ -701,4 +713,83 @@
   (assert-equal test
     "text/html"
     &(req-pick-noaccept &[@"text/html" @"application/json"])
-    "Request.negotiate with no Accept header accepts anything"))
+    "Request.negotiate with no Accept header accepts anything")
+  (assert-equal test
+    &(dechunk-ok "4\r\nWiki\r\n5\r\npedia\r\n0\r\n\r\n")
+    "Wikipedia"
+    "dechunk decodes a multi-chunk body")
+
+  (assert-equal test
+    &(dechunk-ok "1c\r\nabcdefghijklmnopqrstuvwxyz01\r\n0\r\n\r\n")
+    "abcdefghijklmnopqrstuvwxyz01"
+    "dechunk decodes a chunk with a multi-digit hex size")
+
+  (assert-equal test
+    &(dechunk-ok "4;name=value\r\nWiki\r\n5\r\npedia\r\n0\r\n\r\n")
+    "Wikipedia"
+    "dechunk ignores chunk extensions")
+
+  (assert-equal test
+    &(dechunk-ok "0\r\n\r\n")
+    ""
+    "dechunk decodes a zero-only body")
+
+  (assert-equal test
+    &(dechunk-ok "5\r\nhello\r\n0\r\nX-Checksum: abc123\r\nX-Extra: 1\r\n\r\n")
+    "hello"
+    "dechunk ignores trailing headers")
+
+  (assert-true test
+    (dechunk-err? "zz\r\nWiki\r\n0\r\n\r\n")
+    "dechunk errors on a non-hex chunk size")
+
+  (assert-true test
+    (dechunk-err? "80000000\r\nWiki\r\n0\r\n\r\n")
+    "dechunk rejects an overflowing chunk size instead of segfaulting")
+
+  (assert-true test
+    (dechunk-err? "100000000\r\nWiki\r\n0\r\n\r\n")
+    "dechunk rejects a 2^32 chunk size instead of silently mis-decoding as empty")
+
+  (assert-true test
+    (dechunk-err? "5\r\nhi\r\n0\r\n\r\n")
+    "dechunk errors on a chunk shorter than its declared size")
+
+  (assert-true test
+    (dechunk-err? "4\r\nWiki\r\n5\r\npedia\r\n")
+    "dechunk errors on a missing terminating zero-size chunk")
+
+  (assert-equal test
+    &(match (Response.parse
+        "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nWiki\r\n5\r\npedia\r\n0\r\n\r\n")
+      (Result.Success r)
+        (if (Response.chunked? &r)
+          (dechunk-ok (Response.body &r))
+          @"not-chunked")
+      _ @"parse-failed")
+    "Wikipedia"
+    "parse + chunked? + dechunk decodes a real chunked response")
+
+  (assert-true test
+    (resp-chunked? "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n")
+    "chunked? true for Transfer-Encoding: chunked")
+
+  (assert-true test
+    (resp-chunked? "HTTP/1.1 200 OK\r\ntransfer-encoding: Chunked\r\n\r\n")
+    "chunked? is case-insensitive in header name and value")
+
+  (assert-true test
+    (resp-chunked? "HTTP/1.1 200 OK\r\nTransfer-Encoding: gzip, chunked\r\n\r\n")
+    "chunked? true when chunked is last in a coding list")
+
+  (assert-false test
+    (resp-chunked? "HTTP/1.1 200 OK\r\nContent-Length: 0\r\n\r\n")
+    "chunked? false when Transfer-Encoding header is absent")
+
+  (assert-false test
+    (resp-chunked? "HTTP/1.1 200 OK\r\nTransfer-Encoding: gzip\r\n\r\n")
+    "chunked? false when chunked is not among the codings")
+
+  (assert-true test
+    (req-chunked? "POST / HTTP/1.1\r\nTransfer-Encoding: chunked\r\n\r\n")
+    "Request.chunked? true for Transfer-Encoding: chunked"))