diff --git a/README.md b/README.md index 65a4ead..2ce5316 100644 --- a/README.md +++ b/README.md @@ -103,6 +103,39 @@ Secure flag enforcement, and expiry. Cookies are deduplicated by name+domain+path. During redirects, cookies from every hop are stored and re-applied for each new URL. +### Multipart uploads + +```clojure +(match (Client.post-multipart "https://example.com/upload" + (the (Map String (Array String)) {}) + &[(Multipart.text-part "field" "value") + (Multipart.file-part "upload" "test.txt" + "text/plain" + "file contents")]) + (Result.Success r) (println* (Response.code &r)) + (Result.Error e) (IO.errorln &e)) +``` + +`post-multipart` picks the boundary with `Multipart.boundary-for`, which +checks it against the parts and extends it until it occurs in none of them. +RFC 2046 §5.1.1 requires that, and without it any upload whose contents +happen to contain the delimiter is split in the wrong places by the receiver. + +To build the body yourself, pick the boundary the same way: + +```clojure +(let [parts [(Multipart.text-part "name" "Carp")] + boundary (Multipart.boundary-for &parts)] + (Client.post url + {@"Content-Type" [(Multipart.content-type-header &boundary)]} + &(Multipart.encode &parts &boundary))) +``` + +A CR or LF in a part name, filename or content type is percent-encoded as +`%0D` and `%0A`, so an untrusted field name cannot inject header lines or a +further part into the body. Quotes are backslash-escaped. Values without +those characters are emitted unchanged. + ## API ### `Client` @@ -125,6 +158,8 @@ re-applied for each new URL. | `Client.del-with-config url config` | DELETE with request config | | `Client.head-with-config url config` | HEAD with request config | | `Client.patch-with-config url headers body config` | PATCH with request config | +| `Client.post-multipart url headers parts` | POST a multipart/form-data body | +| `Client.post-multipart-with-config url headers parts config` | Multipart POST with request config | | `Client.request-with-config verb url headers body config` | Generic request with request config | | `Client.request-stream-with-config verb url headers body config` | Streaming with request config | | `Client.get-with-jar url jar` | GET with cookie jar | @@ -149,6 +184,17 @@ A relative `Location` is resolved against the URL of the hop that produced it, following RFC 3986 §5. A `Location` that carries its own scheme is followed as given. +### `Multipart` + +| Function | Purpose | +|----------|---------| +| `Multipart.text-part name value` | A text form field | +| `Multipart.file-part name filename content-type data` | A file upload part | +| `Multipart.boundary-for parts` | A boundary that occurs in no part | +| `Multipart.generate-boundary` | A boundary from the clock, unchecked against any payload | +| `Multipart.content-type-header boundary` | The `Content-Type` value for a boundary | +| `Multipart.encode parts boundary` | The encoded body | + ### `RequestConfig` | Function | Purpose | diff --git a/docs/Client.html b/docs/Client.html index ffdd371..2674529 100644 --- a/docs/Client.html +++ b/docs/Client.html @@ -32,6 +32,11 @@ CookieJar +
  • + + Multipart + +
    • diff --git a/docs/Connection.html b/docs/Connection.html index 37e1289..2d75e74 100644 --- a/docs/Connection.html +++ b/docs/Connection.html @@ -32,6 +32,11 @@ CookieJar +
  • + + Multipart + +
    • diff --git a/docs/CookieJar.html b/docs/CookieJar.html index e8d30d5..1f019d4 100644 --- a/docs/CookieJar.html +++ b/docs/CookieJar.html @@ -32,6 +32,11 @@ CookieJar +
  • + + Multipart + +
    • diff --git a/docs/Multipart.html b/docs/Multipart.html new file mode 100644 index 0000000..6eb2261 --- /dev/null +++ b/docs/Multipart.html @@ -0,0 +1,235 @@ + + + + + + + + + +
    + +
    +

    + Multipart +

    +
    +

    provides multipart/form-data encoding for HTTP requests +(RFC 7578).

    +

    Encoding manually

    +
    (let [parts [(Multipart.text-part "name" "Carp")
+             (Multipart.file-part "upload" "test.txt"
+                                  "text/plain" "file contents")]
+      boundary (Multipart.boundary-for &parts)]
+  (Client.post url
+    {@"Content-Type" [(Multipart.content-type-header &boundary)]}
+    &(Multipart.encode &parts &boundary)))
+
    +

    Pick the boundary with Multipart.boundary-for, not with +Multipart.generate-boundary: only the former is checked against the parts, +which is what keeps a body that happens to contain the delimiter from +splitting the message.

    +

    Convenience function

    +
    (Client.post-multipart url {}
+  &[(Multipart.text-part "field" "value")])
+
    + +
    +
    + +

    + boundary-for +

    +     +
    + defn +
    +

    + (Fn [(Ref (Array Part) a)] String) +

    + 
    +                        (boundary-for parts)
