[claw-cvs] r47 - trunk/main/claw-core/src

achiumenti at common-lisp.net achiumenti at common-lisp.net
Tue May 13 15:23:32 UTC 2008


Author: achiumenti
Date: Tue May 13 11:23:32 2008
New Revision: 47

Modified:
   trunk/main/claw-core/src/lisplet.lisp
Log:
corrected authorization logic

Modified: trunk/main/claw-core/src/lisplet.lisp
==============================================================================
--- trunk/main/claw-core/src/lisplet.lisp	(original)
+++ trunk/main/claw-core/src/lisplet.lisp	Tue May 13 11:23:32 2008
@@ -264,16 +264,16 @@
                                         ;(when (lisplet-redirect-protected-resources-p lisplet)
                                         ;(redirect-to-https server request))
               (cond 
+                ((and princp (not (user-in-role-p allowed-roles)) (not (string= login-page-url uri)))
+                 (setf (return-code) +http-forbidden+)
+                 (throw 'handler-done nil))
                 ((and (null princp) auth-basicp)
                  (setf (return-code) +http-authorization-required+                 
                        (header-out "WWW-Authenticate") (format nil "Basic realm=\"~A\"" (hunchentoot::quote-string (current-realm))))
                  (throw 'handler-done nil))
                 ((and (null princp) (null auth-basicp) (not (string= login-page-url uri)))
                  (redirect-to-https server request login-page-url)
-                 (throw 'handler-done nil))
-                ((and (not (user-in-role-p allowed-roles)) (not (string= login-page-url uri)))
-                 (setf (return-code) +http-forbidden+)
-                 (throw 'handler-done nil))
+                 (throw 'handler-done nil))                
                 #-:hunchentoot-no-ssl ((not (find (server-port request) (list (clawserver-sslport server) *apache-https-port*)))
                                        (redirect-to-https server request)
                                        (throw 'handler-done nil))))))))



More information about the Claw-cvs mailing list