From b1aae4a12dcf5c68bd6c98c39deb39ad4ef94c1e Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Mon, 12 Mar 2012 16:14:07 -0600 Subject: [PATCH] Outputing with chunked encoding --- .../dispatchers/dispatch-files-test.rkt | 2 +- .../tests/web-server/private/request-test.rkt | 25 +++++++++ .../web-server/private/response-test.rkt | 25 +++++---- collects/tests/web-server/util.rkt | 19 ++++--- collects/web-server/http/response.rkt | 53 ++++++++++++++++--- collects/web-server/test.rkt | 2 +- 6 files changed, 98 insertions(+), 28 deletions(-) diff --git a/collects/tests/web-server/dispatchers/dispatch-files-test.rkt b/collects/tests/web-server/dispatchers/dispatch-files-test.rkt index 58e3110408..0d17dc4537 100644 --- a/collects/tests/web-server/dispatchers/dispatch-files-test.rkt +++ b/collects/tests/web-server/dispatchers/dispatch-files-test.rkt @@ -115,7 +115,7 @@ #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n") (test-equal?* "dir, not dir-url, get" (collect (dispatch #t a-dir) (req #f #"GET" empty)) - #"HTTP/1.1 302 Moved Temporarily\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nLocation: /foo/\r\n\r\n") + #"HTTP/1.1 302 Moved Temporarily\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nLocation: /foo/\r\n\r\n") (test-exn "dir, not exists, get" exn:dispatcher? (lambda () (collect (dispatch #f a-dir) (req #t #"GET" empty)))) diff --git a/collects/tests/web-server/private/request-test.rkt b/collects/tests/web-server/private/request-test.rkt index b84c591a5c..0267c7edd4 100644 --- a/collects/tests/web-server/private/request-test.rkt +++ b/collects/tests/web-server/private/request-test.rkt @@ -92,6 +92,31 @@ (test-suite "Chunked transfer-encoding" + (test-equal? "example" + (test-read-request + #"POST http://127.0.0.1/test HTTP/1.0 +Date: Fri, 31 Dec 1999 23:59:59 GMT +Content-Type: text/plain +Content-Length: 42 + +abcdefghijklmnopqrstuvwxyz1234567890abcdef +") + (list + (list + 'request + (list + #"POST" + "http://127.0.0.1/test" + (list + (header #"Date" #"Fri, 31 Dec 1999 23:59:59 GMT") + (header #"Content-Type" #"text/plain") + (header #"Content-Length" #"42")) + '() + #"abcdefghijklmnopqrstuvwxyz1234567890abcdef" + "to" + 80 + "from")) + #t)) (test-equal? "example" (test-read-request #"POST http://127.0.0.1/test HTTP/1.1 diff --git a/collects/tests/web-server/private/response-test.rkt b/collects/tests/web-server/private/response-test.rkt index d2eb134a1c..a2e1d19a82 100644 --- a/collects/tests/web-server/private/response-test.rkt +++ b/collects/tests/web-server/private/response-test.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require rackunit +(require racket/slice + rackunit racket/port xml/xml (only-in mzlib/file @@ -35,38 +36,38 @@ (output output-response (response 404 #"404" (current-seconds) #"text/html" (list) void)) - #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n") + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\n\r\n") (test-equi? "response" (output output-response (response 404 #"404" (current-seconds) #f (list) void)) - #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nConnection: close\r\n\r\n") + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\n\r\n") (test-equi? "response (header)" (output output-response (response 404 #"404" (current-seconds) #"text/html" (list (make-header #"Header" #"Value")) void)) - #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value\r\n\r\n") + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nHeader: Value\r\n\r\n") (test-equi? "response (body)" (output output-response (response 404 #"404" (current-seconds) #"text/html" (list) void)) - #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n") + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\n\r\n") (test-equi? "response (bytes body)" (output output-response (response 404 #"404" (current-seconds) #"text/html" (list) void)) - #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n") + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\n\r\n") (test-equi? "response (both)" (output output-response (response 404 #"404" (current-seconds) #"text/html" (list (make-header #"Header" #"Value")) void)) - #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value\r\n\r\n") + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nHeader: Value\r\n\r\n") (test-equi? "response (both)" (output output-response (response 404 #"404" (current-seconds) #"text/html" (list (make-header #"Header" #"Value1") (make-header #"Header" #"Value2")) void)) - #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value1\r\nHeader: Value2\r\n\r\n")) + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nHeader: Value1\r\nHeader: Value2\r\n\r\n")) (test-suite "response/full" @@ -112,7 +113,7 @@ (test-equi? "any" (output output-response (response/xexpr `(html (head (title "Hey!")) (body "Content")))) - #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\n\r\nHey!Content")) + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\n\r\nHey!Content")) )) (define output-response/method-tests @@ -176,7 +177,7 @@ (output output-response/method (response/xexpr `(html (head (title "Hey!")) (body "Content"))) #"HEAD") - #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\n\r\n")))) + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\n\r\n")))) (define response-tests (test-suite @@ -305,3 +306,7 @@ (output output-file/boundary tmp-file #"HEAD" #"text/html" '((-10 . -5) (1000 . 1050) (50 . 49)) #"BOUNDARY")) (get-output-string os)) ""))))) + +(slice test + (require rackunit/text-ui) + (run-tests response-tests)) diff --git a/collects/tests/web-server/util.rkt b/collects/tests/web-server/util.rkt index 5ee7fb3f79..ef5e995ab0 100644 --- a/collects/tests/web-server/util.rkt +++ b/collects/tests/web-server/util.rkt @@ -53,18 +53,21 @@ (define ip (open-input-bytes ib)) (define op (open-output-bytes)) (values (make-connection 0 (make-timer never-evt +inf.0 (lambda () (void))) - ip op (make-custodian) #f) + ip op (make-custodian) #t) ip op)) (define (redact b) - (regexp-replace - #"Date: [a-zA-Z0-9:, ]+ GMT\r\n" - (regexp-replace - #"Last-Modified: [a-zA-Z0-9:, ]+ GMT\r\n" - b - #"Last-Modified: REDACTED GMT\r\n") - #"Date: REDACTED GMT\r\n")) + (regexp-replace + #"Connection: close\r\n" + (regexp-replace + #"Date: [a-zA-Z0-9:, ]+ GMT\r\n" + (regexp-replace + #"Last-Modified: [a-zA-Z0-9:, ]+ GMT\r\n" + b + #"Last-Modified: REDACTED GMT\r\n") + #"Date: REDACTED GMT\r\n") + #"")) (define-syntax (make-module-eval m-expr) (syntax-case m-expr (module) diff --git a/collects/web-server/http/response.rkt b/collects/web-server/http/response.rkt index ec05777251..ffdd047132 100644 --- a/collects/web-server/http/response.rkt +++ b/collects/web-server/http/response.rkt @@ -22,12 +22,22 @@ (output-response/method conn resp #"GET")) (define (output-response/method conn resp meth) - ; XXX Use chunked encoding for non-terminated responses - (unless (terminated-response? resp) - (set-connection-close?! conn #t)) - (output-response-head conn resp) - (unless (bytes-ci=? meth #"HEAD") - (output-response-body conn resp))) + (cond + [(or + ;; If it is terminated, just continue + (terminated-response? resp) + ;; If it is HTTP/1.0, ditto + (connection-close? conn) + ;; Or, if it is a HEAD request + (bytes-ci=? meth #"HEAD")) + (output-response-head conn resp) + (unless (bytes-ci=? meth #"HEAD") + (output-response-body conn resp))] + ;; Otherwise, use chunked encoding + [else + (output-response-head conn resp + (list (header #"Transfer-Encoding" #"chunked"))) + (output-response-body/chunked conn resp)])) ;; Write the headers portion of a response to an output port. ;; NOTE: According to RFC 2145 the server should write HTTP/1.1 @@ -40,12 +50,12 @@ (append (maybe-header h k v) ...)) -(define (output-response-head conn bresp) +(define (output-response-head conn bresp [more-hs empty]) (fprintf (connection-o-port conn) "HTTP/1.1 ~a ~a\r\n" (response-code bresp) (response-message bresp)) - (define hs (response-headers bresp)) + (define hs (append (response-headers bresp) more-hs)) (define seen? (make-hash)) (for ([h (in-list hs)]) (hash-set! seen? (header-field h) #t)) @@ -99,6 +109,33 @@ ((response-output bresp) o-port) (flush-output o-port)) +(define (output-response-body/chunked conn bresp) + (define-values (from-servlet to-chunker) (make-pipe)) + (define to-client (connection-o-port conn)) + (define to-chunker-t + (thread (λ () + ((response-output bresp) to-chunker) + (close-output-port to-chunker)))) + (define buffer (make-bytes 1024)) + (define total-size + (let loop ([total-size 0]) + (define bytes-read-or-eof + (read-bytes-avail! buffer from-servlet)) + (if (eof-object? bytes-read-or-eof) + total-size + (begin + (fprintf to-client "~a\r\n" (number->string bytes-read-or-eof 16)) + (write-bytes buffer to-client 0 bytes-read-or-eof) + (fprintf to-client "\r\n") + (loop (+ total-size bytes-read-or-eof)))))) + (thread-wait to-chunker-t) + (fprintf to-client "0\r\n") + (print-headers + to-client + (list (header #"Content-Length" + (string->bytes/utf-8 (number->string total-size))))) + (flush-output to-client)) + ; seconds->gmt-string : Nat -> String ; format is rfc1123 compliant according to rfc2068 (http/1.1) (define (seconds->gmt-string s) diff --git a/collects/web-server/test.rkt b/collects/web-server/test.rkt index 64489e9775..cfcf6c9375 100644 --- a/collects/web-server/test.rkt +++ b/collects/web-server/test.rkt @@ -72,7 +72,7 @@ (define ip (open-input-bytes ib)) (define op (open-output-bytes)) (values (make-connection 0 (make-timer never-evt +inf.0 (lambda () (void))) - ip op (current-custodian) #f) + ip op (current-custodian) #t) ip op))