Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,12 @@ chunked body, or a `Content-Length` body that ends short, comes back as
only by the connection closing declares no length to check against, so it is
taken as complete however the connection ends.

A `Content-Length` body ends at its last byte: the stream does not wait for the
connection to close, and drops anything the server sends after it. A
`Content-Length` that is not a plain number, disagrees with another one, or is
too large for an `Int` fails the request with `ClientError.Parse`. Any
`Transfer-Encoding` overrides `Content-Length`.

### Cookie jar

Use a `CookieJar` to store cookies from responses and replay them on
Expand Down
150 changes: 105 additions & 45 deletions http-client.carp
Original file line number Diff line number Diff line change
Expand Up @@ -309,12 +309,16 @@ apart.
(do (when (= eol p) (set! scanning false)) (set! p (+ eol 2))))))
(set-pos! s p)))

(hidden charge!)
(private charge!)
(defn charge! [s n]
(match-ref (remaining s)
(Maybe.Nothing) ()
(Maybe.Just left) (set-remaining! s (Maybe.Just (- @left n)))))
(hidden take!)
(private take!)
; drops whatever lies past the declared length
(defn take! [s chunk]
(match @(remaining s)
(Maybe.Nothing) chunk
(Maybe.Just left)
(let-do [n (min left (String.length &chunk))]
(set-remaining! s (Maybe.Just (- left n)))
(String.byte-slice &chunk 0 n))))

(hidden truncated?)
(private truncated?)
Expand All @@ -332,17 +336,18 @@ apart.
(hidden poll-raw)
(private poll-raw)
(defn poll-raw [s]
(if (> (String.length (buf s)) @(pos s))
(let-do [leftover (unconsumed s)]
(set-pos! s (String.length (buf s)))
(charge! s (String.length &leftover))
(Maybe.Just leftover))
(cond
(= (remaining s) &(Maybe.Just 0)) (do (set-done! s true) (Maybe.Nothing))
(> (String.length (buf s)) @(pos s))
(let-do [leftover (unconsumed s)]
(set-pos! s (String.length (buf s)))
(Maybe.Just (take! s leftover)))
(match (Connection.read (conn s))
(Result.Success chunk)
(if (String.empty? &chunk)
(end-raw! s
@"truncated body: the connection closed before Content-Length bytes arrived")
(do (charge! s (String.length &chunk)) (Maybe.Just chunk)))
(Maybe.Just (take! s chunk)))
(Result.Error e) (end-raw! s (fmt "read error: %s" &e)))))

(hidden poll-chunked)
Expand Down Expand Up @@ -569,15 +574,94 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
(defn bodyless? [verb code]
(or (= verb "HEAD") (or (< code 200) (or (= code 204) (= code 304)))))

(hidden parse-length)
(private parse-length)
; RFC 9110 §8.6: 1*DIGIT, which must also fit an Int
(defn parse-length [s]
(let-do [len (String.length s)
acc 0
digits (> len 0)
fits true]
(for [i 0 len]
(let [c (String.char-at s i)
d (- (Char.to-int c) 48)]
(cond
(not (Char.num? c)) (do (set! digits false) (break))
(> acc (/ (- Int.MAX d) 10)) (set! fits false)
(set! acc (+ (* acc 10) d)))))
(cond
(not digits)
(Result.Error
(ClientError.Parse (fmt "invalid Content-Length '%s'" s)))
(not fits)
(Result.Error
(ClientError.Parse (fmt "Content-Length too large: %s" s)))
(Result.Success acc))))

(hidden agree-length)
(private agree-length)
; RFC 9112 §6.3: repeated lengths must all be the same value
(defn agree-length [agreed member]
(match agreed
(Result.Error e) (Result.Error e)
(Result.Success prev)
(match (parse-length &(String.trim member))
(Result.Error e) (Result.Error e)
(Result.Success n)
(match prev
(Maybe.Nothing) (Result.Success (Maybe.Just n))
(Maybe.Just p)
(if (= p n)
(Result.Success (Maybe.Just n))
(Result.Error
(ClientError.Parse
(fmt "conflicting Content-Length values %d and %d" p n))))))))