+
    +

    +

    returns a boundary that occurs nowhere in parts, as RFC 2046 §5.1.1 +requires of the delimiter.

    +

    Starts from Multipart.generate-boundary and, while the candidate still +occurs in some part name, filename, content type or body, appends the +bcharsnospace character that follows the fewest of those occurrences. Each +round therefore divides the occurrence count by 62, so the boundary stays far +inside the 70-character limit even for a payload built to defeat it. Every +round copies and scans each name, filename, content type and body, so a large +upload pays a full pass per round.

    + +

    +
    +
    + +

    + content-type-header +

    +     +
    + defn +
    +

    + (Fn [(Ref String a)] String) +

    + 
    +                        (content-type-header boundary)
+
    +

    +

    returns the Content-Type header value for multipart/form-data with the +given boundary.

    + +

    +
    +
    + +

    + encode +

    +     +
    + defn +
    +

    + (Fn [(Ref (Array Part) a), (Ref String b)] String) +

    + 
    +                        (encode parts boundary)
+
    +

    +

    encodes an array of parts into a multipart/form-data body string using +the given boundary (RFC 7578).

    +

    Pass a boundary from Multipart.boundary-for; encode cannot re-pick one, +because the caller has already committed to it in the Content-Type header.

    +

    A CR or LF in a part name, filename or content type would end the header line +and let the rest of the value pose as headers or as a further part, so both +are percent-encoded as %0D and %0A, following the same rule as HTML form +submission. Quotes in a name or filename are backslash-escaped. Values +without those characters are emitted unchanged.

    + +

    +
    +
    + +

    + file-part +

    +     +
    + defn +
    +

    + (Fn [(Ref String a), (Ref String b), (Ref String c), (Ref String d)] Part) +

    + 
    +                        (file-part name filename content-type data)
+
    +

    +

    creates a file upload part with a filename and content type. +The data parameter is the raw file contents as a string.

    + +

    +
    +
    + +

    + generate-boundary +

    +     +
    + defn +
    +

    + (Fn [] String) +

    + 
    +                        (generate-boundary)
+
    +

    +

    generates a boundary string for multipart encoding, using the current +time for uniqueness.

    +

    The result is not checked against any payload, so a part that contains it is +encoded into a message the receiver splits in the wrong places. Prefer +Multipart.boundary-for, which rules that out.

    + +

    +
    +
    + +

    + parse +

    +     +
    + defn +
    +

    + (Fn [(Ref String a), (Ref String b)] (Result (Array FormPart) String)) +

    + 
    +                        (parse body boundary)
+
    +

    +

    decodes a multipart/form-data body with the given boundary +into its FormParts. Fails when the opening boundary delimiter is absent.

    + +

    +
    +
    + +

    + text-part +

    +     +
    + defn +
    +

    + (Fn [(Ref String a), (Ref String b)] Part) +

    + 
    +                        (text-part name value)
