suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow http-conn-send! to take a procedure as its #:data parameter

Browse Source
This commit is contained in:
Scott Bell 2014-07-04 20:45:51 -07:00 committed by Sam Tobin-Hochstadt
parent 9bd23a8726
commit ec0468a1f1
5 changed files with 51 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/net-pkgs/net-doc/net/scribblings/http-client.scrbl
View File

@ -74,7 +74,7 @@ Closes the output side of @racket[hc], if it is live.
[#:close? close? boolean? #f] [#:close? close? boolean? #f]
[#:headers headers (listof (or/c bytes? string?)) empty] [#:headers headers (listof (or/c bytes? string?)) empty]
[#:content-decode decodes (listof symbol?) '(gzip)] [#:content-decode decodes (listof symbol?) '(gzip)]
[#:data data (or/c false/c bytes? string?) #f]) [#:data data (or/c false/c bytes? string? data-procedure/c) #f])
void?]{ void?]{
Sends an HTTP request to @racket[hc] to the URI @racket[uri] using Sends an HTTP request to @racket[hc] to the URI @racket[uri] using
@ -82,6 +82,11 @@ HTTP version @racket[version] the method @racket[method] and the
additional headers given in @racket[headers] and the additional data additional headers given in @racket[headers] and the additional data
@racket[data]. @racket[data].
If @racket[data] is a procedure, it will be called once with a
procedure of one argument, which is a @racket[string] or
@racket[byte-string] to be written to the request body using
chunked transfer encoding.
If @racket[headers] does not contain an @litchar{Accept-Encoding} If @racket[headers] does not contain an @litchar{Accept-Encoding}
header, then a header indicating that encodings from @racket[decodes] header, then a header indicating that encodings from @racket[decodes]
are accepted is automatically added. are accepted is automatically added.
@ -117,7 +122,7 @@ to do so.
[#:version version (or/c bytes? string?) #"1.1"] [#:version version (or/c bytes? string?) #"1.1"]
[#:method method (or/c bytes? string? symbol?) #"GET"] [#:method method (or/c bytes? string? symbol?) #"GET"]
[#:headers headers (listof (or/c bytes? string?)) empty] [#:headers headers (listof (or/c bytes? string?)) empty]
[#:data data (or/c false/c bytes? string?) #f] [#:data data (or/c false/c bytes? string? data-procedure/c) #f]
[#:content-decode decodes (listof symbol?) '(gzip)] [#:content-decode decodes (listof symbol?) '(gzip)]
[#:close? close? boolean? #f]) [#:close? close? boolean? #f])
(values bytes? (listof bytes?) input-port?)]{ (values bytes? (listof bytes?) input-port?)]{
@ -132,7 +137,7 @@ Calls @racket[http-conn-send!] and @racket[http-conn-recv!] in sequence.
[#:version version (or/c bytes? string?) #"1.1"] [#:version version (or/c bytes? string?) #"1.1"]
[#:method method (or/c bytes? string? symbol?) #"GET"] [#:method method (or/c bytes? string? symbol?) #"GET"]
[#:headers headers (listof (or/c bytes? string?)) empty] [#:headers headers (listof (or/c bytes? string?)) empty]
[#:data data (or/c false/c bytes? string?) #f] [#:data data (or/c false/c bytes? string? data-procedure/c) #f]
[#:content-decode decodes (listof symbol?) '(gzip)]) [#:content-decode decodes (listof symbol?) '(gzip)])
(values bytes? (listof bytes?) input-port?)]{ (values bytes? (listof bytes?) input-port?)]{

2
pkgs/net-pkgs/net-doc/net/scribblings/url.scrbl
View File

@ -444,7 +444,7 @@ mapping is the empty list (i.e., no proxies).}
@defproc[(http-sendrecv/url [u url?] @defproc[(http-sendrecv/url [u url?]
[#:method method (or/c bytes? string? symbol?) #"GET"] [#:method method (or/c bytes? string? symbol?) #"GET"]
[#:headers headers (listof (or/c bytes? string?)) empty] [#:headers headers (listof (or/c bytes? string?)) empty]
[#:data data (or/c false/c bytes? string?) #f] [#:data data (or/c false/c bytes? string? data-procedure/c) #f]
[#:content-decode decodes (listof symbol?) '(gzip)]) [#:content-decode decodes (listof symbol?) '(gzip)])
(values bytes? (listof bytes?) input-port?)]{ (values bytes? (listof bytes?) input-port?)]{

8
pkgs/net-pkgs/net-test/tests/net/http-client.rkt
View File

@ -240,4 +240,12 @@
#"PUT / HTTP/1.1\r\nHost: localhost:REDACTED\r\nUser-Agent: Racket/REDACTED (net/http-client)\r\nAccept-Encoding: gzip\r\nContent-Length: 4\r\nConnection: close\r\n\r\nfrob" #"PUT / HTTP/1.1\r\nHost: localhost:REDACTED\r\nUser-Agent: Racket/REDACTED (net/http-client)\r\nAccept-Encoding: gzip\r\nContent-Length: 4\r\nConnection: close\r\n\r\nfrob"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'() '()
#""]
["PUT"
(λ (w) (w "fr") (w "ob"))
"HTTP/1.1 200 OK\r\n\r\n"
#"PUT / HTTP/1.1\r\nHost: localhost:REDACTED\r\nUser-Agent: Racket/REDACTED (net/http-client)\r\nAccept-Encoding: gzip\r\nTransfer-Encoding: chunked\r\nConnection: close\r\n\r\n2\r\nfr\r\n2\r\nob\r\n\r\n"
#"HTTP/1.1 200 OK"
'()
#""])) #""]))

49
racket/collects/net/http-client.rkt
View File

@ -24,6 +24,11 @@
(bytes->string/utf-8 bs) (bytes->string/utf-8 bs)
bs)) bs))
(define (->bytes str)
(if (string? str)
(string->bytes/utf-8 str)
str))
(define (read-bytes-line/not-eof ip kind) (define (read-bytes-line/not-eof ip kind)
(define bs (read-bytes-line ip kind)) (define bs (read-bytes-line ip kind))
(when (eof-object? bs) (when (eof-object? bs)
@ -93,14 +98,17 @@
(abandon to) (abandon to)
(set-http-conn-to! hc #f))) (set-http-conn-to! hc #f)))
(define (write-chunk out data)
(let ([bytes (->bytes data)])
(fprintf out "~x\r\n~a\r\n" (bytes-length bytes) bytes)))
(define (http-conn-send! hc url-bs (define (http-conn-send! hc url-bs
#:version [version-bs #"1.1"] #:version [version-bs #"1.1"]
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:close? [close? #f] #:close? [close? #f]
#:headers [headers-bs empty] #:headers [headers-bs empty]
#:content-decode [decodes '(gzip)] #:content-decode [decodes '(gzip)]
;; xxx maybe support other kinds of data (ports and writing functions) #:data [data #f])
#:data [data-bsf #f])
(match-define (http-conn host port port-usual? to from _) hc) (match-define (http-conn host port port-usual? to from _) hc)
(fprintf to "~a ~a HTTP/~a\r\n" method-bss url-bs version-bs) (fprintf to "~a ~a HTTP/~a\r\n" method-bss url-bs version-bs)
(unless (regexp-member #rx"^(?i:Host:) +.+$" headers-bs) (unless (regexp-member #rx"^(?i:Host:) +.+$" headers-bs)
@ -114,21 +122,22 @@
(unless (or (not (memq 'gzip decodes)) (unless (or (not (memq 'gzip decodes))
(regexp-member #rx"^(?i:Accept-Encoding:) +.+$" headers-bs)) (regexp-member #rx"^(?i:Accept-Encoding:) +.+$" headers-bs))
(fprintf to "Accept-Encoding: gzip\r\n")) (fprintf to "Accept-Encoding: gzip\r\n"))
(define data (define body (->bytes data))
(if (string? data-bsf) (cond [(procedure? body)
(string->bytes/utf-8 data-bsf) (fprintf to "Transfer-Encoding: chunked\r\n")]
data-bsf)) [(and body
(when data (not (regexp-member #rx"^(?i:Content-Length:) +.+$" headers-bs)))
(unless (regexp-member #rx"^(?i:Content-Length:) +.+$" headers-bs) (fprintf to "Content-Length: ~a\r\n" (bytes-length body))])
(fprintf to "Content-Length: ~a\r\n" (bytes-length data))))
(when close? (when close?
(unless (regexp-member #rx"^(?i:Connection:) +.+$" headers-bs) (unless (regexp-member #rx"^(?i:Connection:) +.+$" headers-bs)
(fprintf to "Connection: close\r\n"))) (fprintf to "Connection: close\r\n")))
(for ([h (in-list headers-bs)]) (for ([h (in-list headers-bs)])
(fprintf to "~a\r\n" h)) (fprintf to "~a\r\n" h))
(fprintf to "\r\n") (fprintf to "\r\n")
(when data (cond [(procedure? body)
(display data to)) (body (λ (data) (write-chunk to data)))
(fprintf to "\r\n")]
[body (display body to)])
(flush-output to)) (flush-output to))
(define (http-conn-status! hc) (define (http-conn-status! hc)
@ -258,7 +267,7 @@
#:version [version-bs #"1.1"] #:version [version-bs #"1.1"]
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:headers [headers-bs empty] #:headers [headers-bs empty]
#:data [data-bsf #f] #:data [data #f]
#:content-decode [decodes '(gzip)] #:content-decode [decodes '(gzip)]
#:close? [close? #f]) #:close? [close? #f])
(http-conn-send! hc url-bs (http-conn-send! hc url-bs
@ -267,7 +276,7 @@
#:close? close? #:close? close?
#:headers headers-bs #:headers headers-bs
#:content-decode decodes #:content-decode decodes
#:data data-bsf) #:data data)
(http-conn-recv! hc (http-conn-recv! hc
#:content-decode decodes #:content-decode decodes
#:close? close?)) #:close? close?))
@ -278,18 +287,22 @@
#:version [version-bs #"1.1"] #:version [version-bs #"1.1"]
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:headers [headers-bs empty] #:headers [headers-bs empty]
#:data [data-bsf #f] #:data [data #f]
#:content-decode [decodes '(gzip)]) #:content-decode [decodes '(gzip)])
(define hc (http-conn-open host-bs #:ssl? ssl? #:port port)) (define hc (http-conn-open host-bs #:ssl? ssl? #:port port))
(http-conn-sendrecv! hc url-bs (http-conn-sendrecv! hc url-bs
#:version version-bs #:version version-bs
#:method method-bss #:method method-bss
#:headers headers-bs #:headers headers-bs
#:data data-bsf #:data data
#:content-decode decodes #:content-decode decodes
#:close? #t)) #:close? #t))
(define data-procedure/c
(-> (-> (or/c bytes? string?) any/c) any/c))
(provide (provide
data-procedure/c
(contract-out (contract-out
[http-conn? [http-conn?
(-> any/c (-> any/c
@ -317,7 +330,7 @@
#:close? boolean? #:close? boolean?
#:headers (listof (or/c bytes? string?)) #:headers (listof (or/c bytes? string?))
#:content-decode (listof symbol?) #:content-decode (listof symbol?)
#:data (or/c false/c bytes? string?)) #:data (or/c false/c bytes? string? data-procedure/c))
void)] void)]
;; Derived ;; Derived
[http-conn-open [http-conn-open
@ -335,7 +348,7 @@
(#:version (or/c bytes? string?) (#:version (or/c bytes? string?)
#:method (or/c bytes? string? symbol?) #:method (or/c bytes? string? symbol?)
#:headers (listof (or/c bytes? string?)) #:headers (listof (or/c bytes? string?))
#:data (or/c false/c bytes? string?) #:data (or/c false/c bytes? string? data-procedure/c)
#:content-decode (listof symbol?) #:content-decode (listof symbol?)
#:close? boolean?) #:close? boolean?)
(values bytes? (listof bytes?) input-port?))] (values bytes? (listof bytes?) input-port?))]
@ -346,6 +359,6 @@
#:version (or/c bytes? string?) #:version (or/c bytes? string?)
#:method (or/c bytes? string? symbol?) #:method (or/c bytes? string? symbol?)
#:headers (listof (or/c bytes? string?)) #:headers (listof (or/c bytes? string?))
#:data (or/c false/c bytes? string?) #:data (or/c false/c bytes? string? data-procedure/c)
#:content-decode (listof symbol?)) #:content-decode (listof symbol?))
(values bytes? (listof bytes?) input-port?))])) (values bytes? (listof bytes?) input-port?))]))

6
racket/collects/net/url.rkt
View File

@ -749,7 +749,7 @@
(define (http-sendrecv/url u (define (http-sendrecv/url u
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:headers [headers-bs empty] #:headers [headers-bs empty]
#:data [data-bsf #f] #:data [data #f]
#:content-decode [decodes '(gzip)]) #:content-decode [decodes '(gzip)])
(unless (member (url-scheme u) '(#f "http" "https")) (unless (member (url-scheme u) '(#f "http" "https"))
(error 'http-sendrecv/url "URL scheme ~e not supported" (url-scheme u))) (error 'http-sendrecv/url "URL scheme ~e not supported" (url-scheme u)))
@ -777,7 +777,7 @@
#:port port #:port port
#:method method-bss #:method method-bss
#:headers headers-bs #:headers headers-bs
#:data data-bsf #:data data
#:content-decode decodes)) #:content-decode decodes))
(provide (provide
@ -786,6 +786,6 @@
(->* (url?) (->* (url?)
(#:method (or/c bytes? string? symbol?) (#:method (or/c bytes? string? symbol?)
#:headers (listof (or/c bytes? string?)) #:headers (listof (or/c bytes? string?))
#:data (or/c false/c bytes? string?) #:data (or/c false/c bytes? string? hc:data-procedure/c)
#:content-decode (listof symbol?)) #:content-decode (listof symbol?))
(values bytes? (listof bytes?) input-port?))])) (values bytes? (listof bytes?) input-port?))]))