Rearranging api
svn: r6636
This commit is contained in:
Jay McCarthy
parent
bd5819639e
commit
fad9c2210f
|
|
@ -128,8 +128,22 @@ related to HTTP request data structures.
|
|||
@file{servlet/bindings.ss} provides a number of helper functions
|
||||
for accessing request bindings.
|
||||
|
||||
@; XXX Move in request-bindings
|
||||
@; XXX Rename extract-binding
|
||||
@defproc[(request-bindings [req request?])
|
||||
(listof (or/c (cons/c symbol? string?)
|
||||
(cons/c symbol? bytes?)))]{
|
||||
Translates the @scheme[request-bindings/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s, except in the case
|
||||
of @scheme[binding:file] bindings, which are left as is. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
@defproc[(request-headers [req request?])
|
||||
(listof (cons/c symbol? string?))]{
|
||||
Translates the @scheme[request-headers/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
@defproc[(extract-binding/single [id symbol?]
|
||||
[binds (listof (cons/c symbol? string?))])
|
||||
string?]{
|
||||
|
|
@ -150,6 +164,14 @@ for accessing request bindings.
|
|||
Otherwise, @scheme[#f].
|
||||
}
|
||||
|
||||
These functions, while convenient, could introduce subtle bugs into your
|
||||
application. Examples: that they are case-insensitive could introduce
|
||||
a bug; if the data submitted is not in UTF-8 format, then the conversion
|
||||
to a string will fail; if an attacked submits a form field as if it were
|
||||
a file, when it is not, then the @scheme[request-bindings] will hold a
|
||||
@scheme[bytes?] object and your program will error; and, for file uploads
|
||||
you lose the filename.
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
@section[#:tag "response-structs.ss"]{HTTP Responses}
|
||||
|
||||
|
|
@ -300,31 +322,6 @@ servlet developer.
|
|||
@file{servlet/helpers.ss} provides functions built on
|
||||
@file{servlet/web.ss} that are useful in many servlets.
|
||||
|
||||
@; XXX Move into binding.ss
|
||||
@defproc[(request-bindings [req request?])
|
||||
(listof (or/c (cons/c symbol? string?)
|
||||
(cons/c symbol? bytes?)))]{
|
||||
Translates the @scheme[request-bindings/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s, except in the case
|
||||
of @scheme[binding:file] bindings, which are left as is. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
@defproc[(request-headers [req request?])
|
||||
(listof (cons/c symbol? string?))]{
|
||||
Translates the @scheme[request-headers/raw] of @scheme[req] by
|
||||
interpreting @scheme[bytes?] as @scheme[string?]s. Ids are then
|
||||
translated into lowercase symbols.
|
||||
}
|
||||
|
||||
These functions, while convenient, could introduce subtle bugs in your
|
||||
application. Examples: the fact they are case-insensitive could introduce
|
||||
a bug; if the data submitted is not in UTF-8 format, then the conversion
|
||||
to a string will fail; if an attacked submits a form field as if it were
|
||||
a file, when it is not, then the @scheme[request-bindings] will hold a
|
||||
@scheme[bytes?] object and your program will error; and, for file uploads
|
||||
you lose the filename.
|
||||
|
||||
@; XXX Move into http/response.ss
|
||||
@; XXX Change headers to make-header struct
|
||||
@defproc[(redirect-to [uri string?]
|
||||
|
|
|
|||
|
|
@ -1,6 +1,25 @@
|
|||
(module bindings mzscheme
|
||||
(require (lib "list.ss")
|
||||
(lib "contract.ss"))
|
||||
(lib "contract.ss")
|
||||
(lib "plt-match.ss"))
|
||||
(require "../private/util.ss"
|
||||
"../private/request-structs.ss")
|
||||
|
||||
(define (request-headers request)
|
||||
(map (match-lambda
|
||||
[(struct header (field value))
|
||||
(cons (lowercase-symbol! (bytes->string/utf-8 field))
|
||||
(bytes->string/utf-8 value))])
|
||||
(request-headers/raw request)))
|
||||
(define (request-bindings request)
|
||||
(map (match-lambda
|
||||
[(struct binding:form (id value))
|
||||
(cons (lowercase-symbol! (bytes->string/utf-8 id))
|
||||
(bytes->string/utf-8 value))]
|
||||
[(struct binding:file (id fname value))
|
||||
(cons (lowercase-symbol! (bytes->string/utf-8 id))
|
||||
value)])
|
||||
(request-bindings/raw request)))
|
||||
|
||||
; extract-binding/single : sym (listof (cons str str)) -> str
|
||||
(define (extract-binding/single name bindings)
|
||||
|
|
@ -27,4 +46,7 @@
|
|||
(provide/contract
|
||||
[extract-binding/single (symbol? (listof (cons/c symbol? any/c)) . -> . any/c)]
|
||||
[extract-bindings (symbol? (listof (cons/c symbol? any/c)) . -> . (listof any/c))]
|
||||
[exists-binding? (symbol? (listof (cons/c symbol? any/c)) . -> . boolean?)]))
|
||||
[exists-binding? (symbol? (listof (cons/c symbol? any/c)) . -> . boolean?)]
|
||||
[request-bindings (request? . -> . (listof (or/c (cons/c symbol? string?)
|
||||
(cons/c symbol? bytes?))))]
|
||||
[request-headers (request? . -> . (listof (cons/c symbol? string?)))]))
|
||||
|
|
@ -1,27 +1,9 @@
|
|||
(module helpers mzscheme
|
||||
(require (lib "contract.ss")
|
||||
(lib "kw.ss")
|
||||
(lib "plt-match.ss"))
|
||||
(lib "kw.ss"))
|
||||
(require "../private/util.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss")
|
||||
|
||||
(define (request-headers request)
|
||||
(map (match-lambda
|
||||
[(struct header (field value))
|
||||
(cons (lowercase-symbol! (bytes->string/utf-8 field))
|
||||
(bytes->string/utf-8 value))])
|
||||
(request-headers/raw request)))
|
||||
(define (request-bindings request)
|
||||
(map (match-lambda
|
||||
[(struct binding:form (id value))
|
||||
(cons (lowercase-symbol! (bytes->string/utf-8 id))
|
||||
(bytes->string/utf-8 value))]
|
||||
[(struct binding:file (id fname value))
|
||||
(cons (lowercase-symbol! (bytes->string/utf-8 id))
|
||||
value)])
|
||||
(request-bindings/raw request)))
|
||||
|
||||
|
||||
; redirection-status = (make-redirection-status nat str)
|
||||
(define-struct redirection-status (code message))
|
||||
|
||||
|
|
@ -56,7 +38,4 @@
|
|||
[redirection-status? (any/c . -> . boolean?)]
|
||||
[permanently redirection-status?]
|
||||
[temporarily redirection-status?]
|
||||
[see-other redirection-status?]
|
||||
[request-bindings (request? . -> . (listof (or/c (cons/c symbol? string?)
|
||||
(cons/c symbol? bytes?))))]
|
||||
[request-headers (request? . -> . (listof (cons/c symbol? string?)))]))
|
||||
[see-other redirection-status?]))
|
||||
|
|
@ -1,5 +1,8 @@
|
|||
(module bindings-test mzscheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(lib "list.ss")
|
||||
(lib "url.ss" "net")
|
||||
(lib "request-structs.ss" "web-server" "private")
|
||||
(lib "bindings.ss" "web-server" "servlet"))
|
||||
(provide bindings-tests)
|
||||
|
||||
|
|
@ -9,6 +12,56 @@
|
|||
(test-suite
|
||||
"Bindings"
|
||||
|
||||
(test-suite
|
||||
"request-bindings"
|
||||
(test-case
|
||||
"Simple"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:form #"key" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val"))))
|
||||
(test-case
|
||||
"Case"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:form #"KEY" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val"))))
|
||||
(test-case
|
||||
"Multi"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:form #"key" #"val")
|
||||
(make-binding:form #"key2" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val")
|
||||
(key2 . "val"))))
|
||||
(test-case
|
||||
"File"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:file #"key" #"file" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . #"val")))))
|
||||
|
||||
(test-suite
|
||||
"request-headers"
|
||||
(test-case
|
||||
"Simple"
|
||||
(check-equal? (request-headers
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
(list (make-header #"key" #"val")) empty #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val"))))
|
||||
(test-case
|
||||
"Case"
|
||||
(check-equal? (request-headers
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
(list (make-header #"KEY" #"val")) empty #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val")))))
|
||||
|
||||
(test-case
|
||||
"exists-binding? - true"
|
||||
(check-true (exists-binding? 'foo bs)))
|
||||
|
|
|
|||
|
|
@ -1,9 +1,6 @@
|
|||
(module helpers-test mzscheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(lib "list.ss")
|
||||
(lib "url.ss" "net")
|
||||
(lib "response-structs.ss" "web-server" "private")
|
||||
(lib "request-structs.ss" "web-server" "private")
|
||||
(lib "helpers.ss" "web-server" "servlet"))
|
||||
(provide helpers-tests)
|
||||
|
||||
|
|
@ -46,54 +43,4 @@
|
|||
"redirection-status?"
|
||||
(test-case "permanently" (check-true (redirection-status? permanently)))
|
||||
(test-case "temporarily" (check-true (redirection-status? temporarily)))
|
||||
(test-case "see-other" (check-true (redirection-status? see-other))))
|
||||
|
||||
(test-suite
|
||||
"request-bindings"
|
||||
(test-case
|
||||
"Simple"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:form #"key" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val"))))
|
||||
(test-case
|
||||
"Case"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:form #"KEY" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val"))))
|
||||
(test-case
|
||||
"Multi"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:form #"key" #"val")
|
||||
(make-binding:form #"key2" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val")
|
||||
(key2 . "val"))))
|
||||
(test-case
|
||||
"File"
|
||||
(check-equal? (request-bindings
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
empty (list (make-binding:file #"key" #"file" #"val")) #f
|
||||
"host" 80 "client"))
|
||||
'((key . #"val")))))
|
||||
|
||||
(test-suite
|
||||
"request-headers"
|
||||
(test-case
|
||||
"Simple"
|
||||
(check-equal? (request-headers
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
(list (make-header #"key" #"val")) empty #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val"))))
|
||||
(test-case
|
||||
"Case"
|
||||
(check-equal? (request-headers
|
||||
(make-request 'get (string->url "http://test.com/foo")
|
||||
(list (make-header #"KEY" #"val")) empty #f
|
||||
"host" 80 "client"))
|
||||
'((key . "val"))))))))
|
||||
(test-case "see-other" (check-true (redirection-status? see-other)))))))
|
||||
Loading…
Reference in New Issue
Block a user