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

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

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