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

Fixing PR14098

Browse Source
This commit is contained in:
Jay McCarthy 2013-10-15 09:32:02 -06:00
parent 6a6b46031b
commit f8d3d6c81b
2 changed files with 29 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -42,7 +42,7 @@
(define-values (status headers content-port) (define-values (status headers content-port)
e) e)
(thread-wait lt) (thread-wait lt)
(check-equal? req ereq) (check-equal? (regexp-replace* (number->string the-port) req "REDACTED") ereq)
(check-equal? status estatus) (check-equal? status estatus)
(check-equal? headers eheaders) (check-equal? headers eheaders)
(check-equal? (port->bytes content-port) econtent))) (check-equal? (port->bytes content-port) econtent)))
@ -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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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\nAccept-Encoding: gzip\r\n\r\n" #"GET / HTTP/1.1\r\nHost: localhost:REDACTED\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"]))

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

@ -30,10 +30,10 @@
;; Core ;; Core
(struct http-conn (host to from abandon-p) #:mutable) (struct http-conn (host port port-usual? to from abandon-p) #:mutable)
(define (make-http-conn) (define (make-http-conn)
(http-conn #f #f #f #f)) (http-conn #f #f #f #f #f #f))
(define (http-conn-live? hc) (define (http-conn-live? hc)
(and (http-conn-to hc) (and (http-conn-to hc)
@ -46,6 +46,7 @@
(define-values (from to) (define-values (from to)
(cond [ssl? (cond [ssl?
(set-http-conn-port-usual?! hc (= 443 port))
(cond (cond
[(or ssl-available? (not win32-ssl-available?)) [(or ssl-available? (not win32-ssl-available?))
(set-http-conn-abandon-p! hc ssl-abandon-port) (set-http-conn-abandon-p! hc ssl-abandon-port)
@ -55,14 +56,16 @@
(win32-ssl-connect host port ssl-version)])] (win32-ssl-connect host port ssl-version)])]
[else [else
(set-http-conn-abandon-p! hc plain-tcp-abandon-port) (set-http-conn-abandon-p! hc plain-tcp-abandon-port)
(set-http-conn-port-usual?! hc (= 80 port))
(plain-tcp-connect host port)])) (plain-tcp-connect host port)]))
(set-http-conn-host! hc host) (set-http-conn-host! hc host)
(set-http-conn-port! hc port)
(set-http-conn-to! hc to) (set-http-conn-to! hc to)
(set-http-conn-from! hc from)) (set-http-conn-from! hc from))
(define (http-conn-close! hc) (define (http-conn-close! hc)
(match-define (http-conn host to from abandon) hc) (match-define (http-conn host port port-usual? to from abandon) hc)
(set-http-conn-host! hc #f) (set-http-conn-host! hc #f)
(when to (when to
(abandon to) (abandon to)
@ -73,7 +76,7 @@
(set-http-conn-abandon-p! hc #f)) (set-http-conn-abandon-p! hc #f))
(define (http-conn-abandon! hc) (define (http-conn-abandon! hc)
(match-define (http-conn host to from abandon) hc) (match-define (http-conn host port port-usual? to from abandon) hc)
(when to (when to
(abandon to) (abandon to)
(set-http-conn-to! hc #f))) (set-http-conn-to! hc #f)))
@ -84,10 +87,13 @@
#:headers [headers-bs empty] #:headers [headers-bs empty]
;; 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 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)
(fprintf to "Host: ~a\r\n" host)) (fprintf to "Host: ~a\r\n"
(if port-usual?
host
(format "~a:~a" host port))))
(unless (regexp-member #rx"^(?i:Accept-Encoding:) +.+$" headers-bs) (unless (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