Add lack-middleware-auth-basic.

lack-middleware-auth-basic.asd

@@ -0,0 +1,15 @@
+(in-package :cl-user)
+(defpackage :lack-middleware-auth-basic-asd
+  (:use :cl :asdf))
+(in-package :lack-middleware-auth-basic-asd)
+
+(defsystem lack-middleware-auth-basic
+  :version "0.1"
+  :author "Eitaro Fukamachi"
+  :license "LLGPL"
+  :depends-on (:cl-base64
+               :split-sequence)
+  :components ((:module "src"
+                :components
+                ((:file "middleware/auth/basic"))))
+  :in-order-to ((test-op (test-op t-lack-middleware-auth-basic))))

src/middleware/auth/basic.lisp

@@ -0,0 +1,44 @@
+(in-package :cl-user)
+(defpackage lack.middleware.auth.basic
+  (:use :cl)
+  (:import-from :cl-base64
+                :base64-string-to-string)
+  (:import-from :split-sequence
+                :split-sequence))
+(in-package :lack.middleware.auth.basic)
+
+(defvar *lack-middleware-auth-basic*
+  (lambda (app &key authenticator (realm "restricted area"))
+    (unless authenticator
+      (error ":authenticator is required in lack-middleware-auth-basic"))
+    (check-type authenticator function)
+    (lambda (env)
+      (block nil
+        (let ((authorization (gethash "authorization" (getf env :headers))))
+          (unless authorization
+            (return (return-401 realm)))
+
+          (destructuring-bind (user &optional (pass ""))
+              (parse-authorization-header authorization)
+            (if user
+                (multiple-value-bind (result returned-user)
+                    (funcall authenticator user pass)
+                  (if result
+                      (progn
+                        (setf (getf env :remote-user)
+                              (or returned-user user))
+                        (funcall app env))
+                      (return-401 realm)))
+                (return-401 realm))))))))
+
+(defun return-401 (realm)
+  `(401
+    (:content-type "text/plain"
+     :content-length 22
+     :www-authenticate ,(format nil "Basic realm=~A" realm))
+    ("Authorization required")))
+
+(defun parse-authorization-header (authorization)
+  (when (string= authorization "Basic " :end1 6)
+    (let ((user-and-pass (base64-string-to-string (subseq authorization 6))))
+      (split-sequence #\: user-and-pass))))

t-lack-middleware-auth-basic.asd

@@ -0,0 +1,20 @@
+(in-package :cl-user)
+(defpackage t-lack-middleware-auth-basic-asd
+  (:use :cl :asdf))
+(in-package :t-lack-middleware-auth-basic-asd)
+
+(defsystem t-lack-middleware-auth-basic
+  :author "Eitaro Fukamachi"
+  :license "LLGPL"
+  :depends-on (:lack
+               :lack-test
+               :lack-middleware-auth-basic
+               :prove
+               :dexador
+               :cl-base64)
+  :components
+  ((:test-file "t/middleware/auth/basic"))
+
+  :defsystem-depends-on (:prove-asdf)
+  :perform (test-op :after (op c)
+                    (funcall (intern #.(string :run-test-system) :prove) c)))

t/middleware/auth/basic.lisp

@@ -0,0 +1,48 @@
+(in-package :cl-user)
+(defpackage t.lack.middleware.auth.basic
+  (:use :cl
+        :prove
+        :lack
+        :lack.test
+        :cl-base64))
+(in-package :t.lack.middleware.auth.basic)
+
+(plan 2)
+
+(subtest-app "lack-middleware-auth-basic"
+    (builder
+     (:auth.basic :authenticator (lambda (user pass)
+                                   (and (string= user "hoge")
+                                        (string= pass "fuga"))))
+     (lambda (env)
+       `(200 () (,(format nil "Hello, ~A" (getf env :remote-user))))))
+  (multiple-value-bind (body status headers)
+      (dex:get (localhost))
+    (is status 401)
+    (is body "Authorization required")
+    (is (gethash "www-authenticate" headers)
+        "Basic realm=restricted area"))
+  (is (dex:get (localhost)
+               :headers `(("Authorization" . ,(format nil "Basic ~A"
+                                                      (string-to-base64-string "wrong:auth")))))
+      "Authorization required")
+  (is (dex:get (localhost)
+               :headers `(("Authorization" . ,(format nil "Basic ~A"
+                                                      (string-to-base64-string "hoge:fuga")))))
+      "Hello, hoge"))
+
+(subtest-app "Use :remote-user"
+    (builder
+     (:auth.basic :authenticator (lambda (user pass)
+                                   (when (and (string= user "nitro_idiot")
+                                              (string= pass "password"))
+                                     (values t "Eitaro Fukamachi"))))
+     (lambda (env)
+       `(200 () (,(format nil "Hello, ~A" (getf env :remote-user))))))
+  (is (dex:get (localhost)) "Authorization required")
+  (is (dex:get (localhost)
+               :headers `(("Authorization" . ,(format nil "Basic ~A"
+                                                      (string-to-base64-string "nitro_idiot:password")))))
+      "Hello, Eitaro Fukamachi"))
+
+(finalize)