From 7b344408ff8fe01cde781dedbbc25b127265ea3a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Jan 2009 20:02:14 -0600 Subject: [PATCH] Working on better POST and PUT requests --- basis/http/client/client.factor | 59 +----------- basis/http/client/post-data/authors.txt | 1 + .../client/post-data/post-data-tests.factor | 4 + basis/http/client/post-data/post-data.factor | 92 +++++++++++++++++++ 4 files changed, 99 insertions(+), 57 deletions(-) create mode 100644 basis/http/client/post-data/authors.txt create mode 100644 basis/http/client/post-data/post-data-tests.factor create mode 100644 basis/http/client/post-data/post-data.factor diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index cce9f07967..edfc6e312b 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -7,7 +7,7 @@ io io.sockets io.streams.string io.files io.timeouts io.pathnames io.encodings io.encodings.string io.encodings.ascii io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.streams.duplex fry ascii urls urls.encoding present -http http.parsers ; +http http.parsers http.client.post-data ; IN: http.client ERROR: too-many-redirects ; @@ -27,14 +27,6 @@ CONSTANT: max-redirects 10 [ 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 ; @@ -48,53 +40,6 @@ CONSTANT: max-redirects 10 over cookies>> [ set-cookie-header ] unless-empty write-header ; -PRIVATE> - -GENERIC: >post-data ( object -- post-data ) - -M: f >post-data ; - -M: post-data >post-data ; - -M: string >post-data - utf8 encode - "application/octet-stream" - swap >>data ; - -M: assoc >post-data - "application/x-www-form-urlencoded" - swap >>params ; - -M: object >post-data - "application/octet-stream" - swap >>data ; - -> [ - dup params>> [ - assoc>query ascii encode >>data - ] when* drop - ] when* ; - -: unparse-post-data ( request -- request ) - [ >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 ] [ write-chunked ] if - ] when ; - : write-request ( request -- ) unparse-post-data write-request-line @@ -197,7 +142,7 @@ ERROR: download-failed response ; dup code>> success? [ download-failed ] unless ; : with-http-request ( request quot -- response ) - (with-http-request) check-response ; inline + [ (with-http-request) check-response ] with-destructors ; inline : http-request ( request -- response data ) [ [ % ] with-http-request ] B{ } make diff --git a/basis/http/client/post-data/authors.txt b/basis/http/client/post-data/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/http/client/post-data/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/http/client/post-data/post-data-tests.factor b/basis/http/client/post-data/post-data-tests.factor new file mode 100644 index 0000000000..2704ce169f --- /dev/null +++ b/basis/http/client/post-data/post-data-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test http.client.post-data ; +IN: http.client.post-data.tests diff --git a/basis/http/client/post-data/post-data.factor b/basis/http/client/post-data/post-data.factor new file mode 100644 index 0000000000..5817fbda3b --- /dev/null +++ b/basis/http/client/post-data/post-data.factor @@ -0,0 +1,92 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs destructors http +http.client.post-data.private io io.encodings.ascii +io.encodings.binary io.encodings.string io.encodings.utf8 +io.files io.files.info io.pathnames kernel math.parser +namespaces sequences strings urls.encoding ; +IN: http.client.post-data + +TUPLE: measured-stream stream size ; + +C: measured-stream + +> "content-length" pick set-at ; + +M: object (set-post-data-headers) + drop "chunked" "transfer-encoding" pick set-at ; + +PRIVATE> + +: set-post-data-headers ( header post-data -- header ) + [ data>> (set-post-data-headers) ] + [ content-type>> "content-type" pick set-at ] bi ; + +> [ [ write ] each-block ] with-input-stream ; + +: write-chunk ( chunk -- ) + [ length >hex ";\r\n" append ascii encode write ] [ write ] bi ; + +M: object (write-post-data) + [ [ write-chunk ] each-block ] with-input-stream + "0;\r\n" ascii encode write ; + +GENERIC: >post-data ( object -- post-data ) + +M: f >post-data ; + +M: post-data >post-data ; + +M: string >post-data + utf8 encode + "application/octet-stream" + swap >>data ; + +M: assoc >post-data + "application/x-www-form-urlencoded" + swap >>params ; + +M: object >post-data + "application/octet-stream" + swap >>data ; + +: pathname>measured-stream ( pathname -- stream ) + string>> + [ binary &dispose ] + [ file-info size>> ] bi + ; + +: normalize-post-data ( request -- request ) + dup post-data>> [ + dup params>> [ + assoc>query ascii encode >>data + ] when* + dup data>> pathname? [ + [ pathname>measured-stream ] change-data + ] when + drop + ] when* ; + +PRIVATE> + +: unparse-post-data ( request -- request ) + [ >post-data ] change-post-data + normalize-post-data ; + +: write-post-data ( request -- request ) + dup post-data>> [ data>> (write-post-data) ] when* ;