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

dyoo

Browse Source 
svn: r4824
This commit is contained in:
Jay McCarthy 2006-11-11 05:56:22 +00:00
parent e476c82b14
commit d74f7c6aae
2 changed files with 49 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
collects/web-server/private/request.ss
View File

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

3
collects/web-server/request-structs.ss
View File

@ -50,11 +50,12 @@
[filename bytes?] [filename bytes?]
[content 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)) host-ip host-port client-ip))
(provide/contract (provide/contract
[struct request ([method symbol?] [uri url?] [struct request ([method symbol?] [uri url?]
[headers/raw (listof header?)] [headers/raw (listof header?)]
[bindings/raw (listof binding?)] [bindings/raw (listof binding?)]
[post-data/raw (or/c false/c bytes?)]
[host-ip string?] [host-port number?] [host-ip string?] [host-port number?]
[client-ip string?])])) [client-ip string?])]))