Restoring old decoding behavior of net/url and allowing future compatibility by parameterizing what is accepted

This commit is contained in:
Jay McCarthy 2013-10-15 09:58:00 -06:00
parent f8d3d6c81b
commit 0a336024a9
4 changed files with 43 additions and 14 deletions

View File

@ -72,6 +72,7 @@ Closes the output side of @racket[hc], if it is live.
[#: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]
[#:content-decode decodes (listof symbol?) '(gzip)]
[#:data data (or/c false/c bytes? string?) #f]) [#:data data (or/c false/c bytes? string?) #f])
void?]{ void?]{
@ -80,16 +81,22 @@ 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[headers] does not contain an @litchar{Accept-Encoding}
header, then a header indicating that encodings from @racket[decodes]
are accepted is automatically added.
This function does not support requests that expect This function does not support requests that expect
@litchar{100 (Continue)} responses. @litchar{100 (Continue)} responses.
} }
@defproc[(http-conn-recv! [hc http-conn-live?] @defproc[(http-conn-recv! [hc http-conn-live?]
[#: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?)]{
Parses an HTTP response from @racket[hc]. Parses an HTTP response from @racket[hc], while decoding the encodings
listed in @racket[decodes].
Returns the status line, a list of headers, and an port which contains Returns the status line, a list of headers, and an port which contains
the contents of the response. the contents of the response.
@ -106,6 +113,7 @@ to do so.
[#: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?) #f]
[#: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?)]{
@ -119,7 +127,8 @@ 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?) #f]
[#:content-decode decodes (listof symbol?) '(gzip)])
(values bytes? (listof bytes?) input-port?)]{ (values bytes? (listof bytes?) input-port?)]{
Calls @racket[http-conn-send!] and @racket[http-conn-recv!] in Calls @racket[http-conn-send!] and @racket[http-conn-recv!] in

View File

@ -433,7 +433,8 @@ 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?) #f]
[#:content-decode decodes (listof symbol?) '(gzip)])
(values bytes? (listof bytes?) input-port?)]{ (values bytes? (listof bytes?) input-port?)]{
Calls @racket[http-sendrecv] using @racket[u] to populate the host, URI, port, and SSL parameters. Calls @racket[http-sendrecv] using @racket[u] to populate the host, URI, port, and SSL parameters.

View File

@ -85,6 +85,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]
#:content-decode [decodes '(gzip)]
;; xxx maybe support other kinds of data (ports and writing functions) ;; xxx maybe support other kinds of data (ports and writing functions)
#:data [data-bsf #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)
@ -94,7 +95,8 @@
(if port-usual? (if port-usual?
host host
(format "~a:~a" host port)))) (format "~a:~a" host port))))
(unless (regexp-member #rx"^(?i:Accept-Encoding:) +.+$" headers-bs) (unless (or (not (memq 'gzip decodes))
(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 data
(if (string? data-bsf) (if (string? data-bsf)
@ -180,6 +182,7 @@
hc) hc)
(define (http-conn-recv! hc (define (http-conn-recv! hc
#:content-decode [decodes '(gzip)]
#:close? [iclose? #f]) #:close? [iclose? #f])
(define status (http-conn-status! hc)) (define status (http-conn-status! hc))
(define headers (http-conn-headers! hc)) (define headers (http-conn-headers! hc))
@ -206,7 +209,7 @@
(http-conn-response-port/rest! hc)])) (http-conn-response-port/rest! hc)]))
(define decoded-response-port (define decoded-response-port
(cond (cond
[(regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers) [(and (memq 'gzip decodes) (regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers))
(define-values (in out) (make-pipe PIPE-SIZE)) (define-values (in out) (make-pipe PIPE-SIZE))
(thread (thread
(λ () (λ ()
@ -222,13 +225,17 @@
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:headers [headers-bs empty] #:headers [headers-bs empty]
#:data [data-bsf #f] #:data [data-bsf #f]
#:content-decode [decodes '(gzip)]
#:close? [close? #f]) #:close? [close? #f])
(http-conn-send! hc url-bs (http-conn-send! hc url-bs
#:version version-bs #:version version-bs
#:method method-bss #:method method-bss
#:headers headers-bs #:headers headers-bs
#:content-decode decodes
#:data data-bsf) #:data data-bsf)
(http-conn-recv! hc #:close? close?)) (http-conn-recv! hc
#:content-decode decodes
#:close? close?))
(define (http-sendrecv host-bs url-bs (define (http-sendrecv host-bs url-bs
#:ssl? [ssl? #f] #:ssl? [ssl? #f]
@ -236,13 +243,15 @@
#: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-bsf #f]
#: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-bsf
#:content-decode decodes
#:close? #t)) #:close? #t))
(provide (provide
@ -271,6 +280,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?))
#:content-decode (listof symbol?)
#:data (or/c false/c bytes? string?)) #:data (or/c false/c bytes? string?))
void)] void)]
;; Derived ;; Derived
@ -281,7 +291,8 @@
http-conn?)] http-conn?)]
[http-conn-recv! [http-conn-recv!
(->* (http-conn-live?) (->* (http-conn-live?)
(#:close? boolean?) (#:content-decode (listof symbol?)
#:close? boolean?)
(values bytes? (listof bytes?) input-port?))] (values bytes? (listof bytes?) input-port?))]
[http-conn-sendrecv! [http-conn-sendrecv!
(->* (http-conn-live? (or/c bytes? string?)) (->* (http-conn-live? (or/c bytes? string?))
@ -289,6 +300,7 @@
#: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?)
#:content-decode (listof symbol?)
#:close? boolean?) #:close? boolean?)
(values bytes? (listof bytes?) input-port?))] (values bytes? (listof bytes?) input-port?))]
[http-sendrecv [http-sendrecv
@ -298,5 +310,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?)
#:content-decode (listof symbol?))
(values bytes? (listof bytes?) input-port?))])) (values bytes? (listof bytes?) input-port?))]))

View File

@ -147,6 +147,7 @@
(hc:http-conn-send! hc access-string (hc:http-conn-send! hc access-string
#:method (if get? "GET" "POST") #:method (if get? "GET" "POST")
#:headers strings #:headers strings
#:content-decode '()
#:data post-data) #:data post-data)
hc) hc)
@ -204,7 +205,7 @@
(define (http-conn-impure-port hc) (define (http-conn-impure-port hc)
(define-values (in out) (make-pipe 4096)) (define-values (in out) (make-pipe 4096))
(define-values (status headers response-port) (define-values (status headers response-port)
(hc:http-conn-recv! hc #:close? #t)) (hc:http-conn-recv! hc #:close? #t #:content-decode '()))
(fprintf out "~a\r\n" status) (fprintf out "~a\r\n" status)
(for ([h (in-list headers)]) (for ([h (in-list headers)])
(fprintf out "~a\r\n" h)) (fprintf out "~a\r\n" h))
@ -239,6 +240,7 @@
(http://getpost-impure-port (http://getpost-impure-port
get? url post-data strings get? url post-data strings
make-ports #f) make-ports #f)
#:content-decode '()
#:close? #t)) #:close? #t))
response-port] response-port]
[else [else
@ -270,7 +272,7 @@
make-ports) make-ports)
(and conn #t))) (and conn #t)))
(define-values (status headers response-port) (define-values (status headers response-port)
(hc:http-conn-recv! hc #:close? (not conn))) (hc:http-conn-recv! hc #:close? (not conn) #:content-decode '()))
(define new-url (define new-url
(ormap (λ (h) (ormap (λ (h)
@ -662,6 +664,7 @@
(hc:http-conn-send! hc access-string (hc:http-conn-send! hc access-string
#:method method #:method method
#:headers strings #:headers strings
#:content-decode '()
#:data data) #:data data)
(http-conn-impure-port hc))) (http-conn-impure-port hc)))
@ -730,7 +733,8 @@
(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-bsf #f]
#: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)))
(define ssl? (define ssl?
@ -757,7 +761,8 @@
#:port port #:port port
#:method method-bss #:method method-bss
#:headers headers-bs #:headers headers-bs
#:data data-bsf)) #:data data-bsf
#:content-decode decodes))
(provide (provide
(contract-out (contract-out
@ -765,5 +770,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?)
#:content-decode (listof symbol?))
(values bytes? (listof bytes?) input-port?))])) (values bytes? (listof bytes?) input-port?))]))