mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

reset passwords

Browse source
This commit is contained in:
David Botton 2022-05-16 18:44:46 -04:00
parent f73a4b1283
commit 75d3762677
2 changed files with 32 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

21
source/clog-web-dbi.lisp
View file

@ -21,6 +21,7 @@
(get-profile function) (get-profile function)
(sign-up function) (sign-up function)
(change-password function) (change-password function)
(reset-password function)
(make-token function) (make-token function)
(load-content function) (load-content function)
(create-base-tables function)) (create-base-tables function))
@ -76,6 +77,7 @@ if one is present and login fails."
(defun sign-up (body sql-connection &key (title "Sign Up") (defun sign-up (body sql-connection &key (title "Sign Up")
(next-step "/login")) (next-step "/login"))
"Setup a sign-up form and process a new sign-up"
(check-type body clog-body) (check-type body clog-body)
(clog-web-form (clog-web-form
body title body title
@ -128,6 +130,7 @@ if one is present and login fails."
(defun change-password (body sql-connection &key (title "Change Password") (defun change-password (body sql-connection &key (title "Change Password")
(next-step "/")) (next-step "/"))
"Setup a change password form and handle change of password"
(check-type body clog-body) (check-type body clog-body)
(clog-web-form (clog-web-form
body title body title
@ -170,11 +173,28 @@ if one is present and login fails."
:time-out 3 :time-out 3
:place-top t))))))))) :place-top t)))))))))
;;;;;;;;;;;;;;;;;;;;
;; reset-password ;;
;;;;;;;;;;;;;;;;;;;;
(defun reset-password (sql-connection username &key (new-password "password"))
"Reset USERNAME's password to :NEW-PASSWORD"
(print username)
(dbi:do-sql
sql-connection
(sql-update
"users"
`(:password ,new-password)
"username=?")
(list username)))
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
;; make-token ;; ;; make-token ;;
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
(defun make-token () (defun make-token ()
"Create a unique token used to associate a browser with a user"
(get-universal-time)) (get-universal-time))
;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;
@ -182,6 +202,7 @@ if one is present and login fails."
;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;
(defun create-base-tables (sql-connection &key (sql-timestamp-func *sqlite-timestamp*)) (defun create-base-tables (sql-connection &key (sql-timestamp-func *sqlite-timestamp*))
"Create default tables"
(dbi:do-sql (dbi:do-sql
sql-connection sql-connection
"create table config (key varchar, value varchar)") "create table config (key varchar, value varchar)")

12
tutorial/32-tutorial.lisp
View file

@ -161,7 +161,17 @@
*sql-connection* *sql-connection*
"select * from users"))))) "select * from users")))))
(dolist (user users) (dolist (user users)
(create-div body :content (getf user :|username|)))))) (let* ((box (create-div body))
(suser (create-span box :content (getf user :|username|)))
(rbut (create-button box :content "Reset Password"
:class "w3-margin-left")))
(declare (ignore suser))
(set-on-click rbut (lambda (obj)
(declare (ignore obj))
(reset-password *sql-connection*
(getf user :|username|))
(setf (disabledp rbut) t)
(setf (text rbut) "Done"))))))))
:authorize t)) :authorize t))
(defun on-new-pass (body) (defun on-new-pass (body)