From 6d8b84d6250a27a8774c8f258158af9c33ad7271 Mon Sep 17 00:00:00 2001 From: Shaka Chen Date: Thu, 2 Jun 2022 23:25:25 +0800 Subject: [PATCH 1/5] use cl-pass to hash and check password in clog-web-dbi --- clog.asd | 2 +- source/clog-web-dbi.lisp | 24 +++++++++++++----------- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/clog.asd b/clog.asd index c7b100b..9009c4e 100644 --- a/clog.asd +++ b/clog.asd @@ -13,7 +13,7 @@ #:bordeaux-threads #:trivial-open-browser #:parse-float #:quri #:lack-middleware-static #:lack-request #:lack-util-writer-stream #:closer-mop #:mgl-pax #:cl-template - #:sqlite #:cl-dbi) + #:sqlite #:cl-dbi #:cl-pass) :components ((:file "clog-connection") (:file "clog") (:file "clog-utilities") diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index 9d03cf1..9854b63 100644 --- a/source/clog-web-dbi.lisp +++ b/source/clog-web-dbi.lisp @@ -57,9 +57,10 @@ if one is present and login fails." (dbi:execute (dbi:prepare sql-connection - "select token from users where username=? and password=?") - (list username password))))) - (when contents + "select token from users where username=?") + (list username))))) + (when (and contents + (cl-pass:check-password password (getf (car contents) :|password|))) (store-authentication-token body (getf (car contents) :|token|))))) ;;;;;;;;;;;; @@ -120,7 +121,7 @@ if one is present and login fails." (sql-insert* "users" `(:username ,(form-result result "username") - :password ,(form-result result "password") + :password ,(cl-pass:hash (form-result result "password")) :token ,(make-token)))) (url-replace (location body) next-step))))))))) @@ -155,15 +156,16 @@ if one is present and login fails." (dbi:execute (dbi:prepare sql-connection - "select username from users where username=? and password=?") - (list (getf (profile (get-web-site body)) :|username|) - (form-result result "oldpass")))))) - (cond (contents + "select username from users where username=?") + (list (getf (profile (get-web-site body)) :|username|)))))) + (cond (and contents + (cl-pass:check-password (form-result result "oldpass") + (getf (car contents) :|password|))) (dbi:do-sql sql-connection (sql-update "users" - `(:password ,(form-result result "password")) + `(:password ,(cl-pass:hash (form-result result "password"))) "username=?") (list (getf (profile (get-web-site body)) :|username|))) (url-replace (location body) next-step)) @@ -185,7 +187,7 @@ if one is present and login fails." sql-connection (sql-update "users" - `(:password ,new-password) + `(:password ,(cl-pass:hash new-password)) "username=?") (list username))) @@ -226,7 +228,7 @@ if one is present and login fails." (dbi:do-sql sql-connection (sql-insert* "users" `(:username "admin" - :password "admin" + :password (cl-pass:hash "admin") :token ,(make-token))))) ;;;;;;;;;;;;;;;;;; From e8ca5d4a2e365c1d6f1bd0d1efe0c34e41fed345 Mon Sep 17 00:00:00 2001 From: Shaka Chen Date: Fri, 3 Jun 2022 17:13:38 +0800 Subject: [PATCH 2/5] fixed check-password with nil hashed password --- source/clog-web-dbi.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index 9854b63..0a40444 100644 --- a/source/clog-web-dbi.lisp +++ b/source/clog-web-dbi.lisp @@ -57,7 +57,7 @@ if one is present and login fails." (dbi:execute (dbi:prepare sql-connection - "select token from users where username=?") + "select * from users where username=?") (list username))))) (when (and contents (cl-pass:check-password password (getf (car contents) :|password|))) @@ -156,7 +156,7 @@ if one is present and login fails." (dbi:execute (dbi:prepare sql-connection - "select username from users where username=?") + "select username, password from users where username=?") (list (getf (profile (get-web-site body)) :|username|)))))) (cond (and contents (cl-pass:check-password (form-result result "oldpass") From 9333f5c2956a186d5e90ce14ce7296ae1b427d07 Mon Sep 17 00:00:00 2001 From: Shaka Chen Date: Fri, 3 Jun 2022 17:19:28 +0800 Subject: [PATCH 3/5] fixed a parenthesis mistake --- source/clog-web-dbi.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index 0a40444..2189046 100644 --- a/source/clog-web-dbi.lisp +++ b/source/clog-web-dbi.lisp @@ -158,9 +158,9 @@ if one is present and login fails." sql-connection "select username, password from users where username=?") (list (getf (profile (get-web-site body)) :|username|)))))) - (cond (and contents - (cl-pass:check-password (form-result result "oldpass") - (getf (car contents) :|password|))) + (cond ((and contents + (cl-pass:check-password (form-result result "oldpass") + (getf (car contents) :|password|))) (dbi:do-sql sql-connection (sql-update From c448aae9cff8e91d3c39de9f4852b135c9f067b1 Mon Sep 17 00:00:00 2001 From: Shaka Chen Date: Fri, 3 Jun 2022 17:23:25 +0800 Subject: [PATCH 4/5] missing comma in backqoute list --- source/clog-web-dbi.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index 2189046..fe9d494 100644 --- a/source/clog-web-dbi.lisp +++ b/source/clog-web-dbi.lisp @@ -228,7 +228,7 @@ if one is present and login fails." (dbi:do-sql sql-connection (sql-insert* "users" `(:username "admin" - :password (cl-pass:hash "admin") + :password ,(cl-pass:hash "admin") :token ,(make-token))))) ;;;;;;;;;;;;;;;;;; From c7669ca1af8aa4eda0db0d0ccb165484c2fcd479 Mon Sep 17 00:00:00 2001 From: Shaka Chen Date: Fri, 3 Jun 2022 17:29:53 +0800 Subject: [PATCH 5/5] auto indented --- source/clog-web-dbi.lisp | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index fe9d494..aed7ac4 100644 --- a/source/clog-web-dbi.lisp +++ b/source/clog-web-dbi.lisp @@ -321,18 +321,18 @@ and if CAN-EDIT unless they are set to nil." (list :content pages :do-add (when (clog-auth:is-authorized-p roles can-edit) (lambda (content) - (push (list sql-timestamp-func) content) - (push :createdate content) - (push page content) - (push :key content) - (push page content) - (push :username content) - (when on-new - (setf content (funcall on-new content))) - (when content - (dbi:do-sql - sql-connection - (sql-insert* table content))))))) + (push (list sql-timestamp-func) content) + (push :createdate content) + (push page content) + (push :key content) + (push page content) + (push :username content) + (when on-new + (setf content (funcall on-new content))) + (when content + (dbi:do-sql + sql-connection + (sql-insert* table content))))))) (dolist (content pages) (when content (when on-content