Restoring old decoding behavior of net/url and allowing future compatibility by parameterizing what is accepted
This commit is contained in:
parent
f8d3d6c81b
commit
0a336024a9
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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?))]))
|
||||||
|
|
|
@ -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?))]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user