|
| 1 | +;; https://paste.sr.ht/%7Emarcuskammer/587dc97736e6ffc3d2b37895f73c36bb7ba9c0e7 |
| 2 | + |
| 3 | +(defpackage :login-demo |
| 4 | + (:use :cl)) |
| 5 | + |
| 6 | +(in-package :login-demo) |
| 7 | + |
| 8 | +;; User-facing paramaters. |
| 9 | +(defparameter *port* 9001) |
| 10 | + |
| 11 | +;; Internal variables. |
| 12 | +(defvar *server* nil) |
| 13 | + |
| 14 | + |
| 15 | +;;; Models. |
| 16 | +(defun get-user (name) |
| 17 | + (list :name name :password "demo")) ;; <--- all our passwords are "demo" |
| 18 | + |
| 19 | +(defun valid-user-p (name password) |
| 20 | + (let ((user (get-user name))) |
| 21 | + (and user |
| 22 | + (string= name (getf user :name)) |
| 23 | + (string= password (getf user :password))))) |
| 24 | + |
| 25 | +;;; Templates. |
| 26 | +;;; XXX: we have to escape the quotes in our string templates. |
| 27 | +(defparameter *template-login* " |
| 28 | + <html lang=en> |
| 29 | + <head> |
| 30 | + <meta charset=UTF-8> |
| 31 | + <title>Login</title> |
| 32 | + </head> |
| 33 | + <body> |
| 34 | + <div> |
| 35 | + Login form. |
| 36 | + </div> |
| 37 | + <div> |
| 38 | + Any user name is valid. The password is \"demo\". |
| 39 | + </div> |
| 40 | +
|
| 41 | + {% if error %} |
| 42 | + <p style=\"color: red;\">Invalid username or password</p> |
| 43 | + {% endif %} |
| 44 | +
|
| 45 | + <form method=post action=\"/admin/\"> |
| 46 | + <p>Username: |
| 47 | + {% if name %} |
| 48 | + <input type=text name=user value=\"{{ name }}\"> |
| 49 | + {% else %} |
| 50 | + <input type=text name=user> |
| 51 | + {% endif %} |
| 52 | + <p>Password: |
| 53 | + <input type=password name=password> |
| 54 | + <p> |
| 55 | + <input type=submit value=\"Log In\"> |
| 56 | + </form> |
| 57 | + </body> |
| 58 | + </html> " |
| 59 | + ) |
| 60 | + |
| 61 | +(defparameter *template-welcome* " |
| 62 | + <html lang=en> |
| 63 | + <head> |
| 64 | + <meta charset=UTF-8> |
| 65 | + <title>Welcome</title> |
| 66 | + </head> |
| 67 | + <body> |
| 68 | + <h1>Welcome, {{ name }}!</h1> |
| 69 | + <p>You are logged in. |
| 70 | + <a href=\"/admin/logout\">Log out</a> |
| 71 | + </body> |
| 72 | + </html> |
| 73 | + ") |
| 74 | + |
| 75 | +(defun render (template &rest args) |
| 76 | + (apply |
| 77 | + #'djula:render-template* |
| 78 | + (djula:compile-string template) |
| 79 | + nil |
| 80 | + args)) |
| 81 | + |
| 82 | + |
| 83 | +;; Views. |
| 84 | +(defun loggedin-p () |
| 85 | + (hunchentoot:session-value 'user)) |
| 86 | + |
| 87 | +(hunchentoot:define-easy-handler (admin :uri "/admin/") () |
| 88 | + (ecase (hunchentoot:request-method*) |
| 89 | + (:get |
| 90 | + (if (loggedin-p) |
| 91 | + (render *template-welcome*) |
| 92 | + (render *template-login*))) |
| 93 | + (:post |
| 94 | + (let ((name (hunchentoot:post-parameter "user")) |
| 95 | + (password (hunchentoot:post-parameter "password"))) |
| 96 | + (cond |
| 97 | + ((valid-user-p name password) |
| 98 | + (hunchentoot:start-session) |
| 99 | + (setf (hunchentoot:session-value 'name) name) |
| 100 | + (render *template-welcome* :name name)) |
| 101 | + (t |
| 102 | + (render *template-login* :name name :error t))))) |
| 103 | + )) |
| 104 | + |
| 105 | +(hunchentoot:define-easy-handler (admin2 :uri "/admin") () |
| 106 | + (hunchentoot:redirect "/admin/")) |
| 107 | + |
| 108 | +(hunchentoot:define-easy-handler (logout :uri "/admin/logout") () |
| 109 | + (setf (hunchentoot:session-value 'name) nil) |
| 110 | + (hunchentoot:redirect "/admin/")) |
| 111 | + |
| 112 | +;; Server. |
| 113 | +(defun start-server (&key (port *port*)) |
| 114 | + (format t "~&Starting the login demo on port ~a~&" port) |
| 115 | + (unless *server* |
| 116 | + (setf *server* (make-instance 'hunchentoot:easy-acceptor :port port))) |
| 117 | + (hunchentoot:start *server*)) |
| 118 | + |
| 119 | +(defun stop-server () |
| 120 | + (hunchentoot:stop *server*)) |
0 commit comments