Add support for chunked encoding, and set connection: close on http requests
parent
4fdfb97a4d
commit
206609242e
|
|
@ -3,7 +3,7 @@
|
|||
USING: assocs http kernel math math.parser namespaces sequences
|
||||
io io.sockets io.streams.string io.files io.timeouts strings
|
||||
splitting calendar continuations accessors vectors
|
||||
io.encodings.8-bit io.encodings.binary fry ;
|
||||
io.encodings.8-bit io.encodings.binary fry debugger ;
|
||||
IN: http.client
|
||||
|
||||
DEFER: http-request
|
||||
|
|
@ -61,20 +61,43 @@ PRIVATE>
|
|||
] close-on-error
|
||||
] with-variable ;
|
||||
|
||||
: read-chunks ( -- )
|
||||
readln ";" split1 drop hex>
|
||||
dup { f 0 } member? [ drop ] [ read % read-chunks ] if ;
|
||||
|
||||
: do-chunked-encoding ( response stream -- response stream/string )
|
||||
over "transfer-encoding" header "chunked" = [
|
||||
[ [ read-chunks ] "" make ] with-stream
|
||||
] when ;
|
||||
|
||||
: <get-request> ( url -- request )
|
||||
<request> request-with-url "GET" >>method ;
|
||||
|
||||
: http-get-stream ( url -- response stream )
|
||||
<get-request> http-request ;
|
||||
: string-or-contents ( stream/string -- string )
|
||||
dup string? [ contents ] unless ;
|
||||
|
||||
: http-get-stream ( url -- response stream/string )
|
||||
<get-request> http-request do-chunked-encoding ;
|
||||
|
||||
: success? ( code -- ? ) 200 = ;
|
||||
|
||||
: check-response ( response -- )
|
||||
code>> success?
|
||||
[ "HTTP download failed" throw ] unless ;
|
||||
ERROR: download-failed response body ;
|
||||
|
||||
M: download-failed error.
|
||||
"HTTP download failed:" print nl
|
||||
[
|
||||
response>>
|
||||
write-response-code
|
||||
write-response-message nl
|
||||
drop
|
||||
]
|
||||
[ body>> write ] bi ;
|
||||
|
||||
: check-response ( response string -- string )
|
||||
over code>> success? [ nip ] [ download-failed ] if ;
|
||||
|
||||
: http-get ( url -- string )
|
||||
http-get-stream contents swap check-response ;
|
||||
http-get-stream string-or-contents check-response ;
|
||||
|
||||
: download-name ( url -- name )
|
||||
file-name "?" split1 drop "/" ?tail drop ;
|
||||
|
|
@ -95,4 +118,4 @@ PRIVATE>
|
|||
swap >>post-data-type ;
|
||||
|
||||
: http-post ( content-type content url -- response string )
|
||||
<post-request> http-request contents ;
|
||||
<post-request> http-request do-chunked-encoding string-or-contents ;
|
||||
|
|
|
|||
|
|
@ -175,13 +175,17 @@ post-data
|
|||
post-data-type
|
||||
cookies ;
|
||||
|
||||
: set-header ( request/response value key -- request/response )
|
||||
pick header>> set-at ;
|
||||
|
||||
: <request>
|
||||
request new
|
||||
"1.1" >>version
|
||||
http-port >>port
|
||||
H{ } clone >>header
|
||||
H{ } clone >>query
|
||||
V{ } clone >>cookies ;
|
||||
V{ } clone >>cookies
|
||||
"close" "connection" set-header ;
|
||||
|
||||
: query-param ( request key -- value )
|
||||
swap query>> at ;
|
||||
|
|
@ -330,9 +334,6 @@ SYMBOL: max-post-request
|
|||
tri
|
||||
] with-string-writer ;
|
||||
|
||||
: set-header ( request/response value key -- request/response )
|
||||
pick header>> set-at ;
|
||||
|
||||
GENERIC: write-response ( response -- )
|
||||
|
||||
GENERIC: write-full-response ( request response -- )
|
||||
|
|
@ -347,11 +348,11 @@ body ;
|
|||
|
||||
: <response>
|
||||
response new
|
||||
"1.1" >>version
|
||||
H{ } clone >>header
|
||||
"close" "connection" set-header
|
||||
now timestamp>http-string "date" set-header
|
||||
V{ } clone >>cookies ;
|
||||
"1.1" >>version
|
||||
H{ } clone >>header
|
||||
"close" "connection" set-header
|
||||
now timestamp>http-string "date" set-header
|
||||
V{ } clone >>cookies ;
|
||||
|
||||
: read-response-version
|
||||
" \t" read-until
|
||||
|
|
|
|||
Loading…
Reference in New Issue