+
    +

    +

    creates a text form field part with the given name and value.

    + +

    +
    +
    +
    + + diff --git a/docs/http-client_index.html b/docs/http-client_index.html index 285fb6f..4da4510 100644 --- a/docs/http-client_index.html +++ b/docs/http-client_index.html @@ -28,6 +28,11 @@ CookieJar +
  • + + Multipart + +
    • diff --git a/docs/index.html b/docs/index.html index 285fb6f..4da4510 100644 --- a/docs/index.html +++ b/docs/index.html @@ -28,6 +28,11 @@ CookieJar +
  • + + Multipart + +
    • diff --git a/gendocs.carp b/gendocs.carp index 07211b1..55c6daf 100644 --- a/gendocs.carp +++ b/gendocs.carp @@ -37,5 +37,5 @@ transparently over plain TCP or TLS-encrypted streams. Requires OpenSSL for HTTPS support (via the `tls` library). Plain HTTP works without OpenSSL.") -(save-docs Client Connection CookieJar) +(save-docs Client Connection CookieJar Multipart) (quit) diff --git a/http-client.carp b/http-client.carp index 2abd76d..cdad0c2 100644 --- a/http-client.carp +++ b/http-client.carp @@ -666,7 +666,7 @@ Returns `(Result Response String)`. \"text/plain\" \"file contents\")]) ```") (defn post-multipart [url headers parts] - (let [boundary (Multipart.generate-boundary) + (let [boundary (Multipart.boundary-for parts) body (Multipart.encode parts &boundary) ct-vals [(Multipart.content-type-header &boundary)] cl-vals [(Int.str (String.length &body))] @@ -681,7 +681,7 @@ multipart/form-data body using the given `RequestConfig`. Returns `(Result Response String)`. See `RequestConfig` for timeout and redirect details.") (defn post-multipart-with-config [url headers parts config] - (let [boundary (Multipart.generate-boundary) + (let [boundary (Multipart.boundary-for parts) body (Multipart.encode parts &boundary) ct-vals [(Multipart.content-type-header &boundary)] cl-vals [(Int.str (String.length &body))] diff --git a/src/multipart.carp b/src/multipart.carp index 8f7ec3a..5c2900e 100644 --- a/src/multipart.carp +++ b/src/multipart.carp @@ -16,12 +16,17 @@ Use `Multipart.text-part` to create a simple text field, or (let [parts [(Multipart.text-part \"name\" \"Carp\") (Multipart.file-part \"upload\" \"test.txt\" \"text/plain\" \"file contents\")] - boundary (Multipart.generate-boundary)] + boundary (Multipart.boundary-for &parts)] (Client.post url {@\"Content-Type\" [(Multipart.content-type-header &boundary)]} &(Multipart.encode &parts &boundary))) ``` +Pick the boundary with `Multipart.boundary-for`, not with +`Multipart.generate-boundary`: only the former is checked against the parts, +which is what keeps a body that happens to contain the delimiter from +splitting the message. + ## Convenience function ``` @@ -34,6 +39,82 @@ Use `Multipart.text-part` to create a simple text field, or (defn escape-quotes [s] (let [q (Char.from-int 34)] (String.join "\\\"" &(String.split-by s &[q])))) + (hidden escape-newlines) + (private escape-newlines) + (defn escape-newlines [s] + (let [cr (Char.from-int 13) + lf (Char.from-int 10)] + (String.join "%0A" + &(String.split-by + &(String.join "%0D" &(String.split-by s &[cr])) + &[lf])))) + + (hidden extension-alphabet) + (private extension-alphabet) + (def extension-alphabet + "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") + + (hidden matches-at?) + (private matches-at?) + (defn matches-at? [haystack needle i] + (let-do [m (Array.length needle) + j 0 + ok true] + (while-do (and ok (< j m)) + (if (= @(Array.unsafe-nth haystack (+ i j)) @(Array.unsafe-nth needle j)) + (set! j (Int.inc j)) + (set! ok false))) + ok)) + + (hidden tally-text!) + (private tally-text!) + (defn tally-text! [counts text needle] + (let-do [haystack (String.to-bytes text) + nb (String.to-bytes needle) + n (Array.length &haystack) + m (Array.length &nb) + found false] + (when-do (>= n m) + (for [i 0 (Int.inc (- n m))] + (when-do (matches-at? &haystack &nb i) + (set! found true) + (when-do (< (+ i m) n) + (let [b (Byte.to-int @(Array.unsafe-nth &haystack (+ i m)))] + (Array.aset! counts b (Int.inc @(Array.unsafe-nth counts b)))))))) + found)) + + (hidden tally-parts!) + (private tally-parts!) + (defn tally-parts! [counts parts needle] + (let-do [found false] + (for [i 0 (Array.length parts)] + (let-do [part (Array.unsafe-nth parts i)] + (when (tally-text! counts (Part.name part) needle) (set! found true)) + (when (tally-text! counts (Part.body part) needle) (set! found true)) + (match-ref (Part.filename part) + (Maybe.Just fname) + (when (tally-text! counts fname needle) (set! found true)) + (Maybe.Nothing) ()) + (match-ref (Part.content-type part) + (Maybe.Just ct) + (when (tally-text! counts ct needle) (set! found true)) + (Maybe.Nothing) ()))) + found)) + + (hidden least-used) + (private least-used) + (defn least-used [counts] + (let-do [alphabet (String.to-bytes extension-alphabet) + best 0 + fewest @(Array.unsafe-nth counts + (Byte.to-int @(Array.unsafe-nth &alphabet + 0)))] + (for [i 1 (Array.length &alphabet)] + (let [n @(Array.unsafe-nth counts + (Byte.to-int @(Array.unsafe-nth &alphabet i)))] + (when-do (< n fewest) (set! best i) (set! fewest n)))) + (String.byte-slice extension-alphabet best (Int.inc best)))) + (doc text-part "creates a text form field part with the given name and value.") (defn text-part [name value] (Part.init @name (Maybe.Nothing) (Maybe.Nothing) @value)) @@ -45,10 +126,33 @@ The `data` parameter is the raw file contents as a string.") (doc generate-boundary "generates a boundary string for multipart encoding, using the current -time for uniqueness.") +time for uniqueness. + +The result is not checked against any payload, so a part that contains it is +encoded into a message the receiver splits in the wrong places. Prefer +`Multipart.boundary-for`, which rules that out.") (defn generate-boundary [] (String.append "----CarpBoundary" &(Int.str (System.time)))) + (doc boundary-for + "returns a boundary that occurs nowhere in `parts`, as RFC 2046 §5.1.1 +requires of the delimiter. + +Starts from `Multipart.generate-boundary` and, while the candidate still +occurs in some part name, filename, content type or body, appends the +`bcharsnospace` character that follows the fewest of those occurrences. Each +round therefore divides the occurrence count by 62, so the boundary stays far +inside the 70-character limit even for a payload built to defeat it. Every +round copies and scans each name, filename, content type and body, so a large +upload pays a full pass per round.") + (defn boundary-for [parts] + (let-do [candidate (generate-boundary) + counts (Array.replicate 256 &0)] + (while-do (tally-parts! &counts parts &candidate) + (set! candidate (String.append &candidate &(least-used &counts))) + (set! counts (Array.replicate 256 &0))) + candidate)) + (doc content-type-header "returns the Content-Type header value for multipart/form-data with the given boundary.") @@ -57,7 +161,16 @@ given boundary.") (doc encode "encodes an array of parts into a multipart/form-data body string using -the given boundary (RFC 7578).") +the given boundary (RFC 7578). + +Pass a boundary from `Multipart.boundary-for`; `encode` cannot re-pick one, +because the caller has already committed to it in the Content-Type header. + +A CR or LF in a part name, filename or content type would end the header line +and let the rest of the value pose as headers or as a further part, so both +are percent-encoded as %0D and %0A, following the same rule as HTML form +submission. Quotes in a name or filename are backslash-escaped. Values +without those characters are emitted unchanged.") (defn encode [parts boundary] (let-do [sb (StringBuf.create)] (for [i 0 (Array.length parts)] @@ -66,13 +179,15 @@ the given boundary (RFC 7578).") (StringBuf.append-str &sb boundary) (StringBuf.append-crlf &sb) (StringBuf.append-str &sb "Content-Disposition: form-data; name=\"") - (StringBuf.append-str &sb &(escape-quotes (Part.name part))) + (StringBuf.append-str &sb + &(escape-quotes &(escape-newlines (Part.name part)))) (StringBuf.append-str &sb "\"") (match-ref (Part.filename part) (Maybe.Just fname) (do (StringBuf.append-str &sb "; filename=\"") - (StringBuf.append-str &sb &(escape-quotes fname)) + (StringBuf.append-str &sb + &(escape-quotes &(escape-newlines fname))) (StringBuf.append-str &sb "\"")) (Maybe.Nothing) ()) (StringBuf.append-crlf &sb) @@ -80,7 +195,7 @@ the given boundary (RFC 7578).") (Maybe.Just ct) (do (StringBuf.append-str &sb "Content-Type: ") - (StringBuf.append-str &sb ct) + (StringBuf.append-str &sb &(escape-newlines ct)) (StringBuf.append-crlf &sb)) (Maybe.Nothing) ()) (StringBuf.append-crlf &sb) diff --git a/test/http-client.carp b/test/http-client.carp index 891628b..9a58434 100644 --- a/test/http-client.carp +++ b/test/http-client.carp @@ -26,6 +26,42 @@ (defn get-body [url] (match (Client.get url) (Result.Success r) @(Response.body &r) _ @"")) +(defn count-occurrences [s needle] + (let-do [n 0 + rest @s + i (String.index-of-string &rest needle)] + (while-do (> i -1) + (set! n (Int.inc n)) + (set! rest + (String.byte-slice &rest + (+ i (String.length needle)) + (String.length &rest))) + (set! i (String.index-of-string &rest needle))) + n)) + +; Two parts, the first of which embeds `victim` as a delimiter line. +(defn parts-embedding [victim] + [(Multipart.text-part "note" + &(String.append "hello\r\n--" + &(String.append victim "\r\nmore"))) + (Multipart.text-part "after" "real")]) + +; How many delimiter lines a receiver finds in the encoded message. +(defn delimiters [parts boundary] + (count-occurrences &(Multipart.encode parts boundary) + &(String.append "--" boundary))) + +(defn legal-boundary? [b] + (and (<= (String.length b) 70) + (Array.reduce + &(fn [ok c] + (and ok + (String.contains? + "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'()+_,-./:=?" + @c))) + true + &(String.chars b)))) + (deftest test (assert-true test (Result.success? &(Client.get "http://127.0.0.1:8791/")) @@ -361,6 +397,61 @@ "b") "encode escapes quotes in name and filename") + (assert-equal test + 4 + (delimiters &(parts-embedding "----CarpBoundary1") "----CarpBoundary1") + "an unchecked boundary that occurs in a body splits two parts into three") + + (assert-equal test + 3 + (let [parts (parts-embedding &(Multipart.generate-boundary))] + (delimiters &parts &(Multipart.boundary-for &parts))) + "boundary-for keeps a body containing the delimiter in one part") + + (assert-equal test + 3 + (let [parts (parts-embedding + &(String.append &(Multipart.generate-boundary) "-tail"))] + (delimiters &parts &(Multipart.boundary-for &parts))) + "boundary-for keeps a body prefixed by the delimiter in one part") + + (assert-true test + (let [parts (parts-embedding &(Multipart.generate-boundary))] + (not + (String.contains-string? (Part.body (Array.unsafe-nth &parts 0)) + &(Multipart.boundary-for &parts)))) + "boundary-for returns a boundary absent from every body") + + (assert-true test + (let [parts (parts-embedding &(Multipart.generate-boundary))] + (legal-boundary? &(Multipart.boundary-for &parts))) + "boundary-for stays within the RFC 2046 length and alphabet") + + (assert-true test + (String.starts-with? + &(Multipart.boundary-for &(the (Array Part) [])) + "----CarpBoundary") + "boundary-for on no parts returns the plain generated boundary") + + (assert-equal test + &@"--b\r\nContent-Disposition: form-data; name=\"a%0D%0AX: y\"\r\n\r\nv\r\n--b--\r\n" + &(Multipart.encode &[(Multipart.text-part "a\r\nX: y" "v")] "b") + "encode percent-encodes CR and LF in a name") + + (assert-equal test + &@"--b\r\nContent-Disposition: form-data; name=\"up\"; filename=\"a.txt%0D%0AX: y\"\r\nContent-Type: text/plain\r\n\r\nd\r\n--b--\r\n" + &(Multipart.encode + &[(Multipart.file-part "up" "a.txt\r\nX: y" "text/plain" "d")] + "b") + "encode percent-encodes CR and LF in a filename") + + (assert-equal test + &@"--b\r\nContent-Disposition: form-data; name=\"up\"; filename=\"a.txt\"\r\nContent-Type: text/plain%0D%0AX: y\r\n\r\nd\r\n--b--\r\n" + &(Multipart.encode + &[(Multipart.file-part "up" "a.txt" "text/plain\r\nX: y" "d")] + "b") + "encode percent-encodes CR and LF in a content type") + (assert-true test (Result.success? &(Client.post-multipart "http://127.0.0.1:8791/post"