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

Preparing for implementing chunked encoding

Browse Source
This commit is contained in:
Jay McCarthy 2012-03-12 11:24:52 -06:00
parent 8b5a11a39d
commit 04fdfbb012
2 changed files with 83 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,6 @@
#lang racket #lang racket
(require rackunit (require rackunit
racket/slice
web-server/private/connection-manager web-server/private/connection-manager
web-server/private/timer web-server/private/timer
web-server/http/request web-server/http/request
@ -78,3 +79,7 @@
(test-equal? "simple test 3" (test-equal? "simple test 3"
(binding:form-value (bindings-assq #"hello" (force (get-bindings "hello=world")))) (binding:form-value (bindings-assq #"hello" (force (get-bindings "hello=world"))))
#"world"))))) #"world")))))
(slice test
(require rackunit/text-ui)
(run-tests request-tests))

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

@ -1,5 +1,9 @@
#lang racket #lang racket/base
(require net/url (require racket/contract
racket/match
racket/list
racket/promise
net/url
net/uri-codec net/uri-codec
unstable/contract unstable/contract
web-server/private/util web-server/private/util
@ -170,37 +174,48 @@
(cond (cond
[(bytes-ci=? #"GET" meth) [(bytes-ci=? #"GET" meth)
(values (delay (values (delay
(filter (lambda (x) x) (filter-map
(map (match-lambda (match-lambda
[(list-rest k v) [(list-rest k v)
(if (and (symbol? k) (string? v)) (if (and (symbol? k) (string? v))
(make-binding:form (string->bytes/utf-8 (symbol->string k)) (make-binding:form (string->bytes/utf-8 (symbol->string k))
(string->bytes/utf-8 v)) (string->bytes/utf-8 v))
#f)]) #f)])
(url-query uri)))) (url-query uri)))
#f)] #f)]
[(bytes-ci=? #"POST" meth) [(bytes-ci=? #"POST" meth)
(local (define content-type (headers-assq* #"Content-Type" headers))
[(define content-type (headers-assq* #"Content-Type" headers)) (define in (connection-i-port conn))
(define in (connection-i-port conn))]
(cond (cond
[(and content-type (regexp-match FILE-FORM-REGEXP (header-value content-type))) [(and content-type
(regexp-match FILE-FORM-REGEXP (header-value content-type)))
=> (match-lambda => (match-lambda
[(list _ content-boundary) [(list _ content-boundary)
; XXX This can't be delay because it reads from the port, which would otherwise be closed. ;; XXX This can't be delay because it reads from the
; I think this is reasonable because the Content-Type said it would have this format ;; port, which would otherwise be closed. I think
;; this is reasonable because the Content-Type
;; said it would have this format
(define bs (define bs
(map (match-lambda (map (match-lambda
[(struct mime-part (headers contents)) [(struct mime-part (headers contents))
(define rhs (header-value (headers-assq* #"Content-Disposition" headers))) (define rhs
(match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs) (header-value
(headers-assq* #"Content-Disposition" headers)))
(match*
((regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
(regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs)) (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
[(list #f #f) [(#f #f)
(network-error 'reading-bindings "Couldn't extract form field name for file upload")] (network-error
[(list #f (list _ _ f0 f1)) 'reading-bindings
(make-binding:form (or f0 f1) (apply bytes-append contents))] "Couldn't extract form field name for file upload")]
[(list (list _ _ f00 f01) (list _ _ f10 f11)) [(#f (list _ _ f0 f1))
(make-binding:file (or f10 f11) (or f00 f01) headers (apply bytes-append contents))])]) (make-binding:form (or f0 f1)
(apply bytes-append contents))]
[((list _ _ f00 f01) (list _ _ f10 f11))
(make-binding:file (or f10 f11)
(or f00 f01)
headers
(apply bytes-append contents))])])
(read-mime-multipart content-boundary in))) (read-mime-multipart content-boundary in)))
(values (values
(delay bs) (delay bs)
@ -214,13 +229,14 @@
(let ([raw-bytes (read-bytes len in)]) (let ([raw-bytes (read-bytes len in)])
(values (delay (parse-bindings raw-bytes)) raw-bytes)))] (values (delay (parse-bindings raw-bytes)) raw-bytes)))]
[else [else
(network-error 'read-bindings "Post request contained a non-numeric content-length")])] (network-error
'read-bindings
"Post request contained a non-numeric content-length")])]
[#f [#f
(values (delay empty) #f)])]))] (values (delay empty) #f)])])]
[meth [meth
(local (define content-type (headers-assq* #"Content-Type" headers))
[(define content-type (headers-assq* #"Content-Type" headers)) (define in (connection-i-port conn))
(define in (connection-i-port conn))]
(match (headers-assq* #"Content-Length" headers) (match (headers-assq* #"Content-Length" headers)
[(struct header (_ value)) [(struct header (_ value))
(cond [(string->number (bytes->string/utf-8 value)) (cond [(string->number (bytes->string/utf-8 value))
@ -228,9 +244,11 @@
(let ([raw-bytes (read-bytes len in)]) (let ([raw-bytes (read-bytes len in)])
(values (delay empty) raw-bytes)))] (values (delay empty) raw-bytes)))]
[else [else
(network-error 'read-bindings "Non-GET/POST request contained a non-numeric content-length")])] (network-error
'read-bindings
"Non-GET/POST request contained a non-numeric content-length")])]
[#f [#f
(values (delay empty) #f)]))])) (values (delay empty) #f)])]))
;; parse-bindings : bytes? -> (listof binding?) ;; parse-bindings : bytes? -> (listof binding?)
(define (parse-bindings raw) (define (parse-bindings raw)