diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index f8106f4c83..cce9f07967 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs kernel math math.parser namespaces make sequences strings splitting calendar continuations accessors vectors @@ -10,6 +10,12 @@ io.streams.duplex fry ascii urls urls.encoding present http http.parsers ; IN: http.client +ERROR: too-many-redirects ; + +CONSTANT: max-redirects 10 + +> write bl ] @@ -21,17 +27,29 @@ IN: http.client [ host>> ] [ port>> ] bi dup "http" protocol-port = [ drop ] [ ":" swap number>string 3append ] if ; +: set-post-data-headers ( header post-data -- header ) + [ + data>> dup sequence? + [ length "content-length" ] + [ drop "chunked" "transfer-encoding" ] if + pick set-at + ] [ content-type>> "content-type" pick set-at ] bi ; + +: set-host-header ( request header -- request header ) + over url>> url-host "host" pick set-at ; + +: set-cookie-header ( header cookies -- header ) + unparse-cookie "cookie" pick set-at ; + : write-request-header ( request -- request ) dup header>> >hashtable - over url>> host>> [ over url>> url-host "host" pick set-at ] when - over post-data>> [ - [ data>> length "content-length" pick set-at ] - [ content-type>> "content-type" pick set-at ] - bi - ] when* - over cookies>> [ unparse-cookie "cookie" pick set-at ] unless-empty + over url>> host>> [ set-host-header ] when + over post-data>> [ set-post-data-headers ] when* + over cookies>> [ set-cookie-header ] unless-empty write-header ; +PRIVATE> + GENERIC: >post-data ( object -- post-data ) M: f >post-data ; @@ -51,6 +69,8 @@ M: object >post-data "application/octet-stream" swap >>data ; +> [ dup params>> [ @@ -62,11 +82,18 @@ M: object >post-data [ >post-data ] change-post-data normalize-post-data ; +: write-chunk ( chunk -- ) + [ length >hex ";\r\n" append ascii encode write ] [ write ] bi ; + +: write-chunked ( stream -- ) + [ [ write-chunk ] each-block ] with-input-stream + "0;\r\n" ascii encode write ; + : write-post-data ( request -- request ) dup method>> { "POST" "PUT" } member? [ dup post-data>> data>> dup sequence? - [ write ] [ output-stream get stream-copy ] if - ] when ; + [ write ] [ write-chunked ] if + ] when ; : write-request ( request -- ) unparse-post-data @@ -95,12 +122,6 @@ M: object >post-data read-response-line read-response-header ; -: max-redirects 10 ; - -ERROR: too-many-redirects ; - - ( -- stream ) request get url>> url-addr ascii drop @@ -166,6 +182,11 @@ SYMBOL: redirects [ do-redirect ] [ nip ] if ] with-variable ; inline recursive +: ( url method -- request ) + + swap >>method + swap >url ensure-port >>url ; inline + PRIVATE> : success? ( code -- ? ) 200 299 between? ; @@ -183,9 +204,7 @@ ERROR: download-failed response ; over content-charset>> decode ; : ( url -- request ) - - "GET" >>method - swap >url ensure-port >>url ; + "GET" ; : http-get ( url -- response data ) http-request ; @@ -203,14 +222,19 @@ ERROR: download-failed response ; dup download-name download-to ; : ( post-data url -- request ) - - "POST" >>method - swap >url ensure-port >>url + "POST" swap >>post-data ; : http-post ( post-data url -- response data ) http-request ; +: ( post-data url -- request ) + "PUT" + swap >>post-data ; + +: http-put ( post-data url -- response data ) + http-request ; + USING: vocabs vocabs.loader ; "debugger" vocab [ "http.client.debugger" require ] when diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 6fa23b4b1f..6b0bdbe2c0 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -1,4 +1,4 @@ -USING: http http.server http.client tools.test multiline +USING: http http.server http.client http.client.private tools.test multiline io.streams.string io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.encodings.string kernel arrays splitting sequences assocs io.sockets db db.sqlite continuations urls diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index 959642b706..a64fe9af3c 100644 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -55,7 +55,7 @@ IN: http.server.cgi binary encode-output _ output-stream get swap binary [ post-request? [ request get post-data>> data>> write flush ] when - input-stream get swap (stream-copy) + '[ _ write ] each-block ] with-stream ] >>body ; diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index c328e1d6a3..73a6b208d8 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -26,8 +26,6 @@ html.elements html.streams ; IN: http.server -\ parse-cookie DEBUG add-input-logging - : check-absolute ( url -- url ) dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline