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

Exposing MIME headers to user

Browse Source 
svn: r12431
This commit is contained in:
Jay McCarthy 2008-11-13 21:25:13 +00:00
parent 4dd202b960
commit f64d8a5280
7 changed files with 46 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/web-server/private/request-test.ss
View File

@ -1,4 +1,4 @@
#lang scheme/base
#lang scheme
(require (planet "util.ss" ("schematics" "schemeunit.plt" 2))
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
web-server/private/connection-manager
@ -49,7 +49,7 @@
(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" #"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

4
collects/tests/web-server/servlet/bindings-test.ss
View File

@ -1,4 +1,4 @@
#lang scheme/base
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
mzlib/list
net/url
@ -41,7 +41,7 @@
"File"
(check-equal? (request-bindings
(make-request 'get (string->url "http://test.com/foo")
empty (list (make-binding:file #"key" #"file" #"val")) #f
empty (list (make-binding:file #"key" #"file" empty #"val")) #f
"host" 80 "client"))
'((key . #"val")))))

34
collects/web-server/default-web-root/htdocs/servlets/examples/fupload.ss Normal file
View File

@ -0,0 +1,34 @@
#lang scheme
(require web-server/servlet)
(provide (all-defined-out))
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(define req
(send/suspend
(lambda (k-url)
`(html (body (form ([action ,k-url]
[method "post"]
[enctype "multipart/form-data"])
(input ([type "file"]
[name "somename"]))
(input ([type "submit"]))))))))
(define (header->xexpr h)
(match h
[(struct header (field value))
`(li (ul (li "Field: " ,(bytes->string/utf-8 field))
(li "Value: " ,(bytes->string/utf-8 value))))]))
(define (binding->xexpr b)
(match b
[(struct binding:form (field value))
`(li (ul (li "Field: " ,(bytes->string/utf-8 field))
(li "Value: " ,(bytes->string/utf-8 value))))]
[(struct binding:file (field filename headers content))
`(li (ul (li "Field: " ,(bytes->string/utf-8 field))
(li "Name: " ,(bytes->string/utf-8 filename))
(li "Headers: " (ul ,@(map header->xexpr headers)))
(li "Contents: " (pre ,(bytes->string/utf-8 content)))))]))
`(html (body ([bgcolor "white"])
(p "Uploaded:"
(ul ,@(map binding->xexpr (request-bindings/raw req)))))))

2
collects/web-server/http/bindings.ss
View File

@ -16,7 +16,7 @@
[(struct binding:form (id value))
(cons (lowercase-symbol! (bytes->string/utf-8 id))
(bytes->string/utf-8 value))]
[(struct binding:file (id fname value))
[(struct binding:file (id fname headers value))
(cons (lowercase-symbol! (bytes->string/utf-8 id))
value)])
(request-bindings/raw request)))

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

@ -33,7 +33,7 @@
(define-serializable-struct binding (id))
(define-serializable-struct (binding:form binding) (value))
(define-serializable-struct (binding:file binding) (filename content))
(define-serializable-struct (binding:file binding) (filename headers content))
(define (bindings-assq ti bs)
(match bs
[(list)
@ -49,6 +49,7 @@
[value bytes?])]
[struct (binding:file binding) ([id bytes?]
[filename bytes?]
[headers (listof header?)]
[content bytes?])])
(define-serializable-struct request (method uri headers/raw bindings/raw post-data/raw

2
collects/web-server/http/request.ss
View File

@ -173,7 +173,7 @@
[(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))])])
(make-binding:file (or f10 f11) (or f00 f01) headers (apply bytes-append contents))])])
(read-mime-multipart content-boundary in))
#f)])]
[else

5
collects/web-server/scribblings/http.scrbl
View File

@ -40,9 +40,12 @@ The @web-server implements many HTTP RFCs that are provided by this module.
}
@defstruct[(binding:file binding) ([filename bytes?]
[headers (listof header?)]
[content bytes?])]{
Represents the uploading of the file @scheme[filename] with the id @scheme[id]
and the content @scheme[content].
and the content @scheme[content], where @scheme[headers] are the additional headers from
the MIME envelope the file was in. (For example, the @scheme[#"Content-Type"] header may
be included by some browsers.)
}
@defproc[(bindings-assq [id bytes?]