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

Fix PR14142 by allowing 'tolerant' line endings acording to Appendix B of the HTTP spec

Browse Source 
original commit: 3d15fb3c1d
This commit is contained in:
Jay McCarthy 2013-11-05 11:02:57 -07:00
parent d90a7c4e47
commit 444cabd8c8
1 changed files with 79 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,6 +3,7 @@
(require rackunit (require rackunit
racket/tcp racket/tcp
racket/port racket/port
(for-syntax racket/base)
racket/list racket/list
(prefix-in hc: net/http-client) (prefix-in hc: net/http-client)
(prefix-in u: net/url)) (prefix-in u: net/url))
@ -18,52 +19,74 @@
(loop)))) (loop))))
(get-output-bytes ob)) (get-output-bytes ob))
(define-syntax-rule (tests [t ...] ...) (define-syntax (tests stx)
(begin (test t ...) ...)) (syntax-case stx ()
[(_ t ...)
(with-syntax
([(t.test ...)
(for/list ([t (in-list (syntax->list #'(t ...)))])
(quasisyntax/loc t
(test . #,t)))])
(syntax/loc stx
(begin t.test ...)))]))
(define-syntax-rule (test-e the-port e raw ereq estatus eheaders econtent) (define-syntax (test-e stx)
(let () (syntax-case stx ()
(define l (tcp-listen 0 40 #t "127.0.0.1")) [(_ the-port e raw ereq estatus eheaders econtent)
(define-values (_1 the-port _2 _3) (quasisyntax/loc stx
(tcp-addresses l #t)) (let ()
(define req #f) (define l (tcp-listen 0 40 #t "127.0.0.1"))
(define lt (define-values (_1 the-port _2 _3)
(thread (tcp-addresses l #t))
(λ () (define req #f)
(define-values (in out) (tcp-accept l)) (define lt
(tcp-close l) (thread
(display raw out) (λ ()
(flush-output out) (define-values (in out) (tcp-accept l))
(tcp-abandon-port out) (tcp-close l)
(close-output-port out) (display raw out)
(set! req (port->bytes* in)) (flush-output out)
(tcp-abandon-port in) (tcp-abandon-port out)
(close-input-port in)))) (close-output-port out)
(define-values (status headers content-port) (set! req (port->bytes* in))
e) (tcp-abandon-port in)
(thread-wait lt) (close-input-port in))))
(check-equal? (regexp-replace* (number->string the-port) req "REDACTED") ereq) (define-values (status headers content-port)
(check-equal? status estatus) e)
(check-equal? headers eheaders) (thread-wait lt)
(check-equal? (port->bytes content-port) econtent))) #,(syntax/loc stx
(check-equal? (regexp-replace* (number->string the-port) req "REDACTED")
ereq))
#,(syntax/loc stx
(check-equal? status estatus))
#,(syntax/loc stx
(check-equal? headers eheaders))
#,(syntax/loc stx
(check-equal? (port->bytes content-port) econtent))))]))
(define-syntax-rule (test raw ereq estatus eheaders econtent) (define-syntax (test stx)
(begin (syntax-case stx ()
(test-e the-port [(_ raw ereq estatus eheaders econtent)
(hc:http-sendrecv "localhost" "/" (quasisyntax/loc stx
#:ssl? #f (begin
#:port the-port #,(syntax/loc stx
#:method "GET" (test-e the-port
#:headers empty (hc:http-sendrecv "localhost" "/"
#:data #f) #:ssl? #f
raw ereq estatus eheaders econtent) #:port the-port
(test-e the-port #:method "GET"
(u:http-sendrecv/url #:headers empty
(u:make-url "http" #f "localhost" the-port #t (list (u:path/param "" empty)) empty #f) #:data #f)
#:method "GET" raw ereq estatus eheaders econtent))
#:headers empty #,(syntax/loc stx
#:data #f) (test-e the-port
raw ereq estatus eheaders econtent))) (u:http-sendrecv/url
(u:make-url "http" #f "localhost" the-port #t
(list (u:path/param "" empty)) empty #f)
#:method "GET"
#:headers empty
#:data #f)
raw ereq estatus eheaders econtent))))]))
(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"
@ -78,12 +101,24 @@
'(#"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\nContent-Type: text/plain\n\nThis is the data in the first chunk and this is the second one"
#"GET / HTTP/1.1\r\nHost: localhost:REDACTED\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain")
#"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:REDACTED\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\n\r\nThis is the data in the first chunk and this is the second one"
#"GET / HTTP/1.1\r\nHost: localhost:REDACTED\r\nAccept-Encoding: gzip\r\n\r\n"
#"HTTP/1.0 200 OK"
'(#"Content-Type: text/plain")
#"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:REDACTED\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"
@ -162,6 +197,3 @@
#"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")
#"<HTML>\n\t\t\t\t\t <HEAD>\n\t\t\t\t\t <TITLE>ABCNANOTECH Co., LTD.</TITLE>\n\t\t\t\t\t </HEAD>\n\t\t\t\t\t <FRAMESET ROWS=\"100%,*\" border=0>\n\t\t\t\t\t <FRAME src=http://nanotech.co.kr></FRAMESET>\n\t\t\t\t\t </HTML>"])) #"<HTML>\n\t\t\t\t\t <HEAD>\n\t\t\t\t\t <TITLE>ABCNANOTECH Co., LTD.</TITLE>\n\t\t\t\t\t </HEAD>\n\t\t\t\t\t <FRAMESET ROWS=\"100%,*\" border=0>\n\t\t\t\t\t <FRAME src=http://nanotech.co.kr></FRAMESET>\n\t\t\t\t\t </HTML>"]))