From 1e80084c97532793d99df505fdd9b960a7d35953 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Mon, 12 Mar 2012 12:37:20 -0600 Subject: [PATCH] Reading chunked requests --- .../tests/web-server/private/request-test.rkt | 75 ++++++++++++++--- collects/web-server/http/request-structs.rkt | 17 ++-- collects/web-server/http/request.rkt | 81 ++++++++++++++----- 3 files changed, 141 insertions(+), 32 deletions(-) diff --git a/collects/tests/web-server/private/request-test.rkt b/collects/tests/web-server/private/request-test.rkt index 50ba9d6c5a..b84c591a5c 100644 --- a/collects/tests/web-server/private/request-test.rkt +++ b/collects/tests/web-server/private/request-test.rkt @@ -1,6 +1,7 @@ #lang racket (require rackunit racket/slice + net/url web-server/private/connection-manager web-server/private/timer web-server/http/request @@ -26,19 +27,38 @@ (define (get-bindings post-data) (define-values (conn headers) (make-mock-connection&headers post-data)) - (call-with-values (lambda () (read-bindings&post-data/raw conn #"POST" #f headers)) - (lambda (f s) f))) + (call-with-values + (lambda () + (read-bindings&post-data/raw (connection-i-port conn) #"POST" #f headers)) + (lambda (f s) f))) (define (get-post-data/raw post-data) (define-values (conn headers) (make-mock-connection&headers post-data)) - (call-with-values (lambda () (read-bindings&post-data/raw conn #"POST" #f headers)) - (lambda (f s) s))) + (call-with-values + (lambda () + (read-bindings&post-data/raw (connection-i-port conn) #"POST" #f headers)) + (lambda (f s) s))) +(define (test-read-request b) + (define ip (open-input-bytes b)) + (define op (open-output-bytes)) + (define c + (make-connection 0 (make-timer ip +inf.0 (lambda () (void))) + ip op (make-custodian) #f)) + (define-values (req flag) + (read-request c 80 (λ (_) (values "to" "from")))) + (list (list 'request + (map (λ (f) (f req)) + (list request-method (compose url->string request-uri) + request-headers/raw + request-bindings/raw request-post-data/raw + request-host-ip request-host-port request-client-ip))) + flag)) (define request-tests (test-suite "HTTP Requests" - + (test-suite "Headers" (test-equal? "Simple" (header-value (headers-assq #"key" (list (make-header #"key" #"val")))) #"val") @@ -47,14 +67,14 @@ (test-equal? "Case" (header-value (headers-assq* #"Key" (list (make-header #"key" #"val")))) #"val") (test-equal? "Case (not first)" (header-value (headers-assq* #"Key" (list (make-header #"key1" #"val") (make-header #"key" #"val")))) #"val")) - + (test-suite "Bindings" (test-equal? "Simple" (binding:form-value (bindings-assq #"key" (list (make-binding:form #"key" #"val")))) #"val") (test-equal? "Simple (File)" (binding:file-content (bindings-assq #"key" (list (make-binding:file #"key" #"name" empty #"val")))) #"val") (test-false "Not present" (bindings-assq #"key" (list)))) - - ; XXX This needs to be really extensive, see what Apache has + + ; XXX This needs to be really extensive, see what Apache has (test-suite "Parsing" (test-suite @@ -69,7 +89,44 @@ 8081 (lambda _ (values "s1" "s2"))) (void)))) - + + (test-suite + "Chunked transfer-encoding" + (test-equal? "example" + (test-read-request + #"POST http://127.0.0.1/test HTTP/1.1 +Date: Fri, 31 Dec 1999 23:59:59 GMT +Content-Type: text/plain +Transfer-Encoding: chunked + +1a; ignore-stuff-here +abcdefghijklmnopqrstuvwxyz +10 +1234567890abcdef +0 +some-footer: some-value +another-footer: another-value +") + (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 #"Transfer-Encoding" #"chunked") + (header #"Content-Length" #"42") + (header #"some-footer" #"some-value") + (header #"another-footer" #"another-value")) + '() + #"abcdefghijklmnopqrstuvwxyz1234567890abcdef" + "to" + 80 + "from")) + #f))) + (test-suite "POST Bindings" (test-equal? "simple test 1" diff --git a/collects/web-server/http/request-structs.rkt b/collects/web-server/http/request-structs.rkt index 46b5743055..6adf9a2db5 100644 --- a/collects/web-server/http/request-structs.rkt +++ b/collects/web-server/http/request-structs.rkt @@ -6,7 +6,7 @@ net/url web-server/private/util) -(define-serializable-struct header (field value)) +(define-serializable-struct header (field value) #:transparent) (define (headers-assq* f hs) (match hs [(list) @@ -29,9 +29,12 @@ [struct header ([field bytes?] [value bytes?])]) -(define-serializable-struct binding (id)) -(define-serializable-struct (binding:form binding) (value)) -(define-serializable-struct (binding:file binding) (filename headers content)) +(define-serializable-struct binding + (id) #:transparent) +(define-serializable-struct (binding:form binding) + (value) #:transparent) +(define-serializable-struct (binding:file binding) + (filename headers content) #:transparent) (define (bindings-assq ti bs) (match bs [(list) @@ -50,7 +53,11 @@ [headers (listof header?)] [content bytes?])]) -(define-serializable-struct request (method uri headers/raw bindings/raw-promise post-data/raw host-ip host-port client-ip)) +(define-serializable-struct + request + (method uri headers/raw bindings/raw-promise post-data/raw + host-ip host-port client-ip) + #:transparent) (define (request-bindings/raw r) (force (request-bindings/raw-promise r))) diff --git a/collects/web-server/http/request.rkt b/collects/web-server/http/request.rkt index 3687a3e67a..ceba2931a1 100644 --- a/collects/web-server/http/request.rkt +++ b/collects/web-server/http/request.rkt @@ -36,19 +36,22 @@ (connection-i-port conn)) (define-values (method uri major minor) (read-request-line ip)) - (define headers + (define initial-headers (read-headers ip)) - (define _ - (match (headers-assq* #"Content-Length" headers) - [(struct header (f v)) - ; Give it one second per byte (with 5 second minimum... a bit arbitrary) - (adjust-connection-timeout! conn (max 5 (string->number (bytes->string/utf-8 v))))] - [#f - (void)])) + (match (headers-assq* #"Content-Length" initial-headers) + [(struct header (f v)) + ;; Give it one second per byte (with 5 second minimum... a bit + ;; arbitrary) + (adjust-connection-timeout! + conn (max 5 (string->number (bytes->string/utf-8 v))))] + [#f + (void)]) + (define-values (data-ip headers) + (complete-request ip initial-headers)) (define-values (host-ip client-ip) (port-addresses ip)) (define-values (bindings/raw-promise raw-post-data) - (read-bindings&post-data/raw conn method uri headers)) + (read-bindings&post-data/raw data-ip method uri headers)) (values (make-request method uri headers bindings/raw-promise raw-post-data host-ip host-port client-ip) @@ -56,6 +59,46 @@ (close-connection? headers major minor client-ip host-ip)))) +;; If the headers says it uses chunked transfer encoding, then decode +;; it +(require racket/stxparam + (for-syntax racket/base)) +(define-syntax-parameter break + (λ (stx) + (raise-syntax-error 'break "Used outside forever" stx))) +(define-syntax-rule (forever e ...) + (let/ec this-break + (let loop () + (syntax-parameterize ([break (make-rename-transformer #'this-break)]) + (begin e ...)) + (loop)))) +(define (hex-string->number s) + (string->number s 16)) +(define (complete-request real-ip initial-headers) + (match (headers-assq* #"Transfer-Encoding" initial-headers) + [(struct header (f #"chunked")) + (define-values (decoded-ip decode-op) (make-pipe)) + (define total-size 0) + (forever + (define size-line (read-line real-ip 'any)) + (match-define (cons size-in-hex _) (regexp-split #rx";" size-line)) + (define size-in-bytes (hex-string->number size-in-hex)) + (set! total-size (+ total-size size-in-bytes)) + (when (zero? size-in-bytes) + (break)) + (define data-bytes (read-bytes size-in-bytes real-ip)) + (write-bytes data-bytes decode-op) + ;; Ignore CRLF + (read-line real-ip 'any)) + (define more-headers + (list* (header #"Content-Length" + (string->bytes/utf-8 (number->string total-size))) + (read-headers real-ip))) + (close-output-port decode-op) + (values decoded-ip (append initial-headers more-headers))] + [_ + (values real-ip initial-headers)])) + (define (make-ext:read-request #:connection-close? [connection-close? #f]) (define read-request @@ -74,7 +117,8 @@ ;; close-connection? ; close-connection? : (listof (cons symbol bytes)) number number string string -> boolean -; determine if this connection should be closed after serving the response +;; determine if this connection should be closed after serving the +;; response (define close-connection? (let ([rx (byte-regexp #"[cC][lL][oO][sS][eE]")]) (lambda (headers major minor client-ip host-ip) @@ -88,10 +132,13 @@ #f]) (msie-from-local-machine? headers client-ip host-ip))))) -; msie-from-local-machine? : table str str -> bool -; to work around a bug in MSIE for documents < 265 bytes when connecting from the local -; machine. The server could pad the response as MSIIS does, but closing the connection works, too. -; We do not check for version numbers since IE 6 under windows is 5.2 under macosX +;; msie-from-local-machine? : table str str -> bool + +;; to work around a bug in MSIE for documents < 265 bytes when +;; connecting from the local machine. The server could pad the +;; response as MSIIS does, but closing the connection works, too. We +;; do not check for version numbers since IE 6 under windows is 5.2 +;; under macosX (define msie-from-local-machine? (let ([rx (byte-regexp #"MSIE")]) (lambda (headers client-ip host-ip) @@ -169,8 +216,8 @@ (define FILE-FORM-REGEXP (byte-regexp #"multipart/form-data; *boundary=(.*)")) -;; read-bindings&post-data/raw: connection symbol url (listof header?) -> (values (or/c (listof binding?) string?) (or/c bytes? false/c?)) -(define (read-bindings&post-data/raw conn meth uri headers) +;; read-bindings&post-data/raw: input-port symbol url (listof header?) -> (values (or/c (listof binding?) string?) (or/c bytes? false/c?)) +(define (read-bindings&post-data/raw in meth uri headers) (cond [(bytes-ci=? #"GET" meth) (values (delay @@ -185,7 +232,6 @@ #f)] [(bytes-ci=? #"POST" meth) (define content-type (headers-assq* #"Content-Type" headers)) - (define in (connection-i-port conn)) (cond [(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type))) @@ -236,7 +282,6 @@ (values (delay empty) #f)])])] [meth (define content-type (headers-assq* #"Content-Type" headers)) - (define in (connection-i-port conn)) (match (headers-assq* #"Content-Length" headers) [(struct header (_ value)) (cond [(string->number (bytes->string/utf-8 value))