(hidden content-lengths)
(private content-lengths)
; the members of every Content-Length field line, with comma lists split
(defn content-lengths [resp]
(Map.kv-reduce
&(fn [acc k vs]
(if (= &(String.ascii-to-lower k) "content-length")
(Array.reduce
&(fn [a v] (Array.concat &[a (String.split-by v &[\,])]))
acc
vs)
acc))
(the (Array String) [])
(Response.headers resp)))

(hidden declared-length)
(private declared-length)
; how many body bytes the response promises, or Nothing when it promises none
(defn declared-length [resp verb code]
(if (bodyless? verb code)
(Maybe.Nothing)
(match (Response.header resp "Content-Length")
(Maybe.Nothing) (Maybe.Nothing)
(Maybe.Just v) (Int.from-string &v))))
(if (or (bodyless? verb code)
(Maybe.just? &(Response.header resp "Transfer-Encoding")))
(Result.Success (Maybe.Nothing))
(Array.reduce &agree-length
(Result.Success (Maybe.Nothing))
&(content-lengths resp))))

(hidden open-stream)
(private open-stream)
(defn open-stream [conn resp leftover verb]
(let [code @(Response.code &resp)]
(match (declared-length &resp verb code)
(Result.Error e) (do (Connection.close conn) (Result.Error e))
(Result.Success left)
(let [is-chunked (and (Response.chunked? &resp)
(not (bodyless? verb code)))]
(Result.Success
(ResponseStream.init conn
leftover
0
(Maybe.Nothing)
is-chunked
false
left
code
resp))))))

; RFC 9110 §15.4.2–§15.4.4 method rewriting.
(hidden redirect-verb)
Expand Down Expand Up @@ -720,21 +804,9 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
(ClientError.Redirect
(fmt "too many redirects (max %d)" max-redir))))
(break)))
(let-do [leftover @(Pair.b &pair)
is-chunked (and (Response.chunked? &resp)
(not (bodyless? &cur-verb code)))
left (declared-length &resp &cur-verb code)]
(do
(set! result
(Result.Success
(ResponseStream.init conn
leftover
0
(Maybe.Nothing)
is-chunked
false
left
code
resp)))
(open-stream conn resp @(Pair.b &pair) &cur-verb))
(break)))))))
result))

Expand Down Expand Up @@ -1049,21 +1121,9 @@ See `RequestConfig` for timeout and redirect details.")
(ClientError.Redirect
(fmt "too many redirects (max %d)" max-redir))))
(break)))
(let-do [leftover @(Pair.b &pair)
is-chunked (and (Response.chunked? &resp)
(not (bodyless? &cur-verb code)))
left (declared-length &resp &cur-verb code)]
(do
(set! result
(Result.Success
(ResponseStream.init conn
leftover
0
(Maybe.Nothing)
is-chunked
false
left
code
resp)))
(open-stream conn resp @(Pair.b &pair) &cur-verb))
(break))))))))
result))

Expand Down
145 changes: 145 additions & 0 deletions test/http-client.carp
Original file line number Diff line number Diff line change
Expand Up @@ -108,6 +108,31 @@
(ResponseStream.close stream)
kind))))

; The body a stream yields poll by poll, then how it ended.
(defn streamed [url]
(match (Client.request-stream "GET"
url
(the (Map String (Array String)) {})
"")
(Result.Error e) (ClientError.message &e)
(Result.Success stream)
(let-do [body @""]
(while-do true
(match (ResponseStream.poll &stream)
(Maybe.Nothing) (break)
(Maybe.Just chunk) (set! body (String.append &body &chunk))))
(let-do [ended (match @(ResponseStream.error &stream)
(Maybe.Just e) (ClientError.message &e)
(Maybe.Nothing) @"clean")]
(ResponseStream.close stream)
(fmt "[%s] %s" &body &ended)))))

; The held routes keep the connection open for 10 s after the body.
(defn without-waiting [f]
(let-do [t0 (System.time)
res (~f)]
(if (< (- (System.time) t0) 5) res @"waited for the close")))

