Support gzip encoded HTTP responses

This commit is contained in:
Jay McCarthy 2013-09-04 08:56:46 -06:00
parent ba6e1754eb
commit 5a7ce6d60a
2 changed files with 32 additions and 18 deletions

View File

@ -67,92 +67,92 @@
(tests (tests
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one" ["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK" #"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain") '(#"Content-Type: text/plain")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 62\r\n\r\nThis is the data in the first chunk and this is the second one" ["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 62\r\n\r\nThis is the data in the first chunk and this is the second one"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK" #"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain" #"Content-Length: 62") '(#"Content-Type: text/plain" #"Content-Length: 62")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\ncontent-length: 62\r\n\r\nThis is the data in the first chunk and this is the second one" ["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\ncontent-length: 62\r\n\r\nThis is the data in the first chunk and this is the second one"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK" #"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain" #"content-length: 62") '(#"Content-Type: text/plain" #"content-length: 62")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
#"This is the data in the first chand this is the second oneXXXXXXX"] #"This is the data in the first chand this is the second oneXXXXXXX"]
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one" ["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK" #"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain") '(#"Content-Type: text/plain")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
#"This is the data in the first chand this is the second oneXXXXXXX"] #"This is the data in the first chand this is the second oneXXXXXXX"]
["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n" ["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK" #"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain") '(#"Content-Type: text/plain")
#"This is the data in the first chunk and this is the second one\r\n"] #"This is the data in the first chunk and this is the second one\r\n"]
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one" ["HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK" #"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain") '(#"Content-Type: text/plain")
#"This is the data in the first chunk and this is the second one"] #"This is the data in the first chunk and this is the second one"]
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
#"This is the data in the first chand this is the second oneXXXXXXX"] #"This is the data in the first chand this is the second oneXXXXXXX"]
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked" #"Another-Header: ta-daa") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked" #"Another-Header: ta-daa")
#"This is the data in the first chand this is the second oneXXXXXXX"] #"This is the data in the first chand this is the second oneXXXXXXX"]
["HTTP/1.1 301 Moved Permanently\r\nLocation: http://localhost:9002/whatever\r\n\r\nstuff" ["HTTP/1.1 301 Moved Permanently\r\nLocation: http://localhost:9002/whatever\r\n\r\nstuff"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 301 Moved Permanently" #"HTTP/1.1 301 Moved Permanently"
'(#"Location: http://localhost:9002/whatever") '(#"Location: http://localhost:9002/whatever")
#"stuff"] #"stuff"]
["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n" ["HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n"
#"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.1 200 OK" #"HTTP/1.1 200 OK"
'(#"Content-Type: text/plain" #"Transfer-Encoding: chunked" #"Another-Header: ta-daa") '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked" #"Another-Header: ta-daa")
#"This is the data in the first chand this is the second oneXXXXXXX"])) #"This is the data in the first chand this is the second oneXXXXXXX"]))

View File

@ -7,7 +7,8 @@
[tcp-connect plain-tcp-connect] [tcp-connect plain-tcp-connect]
[tcp-abandon-port plain-tcp-abandon-port]) [tcp-abandon-port plain-tcp-abandon-port])
openssl openssl
"win32-ssl.rkt") "win32-ssl.rkt"
file/gunzip)
;; Lib ;; Lib
@ -87,6 +88,8 @@
(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)
(fprintf to "Host: ~a\r\n" host)) (fprintf to "Host: ~a\r\n" host))
(unless (regexp-member #rx"^(?i:Accept-Encoding:) +.+$" headers-bs)
(fprintf to "Accept-Encoding: gzip\r\n"))
(define data (define data
(if (string? data-bsf) (if (string? data-bsf)
(string->bytes/utf-8 data-bsf) (string->bytes/utf-8 data-bsf)
@ -179,7 +182,7 @@
(regexp-member #rx#"^(?i:Connection: +close)$" headers))) (regexp-member #rx#"^(?i:Connection: +close)$" headers)))
(when close? (when close?
(http-conn-abandon! hc)) (http-conn-abandon! hc))
(define response-port (define raw-response-port
(cond (cond
[(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers) [(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers)
(http-conn-response-port/chunked! hc #:close? #t)] (http-conn-response-port/chunked! hc #:close? #t)]
@ -195,7 +198,18 @@
(http-conn-response-port/length! hc count #:close? close?))] (http-conn-response-port/length! hc count #:close? close?))]
[else [else
(http-conn-response-port/rest! hc)])) (http-conn-response-port/rest! hc)]))
(values status headers response-port)) (define decoded-response-port
(cond
[(regexp-member #rx#"^(?i:Content-Encoding: +gzip)$" headers)
(define-values (in out) (make-pipe PIPE-SIZE))
(thread
(λ ()
(gunzip-through-ports raw-response-port out)
(close-output-port out)))
in]
[else
raw-response-port]))
(values status headers decoded-response-port))
(define (http-conn-sendrecv! hc url-bs (define (http-conn-sendrecv! hc url-bs
#:version [version-bs #"1.1"] #:version [version-bs #"1.1"]