New tests

svn: r6530

collects/web-server/servlet/basic-auth.ss

@@ -4,14 +4,6 @@
            (lib "base64.ss" "net"))
   (require "../private/request-structs.ss")
   
-  ; Authentication  
-  ; extract-user-pass : (listof (cons sym bytes)) -> (or/c #f (cons str str))
-  ;; Notes (GregP)
-  ;; 1. This is Basic Authentication (RFC 1945 SECTION 11.1)
-  ;;    e.g. an authorization header will look like this:
-  ;;         Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==
-  ;; 2. Headers should be read as bytes and then translated to unicode as appropriate.
-  ;; 3. The Authorization header should have bytes (i.e. (cdr pass-pair) is bytes
   (define (extract-user-pass headers)
     (match (headers-assq* #"Authorization" headers)
       [#f #f]

collects/web-server/tests/servlet/basic-auth-test.ss

@@ -1,8 +1,27 @@
 (module basic-auth-test mzscheme
-  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
+  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
+           (lib "request-structs.ss" "web-server" "private")
+           (lib "basic-auth.ss" "web-server" "servlet"))
   (provide basic-auth-tests)
   
-  ; XXX
   (define basic-auth-tests
     (test-suite
-     "BASIC Authentication")))
+     "BASIC Authentication"
+     
+     (test-case
+      "Simple"
+      (check-equal? (extract-user-pass (list (make-header #"Authorization" #"Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==")))
+                    (cons #"Aladdin" #"open sesame")))
+      
+     (test-case
+      "Value error"
+      (check-false (extract-user-pass (list (make-header #"Authorization" #"Basic adfadQWxhZGRpb124134jpvcGVu=")))))
+     
+     (test-case
+      "No header"
+      (check-false (extract-user-pass (list))))
+     
+     (test-case
+      "Case"
+      (check-equal? (extract-user-pass (list (make-header #"AuthoRIZation" #"Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==")))
+                    (cons #"Aladdin" #"open sesame"))))))