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

Reading chunked requests

Browse Source
This commit is contained in:
Jay McCarthy 2012-03-12 12:37:20 -06:00
parent 04fdfbb012
commit 1e80084c97
3 changed files with 141 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
collects/tests/web-server/private/request-test.rkt
View File

@ -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"

17
collects/web-server/http/request-structs.rkt
View File

@ -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)))

81
collects/web-server/http/request.rkt
View File

@ -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))