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

138
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,67 +174,81 @@
(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
[(and content-type (regexp-match FILE-FORM-REGEXP (header-value 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
(define bs ;; this is reasonable because the Content-Type
(map (match-lambda ;; said it would have this format
[(struct mime-part (headers contents)) (define bs
(define rhs (header-value (headers-assq* #"Content-Disposition" headers))) (map (match-lambda
(match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs) [(struct mime-part (headers contents))
(regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs)) (define rhs
[(list #f #f) (header-value
(network-error 'reading-bindings "Couldn't extract form field name for file upload")] (headers-assq* #"Content-Disposition" headers)))
[(list #f (list _ _ f0 f1)) (match*
(make-binding:form (or f0 f1) (apply bytes-append contents))] ((regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
[(list (list _ _ f00 f01) (list _ _ f10 f11)) (regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
(make-binding:file (or f10 f11) (or f00 f01) headers (apply bytes-append contents))])]) [(#f #f)
(read-mime-multipart content-boundary in))) (network-error
(values 'reading-bindings
(delay bs) "Couldn't extract form field name for file upload")]
#f)])] [(#f (list _ _ f0 f1))
[else (make-binding:form (or f0 f1)
(match (headers-assq* #"Content-Length" headers) (apply bytes-append contents))]
[(struct header (_ value)) [((list _ _ f00 f01) (list _ _ f10 f11))
(cond (make-binding:file (or f10 f11)
[(string->number (bytes->string/utf-8 value)) (or f00 f01)
=> (lambda (len) headers
(let ([raw-bytes (read-bytes len in)]) (apply bytes-append contents))])])
(values (delay (parse-bindings raw-bytes)) raw-bytes)))] (read-mime-multipart content-boundary in)))
[else (values
(network-error 'read-bindings "Post request contained a non-numeric content-length")])] (delay bs)
[#f #f)])]
(values (delay empty) #f)])]))] [else
(match (headers-assq* #"Content-Length" headers)
[(struct header (_ value))
(cond
[(string->number (bytes->string/utf-8 value))
=> (lambda (len)
(let ([raw-bytes (read-bytes len in)])
(values (delay (parse-bindings raw-bytes)) raw-bytes)))]
[else
(network-error
'read-bindings
"Post request contained a non-numeric content-length")])]
[#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)) => (lambda (len)
=> (lambda (len) (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
(network-error 'read-bindings "Non-GET/POST request contained a non-numeric content-length")])] 'read-bindings
[#f "Non-GET/POST request contained a non-numeric content-length")])]
(values (delay empty) #f)]))])) [#f
(values (delay empty) #f)])]))
;; parse-bindings : bytes? -> (listof binding?) ;; parse-bindings : bytes? -> (listof binding?)
(define (parse-bindings raw) (define (parse-bindings raw)