about summary refs log tree commit diff
path: root/web/panettone/src
diff options
context:
space:
mode:
Diffstat (limited to 'web/panettone/src')
-rw-r--r--web/panettone/src/panettone.lisp25
1 files changed, 16 insertions, 9 deletions
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*)))