diff options
Diffstat (limited to 'web/panettone')
-rw-r--r-- | web/panettone/default.nix | 1 | ||||
-rw-r--r-- | web/panettone/src/panettone.lisp | 25 |
2 files changed, 17 insertions, 9 deletions
diff --git a/web/panettone/default.nix b/web/panettone/default.nix index b954bcec67ac..2de000b7e852 100644 --- a/web/panettone/default.nix +++ b/web/panettone/default.nix @@ -6,6 +6,7 @@ depot.nix.buildLisp.program { deps = with depot.third_party.lisp; [ cl-prevalence cl-who + drakma defclass-std easy-routes hunchentoot diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp index 026d47825f37..c49dc63c6c35 100644 --- a/web/panettone/src/panettone.lisp +++ b/web/panettone/src/panettone.lisp @@ -192,7 +192,7 @@ updated issue" (when message (who:htm (:div :class "alert" (who:esc message)))))) -(defun render/login (&optional message) +(defun render/login (&key message (original-uri "/")) (render (:div :class "login-form" @@ -203,6 +203,8 @@ updated issue" (render/alert message) (:form :method :post :action "/login" + (:input :type "hidden" :name "original-uri" + :value original-uri) (:div (:label :for "username" "Username") @@ -378,20 +380,25 @@ updated issue" (defun @auth (next) (if-let ((*user* (hunchentoot:session-value 'user))) (funcall next) - (hunchentoot:redirect "/login"))) - -(defroute login-form ("/login" :method :get) () + (hunchentoot:redirect + (format nil "/login?original-uri=~A" + (drakma:url-encode + (hunchentoot:request-uri*) + :utf-8))))) + +(defroute login-form ("/login" :method :get) + (original-uri) (if (hunchentoot:session-value 'user) - (hunchentoot:redirect "/") - (render/login))) + (hunchentoot:redirect (or original-uri "/")) + (render/login :original-uri original-uri))) (defroute submit-login ("/login" :method :post) - (&post username password) + (&post original-uri username password) (if-let ((user (authenticate-user username password))) (progn (setf (hunchentoot:session-value 'user) user) - (hunchentoot:redirect "/")) - (render/login "Invalid credentials"))) + (hunchentoot:redirect (or original-uri "/"))) + (render/login :message "Invalid credentials"))) (defroute index ("/" :decorators (@auth)) () (let ((issues (open-issues *p-system*))) |