From eb0711d1b09bb2000ee6c25e1e617a63904e4097 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 7 Jun 2007 23:12:03 +0000
Subject: [PATCH] Adding tests and making comment in docs

svn: r6532
---
 .../web-server/docs/reference/servlet.scrbl   | 10 ++-
 collects/web-server/servlet/helpers.ss        |  3 -
 .../web-server/tests/servlet/helpers-test.ss  | 83 ++++++++++++++++++-
 3 files changed, 89 insertions(+), 7 deletions(-)

diff --git a/collects/web-server/docs/reference/servlet.scrbl b/collects/web-server/docs/reference/servlet.scrbl
index 723a863a74..45cbce6451 100644
--- a/collects/web-server/docs/reference/servlet.scrbl
+++ b/collects/web-server/docs/reference/servlet.scrbl
@@ -338,7 +338,15 @@ servlet developer.
  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
diff --git a/collects/web-server/servlet/helpers.ss b/collects/web-server/servlet/helpers.ss
index b34e9615f5..71a18534ca 100644
--- a/collects/web-server/servlet/helpers.ss
+++ b/collects/web-server/servlet/helpers.ss
@@ -40,9 +40,6 @@
                         (current-seconds) #"text/html"
                         `((Location . ,uri) ,@headers) (list)))
   
-  ; with-errors-to-browser 
-  ; to report exceptions that occur later to the browser
-  ; this must be called at the begining of a servlet
   (define (with-errors-to-browser send/finish-or-back thunk)
     (with-handlers ([exn? (lambda (exn)
                             (send/finish-or-back
diff --git a/collects/web-server/tests/servlet/helpers-test.ss b/collects/web-server/tests/servlet/helpers-test.ss
index 6ebefc56af..9f606728a5 100644
--- a/collects/web-server/tests/servlet/helpers-test.ss
+++ b/collects/web-server/tests/servlet/helpers-test.ss
@@ -1,8 +1,85 @@
 (module helpers-test mzscheme
-  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
+  (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)
   
-  ; XXX
   (define helpers-tests
     (test-suite
-     "Helpers")))
\ No newline at end of file
+     "Helpers"
+     
+     (test-suite
+      "with-errors-to-browser"
+      (test-case
+       "Basic"
+       (check-pred list? (with-errors-to-browser (lambda (x) x) (lambda () (error 'error "Hey!")))))
+      (test-case
+       "Basic (succ)"
+       (check-true (with-errors-to-browser (lambda (x) x) (lambda () #t)))))
+     
+     ; XXX Test redirection status
+     ; XXX Test optional headers
+     (test-suite
+      "redirect-to"
+      (test-case
+       "Basic"
+       (check-pred response/full? (redirect-to "http://test.com/foo"))))
+     
+     (test-suite
+      "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"))))))))
\ No newline at end of file