dyoo
svn: r4824
This commit is contained in:
parent
e476c82b14
commit
d74f7c6aae
|
@ -27,10 +27,10 @@
|
|||
(read-headers ip))
|
||||
(define-values (host-ip client-ip)
|
||||
(port-addresses ip))
|
||||
(define bindings
|
||||
(read-bindings conn method uri headers))
|
||||
(define-values (bindings raw-post-data)
|
||||
(read-bindings&post-data/raw conn method uri headers))
|
||||
(values
|
||||
(make-request method uri headers bindings
|
||||
(make-request method uri headers bindings raw-post-data
|
||||
host-ip host-port client-ip)
|
||||
(close-connection? headers major minor
|
||||
client-ip host-ip)))))
|
||||
|
@ -134,47 +134,52 @@
|
|||
|
||||
(define FILE-FORM-REGEXP (byte-regexp #"multipart/form-data; *boundary=(.*)"))
|
||||
|
||||
;; read-bindings: connection symbol url (listof header?) -> (or/c (listof binding?) string?)
|
||||
(define (read-bindings conn meth uri headers)
|
||||
;; 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)
|
||||
(match meth
|
||||
['get
|
||||
(map (match-lambda
|
||||
[(list-rest k v)
|
||||
(make-binding:form (string->bytes/utf-8 (symbol->string k))
|
||||
(string->bytes/utf-8 v))])
|
||||
(url-query uri))]
|
||||
(values (map (match-lambda
|
||||
[(list-rest k v)
|
||||
(make-binding:form (string->bytes/utf-8 (symbol->string k))
|
||||
(string->bytes/utf-8 v))])
|
||||
(url-query uri))
|
||||
#f)]
|
||||
['post
|
||||
(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)))
|
||||
=> (match-lambda
|
||||
[(list _ content-boundary)
|
||||
(map (match-lambda
|
||||
[(struct mime-part (headers contents))
|
||||
(define rhs (header-value (headers-assq* #"Content-Disposition" headers)))
|
||||
(match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
|
||||
(regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
|
||||
[(list #f #f)
|
||||
(network-error 'reading-bindings "Couldn't extract form field name for file upload")]
|
||||
[(list #f (list _ _ f0 f1))
|
||||
(make-binding:form (or f0 f1) (apply bytes-append contents))]
|
||||
[(list (list _ _ f00 f01) (list _ _ f10 f11))
|
||||
(make-binding:file (or f10 f11) (or f00 f01) (apply bytes-append contents))])])
|
||||
(read-mime-multipart content-boundary in))])]
|
||||
[else
|
||||
(match (headers-assq* #"Content-Length" headers)
|
||||
[(struct header (_ value))
|
||||
(cond
|
||||
[(string->number (bytes->string/utf-8 value))
|
||||
=> (lambda (len)
|
||||
(parse-bindings (read-bytes len in)))]
|
||||
[else
|
||||
(network-error 'read-bindings "Post request contained a non-numeric content-length")])]
|
||||
[#f
|
||||
(parse-bindings (apply bytes-append (read-to-eof in)))])])]
|
||||
(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)))
|
||||
=> (match-lambda
|
||||
[(list _ content-boundary)
|
||||
(values
|
||||
(map (match-lambda
|
||||
[(struct mime-part (headers contents))
|
||||
(define rhs (header-value (headers-assq #"Content-Disposition" headers)))
|
||||
(match (list (regexp-match #"filename=(\"([^\"]*)\"|([^ ;]*))" rhs)
|
||||
(regexp-match #"[^e]name=(\"([^\"]*)\"|([^ ;]*))" rhs))
|
||||
[(list #f #f)
|
||||
(network-error 'reading-bindings "Couldn't extract form field name for file upload")]
|
||||
[(list #f (list _ _ f0 f1))
|
||||
(make-binding:form (or f0 f1) (apply bytes-append contents))]
|
||||
[(list (list _ _ f00 f01) (list _ _ f10 f11))
|
||||
(make-binding:file (or f10 f11) (or f00 f01) (apply bytes-append contents))])])
|
||||
(read-mime-multipart content-boundary in))
|
||||
#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 (parse-bindings raw-bytes) raw-bytes)))]
|
||||
[else
|
||||
(network-error 'read-bindings "Post request contained a non-numeric content-length")])]
|
||||
[#f
|
||||
(let ([raw-bytes (apply bytes-append (read-to-eof in))])
|
||||
(parse-bindings raw-bytes))])])]
|
||||
[meth
|
||||
empty]))
|
||||
(values empty #f)]))
|
||||
|
||||
;; parse-bindings : bytes? -> (listof binding?)
|
||||
(define (parse-bindings raw)
|
||||
|
@ -195,10 +200,10 @@
|
|||
(form-urlencoded-decode
|
||||
(bytes->string/utf-8
|
||||
(subbytes raw (add1 key-end) amp-end)))))
|
||||
(loop (add1 amp-end)))
|
||||
(loop (add1 amp-end)))
|
||||
(find-amp (add1 amp-end))))
|
||||
(find= (add1 key-end)))))))
|
||||
|
||||
|
||||
;; **************************************************
|
||||
;; read-mime-multipart
|
||||
|
||||
|
|
|
@ -50,11 +50,12 @@
|
|||
[filename bytes?]
|
||||
[content bytes?])])
|
||||
|
||||
(define-struct request (method uri headers/raw bindings/raw
|
||||
(define-struct request (method uri headers/raw bindings/raw post-data/raw
|
||||
host-ip host-port client-ip))
|
||||
(provide/contract
|
||||
[struct request ([method symbol?] [uri url?]
|
||||
[headers/raw (listof header?)]
|
||||
[bindings/raw (listof binding?)]
|
||||
[post-data/raw (or/c false/c bytes?)]
|
||||
[host-ip string?] [host-port number?]
|
||||
[client-ip string?])]))
|
Loading…
Reference in New Issue
Block a user