diff of 833040e4d3ec104fbe545dd2f998ac09f42c5dd5
833040e4d3ec104fbe545dd2f998ac09f42c5dd5
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 3b2051f..398db09 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -43,6 +43,10 @@
:components ((:file "user-db")))
(:file "session-db")
(:file "settings")
+ (:module "model"
+ :components
+ ((:file "user")
+ (:file "post")))
(:module "middleware"
:components ((:file "json")
(:file "db")
@@ -71,10 +75,7 @@
(:file "user-editor")
(:file "root-routes")))
- (:module "model"
- :components
- ((:file "user")
- (:file "post")))
+
(:module "view"
:components
((:module "components"
diff --git a/src/middleware/auth.lisp b/src/middleware/auth.lisp
index 7d89a5a..303c603 100644
--- a/src/middleware/auth.lisp
+++ b/src/middleware/auth.lisp
@@ -1,7 +1,7 @@
(defpackage murja.middleware.auth
(:use :cl :postmodern)
- (:import-from :murja.users.user-db :get-user-by-id)
- (:export :*now* :*session-key* :*user* :@can?))
+ (:import-from :murja.model.user :user-username)
+ (:export :@ssr-authenticated :*now* :*session-key* :*user* :@can?))
(in-package :murja.middleware.auth)
@@ -29,6 +29,7 @@
(log:info "populating session var from db ~a => ~a" k v)
(log:info "populating session var from db ~a" k))))))
+;; deprecated, look at @ssr-authenticated
(defun @authenticated (next &key (retries 0))
(let ((session-cookie (hunchentoot:cookie-in "murja-session"))
(username-cookie (hunchentoot:cookie-in "murja-username"))
@@ -69,7 +70,7 @@
:user-id user-id))
"not authorized")))))
-(defun @can? (next ability)
+(defun @can? (ability next)
(if (and *user*
(member ability
(gethash "permissions" *user*)
@@ -91,3 +92,55 @@
(log:info "didn't find header x-murja-now"))
(funcall next))))
+
+
+
+(defun @ssr-authenticated (next &key (require-authentication t) (retries 0))
+ (let ((session-cookie (hunchentoot:cookie-in "murja-session"))
+ (username-cookie (hunchentoot:cookie-in "murja-username"))
+ (user-id (hunchentoot:session-value :logged-in-user-id)))
+ (when lisp-fixup:*dev?*
+ (log:info "Read session-cookie ~a for user ~a" session-cookie username-cookie))
+ (if (and (not user-id)
+ session-cookie
+ (< retries 1))
+ ;; if session-cookie is found but hunchentoot's session is expired, lets try to restore
+ ;; it from the db and retry calling this middleware function. If retries > 0 and
+ ;; restoring-from-db has failed, we're returning 401 to the caller.
+ (if (murja.session.db:assert-ownership-username username-cookie session-cookie)
+ (progn
+ (log:info "populating http-session and retrying")
+ (populate-http-session username-cookie session-cookie)
+ (@ssr-authenticated next :retries (1+ retries)))
+ (progn
+ (if require-authentication
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ (log:warn "assert-ownership-username failed for ~a" username-cookie)
+ "not authorized")
+ (progn
+ (format t "no auth required~%")
+ (funcall next)))))
+ (progn (format t "löydetäänköhän me ~a~%" user-id)
+ (if user-id
+ (let ((user (postmodern:get-dao 'murja.model.user:user user-id)))
+ (if (and user
+ (string= (hunchentoot:session-value :logged-in-username)
+ (user-username user)))
+ (let ((*user* user)
+ (*session-key* session-cookie))
+ (funcall next))
+ (if require-authentication
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ "not authorized")
+ (funcall next))))
+ (if (not require-authentication)
+ (funcall next)
+ (progn
+ (setf (hunchentoot:return-code*) 401)
+ (log:warn "failed auth at @authenticated, ~a" (list :retries retries
+ :session-cookie session-cookie
+ :username-cookie username-cookie
+ :user-id user-id))
+ "not authorized")))))))
diff --git a/src/routes/login-routes.lisp b/src/routes/login-routes.lisp
index 745d892..519ecdc 100644
--- a/src/routes/login-routes.lisp
+++ b/src/routes/login-routes.lisp
@@ -1,6 +1,6 @@
(defpackage murja.routes.login-routes
- (:use :cl)
- (:export :get-session-key :set-session-cookies)
+ (:use :cl :binding-arrows)
+ (:export :get-session-key :set-session-cookies :formdata->hashmap)
(:import-from :cl-hash-util :hash)
(:import-from :murja.session :set-session-value)
(:import-from :lisp-fixup :sha-512)
@@ -118,3 +118,58 @@
(log:warn "Someone called POST /api/initial while there are users")
(setf (hunchentoot:return-code*) 500)
""))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(defun formdata->hashmap (form-body)
+ (reduce (lambda (acc pair)
+ (let ((k (first pair))
+ (v (hunchentoot:url-decode (second pair))))
+ (setf (gethash k acc) v)
+ acc))
+ (->>
+ form-body
+ (str:split "&")
+ (mapcar (lisp-fixup:partial #'str:split "=")))
+
+ :initial-value (hash)))
+
+;; forms-based login
+(defroute post-login ("/api/login"
+ :method :post
+ :decorators (@test-now @transaction)) ()
+ (let* ((form (formdata->hashmap (hunchentoot:raw-post-data :force-text t)))
+ (username (gethash "username" form))
+ (password (gethash "password" form))
+ (user-row (murja.users.user-db:select-user-by-login username (sha-512 password))))
+ (if (and user-row
+ (string= (gethash "username" user-row) username))
+ (let ((settings (murja.routes.settings-routes:get-settings))
+ (murja.middleware.auth:*user* (murja.users.user-db:get-user-by-id (gethash "userid" user-row))))
+ (multiple-value-bind (session-key max-age) (get-session-key username)
+ (if session-key
+ (let ((murja.middleware.auth:*session-key* session-key))
+
+ (set-session-value :logged-in-username username)
+ (set-session-value :logged-in-user-id (gethash "userid" user-row))
+
+ (set-session-cookies username session-key max-age settings)
+ (format t "Login successfully~%"))
+ (progn
+ (log:error "~a tried to log-in but get-session-key didn't return a session key. This happening signifies a bug" username)))))
+
+ (log:error "not authorized"))
+
+ (let ((referer (hunchentoot:header-in* "referer")))
+ (hunchentoot:redirect referer))))
diff --git a/src/view/components/tabs.lisp b/src/view/components/tabs.lisp
index 30aacf5..6c217be 100644
--- a/src/view/components/tabs.lisp
+++ b/src/view/components/tabs.lisp
@@ -55,6 +55,7 @@
(defroute ,(intern (format nil "~a-sym" sym)) (,url
:method :get
:decorators (@transaction
+ (@ssr-authenticated :require-authentication ,require-login )
;;@check-if-initial
(@dispatcher ,inject-to-head)
)) ()