; Returns the empty string on request failure.
(defn get-body [url]
(match (Client.get url) (Result.Success r) @(Response.body &r) _ @""))
Expand Down Expand Up @@ -954,6 +979,126 @@
&jar)))
"the same holds on the cookie-jar path")

(assert-equal test
"200 [hello]"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-extra"))
"bytes past Content-Length are not part of the body")

(assert-equal test
"200 [hello]"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-extra-late"))
"bytes past Content-Length in a later read are not part of the body")

(assert-equal test
"[hello] clean"
&(streamed "http://127.0.0.1:8791/length-extra")
"a stream stops at Content-Length")

(assert-equal test
"200 [hello]"
&(without-waiting
&(fn [] (status-and-body (Client.get "http://127.0.0.1:8791/length-held"))))
"a complete Content-Length body does not wait for the close")

(assert-equal test
"[hello] clean"
&(without-waiting &(fn [] (streamed "http://127.0.0.1:8791/length-held")))
"a stream ends at the last Content-Length byte without waiting for the close")

(assert-equal test
"200 []"
&(without-waiting
&(fn []
(status-and-body (Client.get "http://127.0.0.1:8791/length-zero-held"))))
"a zero Content-Length does not wait for the close")

(assert-equal test
"invalid Content-Length '-5'"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-negative"))
"a negative Content-Length is rejected")

(assert-equal test
"invalid Content-Length ''"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-empty"))
"an empty Content-Length is rejected")

(assert-equal test
"invalid Content-Length '5x'"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-junk"))
"a Content-Length with trailing junk is rejected")

(assert-equal test
"invalid Content-Length '+5'"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-plus"))
"a signed Content-Length is rejected")

(assert-equal test
"parse"
&(error-kind (Client.get "http://127.0.0.1:8791/length-junk"))
"an invalid Content-Length is a Parse error")

(assert-equal test
"200 [hello]"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-list"))
"a list of identical Content-Length values counts as one")

(assert-equal test
"200 [hello]"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-lines"))
"repeated identical Content-Length lines count as one")

(assert-equal test
"conflicting Content-Length values 5 and 6"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-list-conflict"))
"a list of differing Content-Length values is rejected")

(assert-equal test
"conflicting Content-Length values 3 and 5"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-lines-conflict"))
"repeated differing Content-Length lines are rejected")

(assert-equal test
"conflicting Content-Length values 3 and 5"
&(let-do [jar (CookieJar.create)]
(status-and-body
(Client.get-with-jar "http://127.0.0.1:8791/length-lines-conflict" &jar)))
"the same holds on the cookie-jar path")

(assert-equal test
"truncated body: the connection closed before Content-Length bytes arrived"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-max"))
"the largest Content-Length an Int holds is still a length")

(assert-equal test
"Content-Length too large: 2147483648"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-over-max"))
"a Content-Length one past the largest Int is rejected")

(assert-equal test
"Content-Length too large: 4294967301"
&(status-and-body (Client.get "http://127.0.0.1:8791/length-wraps"))
"a Content-Length that would wrap to a small Int is rejected")

(assert-equal test
"200 [hello]"
&(status-and-body (Client.get "http://127.0.0.1:8791/chunked-bad-length"))
"a chunked body ignores an invalid Content-Length")

(assert-equal test
"200 [helloEXTRA]"
&(status-and-body (Client.get "http://127.0.0.1:8791/coded-length"))
"any Transfer-Encoding overrides Content-Length")

(assert-equal test
"204 []"
&(status-and-body (Client.get "http://127.0.0.1:8791/no-content-bad-length"))
"a 204 ignores an invalid Content-Length")

(assert-equal test
"200 []"
&(head-status-and-body "http://127.0.0.1:8791/length-negative")
"a HEAD response ignores an invalid Content-Length")

(assert-equal test
"127.0.0.1:8791"
&(seen-hosts (Client.get "http://127.0.0.1:8791/headers"))
Expand Down
Loading
Loading