about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--web/panettone/default.nix1
-rw-r--r--web/panettone/src/panettone.lisp25
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*)))