steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add support for chunked encoding, and set connection: close on http requests

db4
Slava Pestov 2008-04-22 14:37:26 -05:00
parent 4fdfb97a4d
commit 206609242e
2 changed files with 41 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
extra/http/client/client.factor
View File

@ -3,7 +3,7 @@
USING: assocs http kernel math math.parser namespaces sequences USING: assocs http kernel math math.parser namespaces sequences
io io.sockets io.streams.string io.files io.timeouts strings io io.sockets io.streams.string io.files io.timeouts strings
splitting calendar continuations accessors vectors 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 IN: http.client
DEFER: http-request DEFER: http-request
@ -61,20 +61,43 @@ PRIVATE>
] close-on-error ] close-on-error
] with-variable ; ] 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 ) : <get-request> ( url -- request )
<request> request-with-url "GET" >>method ; <request> request-with-url "GET" >>method ;
: http-get-stream ( url -- response stream ) : string-or-contents ( stream/string -- string )
<get-request> http-request ; dup string? [ contents ] unless ;
: http-get-stream ( url -- response stream/string )
<get-request> http-request do-chunked-encoding ;
: success? ( code -- ? ) 200 = ; : success? ( code -- ? ) 200 = ;
: check-response ( response -- ) ERROR: download-failed response body ;
code>> success?
[ "HTTP download failed" throw ] unless ; 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 ( url -- string )
http-get-stream contents swap check-response ; http-get-stream string-or-contents check-response ;
: download-name ( url -- name ) : download-name ( url -- name )
file-name "?" split1 drop "/" ?tail drop ; file-name "?" split1 drop "/" ?tail drop ;
@ -95,4 +118,4 @@ PRIVATE>
swap >>post-data-type ; swap >>post-data-type ;
: http-post ( content-type content url -- response string ) : http-post ( content-type content url -- response string )
<post-request> http-request contents ; <post-request> http-request do-chunked-encoding string-or-contents ;

19
extra/http/http.factor
View File

@ -175,13 +175,17 @@ post-data
post-data-type post-data-type
cookies ; cookies ;
: set-header ( request/response value key -- request/response )
pick header>> set-at ;
: <request> : <request>
request new request new
"1.1" >>version "1.1" >>version
http-port >>port http-port >>port
H{ } clone >>header H{ } clone >>header
H{ } clone >>query H{ } clone >>query
V{ } clone >>cookies ; V{ } clone >>cookies
"close" "connection" set-header ;
: query-param ( request key -- value ) : query-param ( request key -- value )
swap query>> at ; swap query>> at ;
@ -330,9 +334,6 @@ SYMBOL: max-post-request
tri tri
] with-string-writer ; ] with-string-writer ;
: set-header ( request/response value key -- request/response )
pick header>> set-at ;
GENERIC: write-response ( response -- ) GENERIC: write-response ( response -- )
GENERIC: write-full-response ( request response -- ) GENERIC: write-full-response ( request response -- )
@ -347,11 +348,11 @@ body ;
: <response> : <response>
response new response new
"1.1" >>version "1.1" >>version
H{ } clone >>header H{ } clone >>header
"close" "connection" set-header "close" "connection" set-header
now timestamp>http-string "date" set-header now timestamp>http-string "date" set-header
V{ } clone >>cookies ; V{ } clone >>cookies ;
: read-response-version : read-response-version
" \t" read-until " \t" read-until