Skip to content
Browse files

Changed the way authentication cookies work, and made session trackin…

…g be per-wiki
  • Loading branch information...
1 parent 717ba38 commit 489a6d3e8ae33cd14820a77c49c3e4836e852625 @vsedach committed
Showing with 45 additions and 41 deletions.
  1. +4 −2 src/acceptor.lisp
  2. +32 −34 src/authentication.lisp
  3. +3 −4 src/dispatcher.lisp
  4. +1 −0 src/package.lisp
  5. +5 −1 src/wiki.lisp
View
6 src/acceptor.lisp
@@ -1,14 +1,16 @@
(in-package #:cliki2)
(defvar *wiki*)
+(defvar *account* nil)
(defclass cliki2-acceptor (easy-acceptor)
((dispatch-table :reader dispatch-table :initarg :dispatch-table)
(wikis :reader wikis :initarg :wikis)))
(defmethod acceptor-dispatch-request ((acceptor cliki2-acceptor) request)
- (let* ((host (subseq (host) 0 (or (position #\: (host)) (length (host)))))
- (*wiki* (cadr (assoc host (wikis acceptor) :test #'string=))))
+ (let* ((host (subseq (host) 0 (or (position #\: (host)) (length (host)))))
+ (*wiki* (cadr (assoc host (wikis acceptor) :test #'string=)))
+ (*account* (account-auth)))
(if *wiki*
(loop for dispatcher in (dispatch-table acceptor)
for action = (funcall dispatcher request)
View
66 src/authentication.lisp
@@ -1,51 +1,49 @@
(in-package #:cliki2)
(in-readtable cliki2)
-(defvar *session-secrets* (make-hash-table :test 'equal))
-(defvar *session-secrets-lock* (make-lock))
+(defstruct session
+ account
+ expires-at
+ password-digest)
(defun logout ()
- (with-lock-held (*session-secrets-lock*)
- (remhash (cookie-in "cliki2auth") *session-secrets*))
+ (with-lock-held ((session-lock *wiki*))
+ (remhash (cookie-in "cliki2auth") (sessions *wiki*)))
(set-cookie "cliki2auth" :value "" :path "/")
nil)
-(defun hash^2-account-password (salt account)
- (ironclad:byte-array-to-hex-string
- (ironclad:digest-sequence
- 'ironclad:sha256
- (flexi-streams:string-to-octets
- (concatenate 'string (account-password-digest account) salt)
- :external-format :utf8))))
+(defun expire-old-sessions ()
+ (with-lock-held ((session-lock *wiki*))
+ (loop for x being the hash-key of (sessions *wiki*)
+ using (hash-value session) do
+ (when (< (session-expires-at session) (get-universal-time))
+ (remhash x (sessions *wiki*))))))
+
+(defun next-expiry-time ()
+ (+ (get-universal-time) (* 60 60 24 180)))
(defun login (account)
- (let* ((salt (make-random-string 20))
- (secret #?"${salt}.${(hash^2-account-password salt account)}"))
- (with-lock-held (*session-secrets-lock*)
- (setf (gethash secret *session-secrets*) account))
- (set-cookie "cliki2auth" :value secret :path "/"
- :expires (+ (get-universal-time) (* 60 60 24 180))))) ;;6 months
+ (let (secret)
+ (with-lock-held ((session-lock *wiki*))
+ (loop while (gethash (setf secret (make-random-string 60))
+ (sessions *wiki*)))
+ (setf (gethash secret (sessions *wiki*))
+ (make-session :account account
+ :expires-at (next-expiry-time)
+ :password-digest (account-password-digest account))))
+ (set-cookie "cliki2auth" :value secret :path "/" :expires (next-expiry-time))))
(defun account-auth ()
- (let* ((cookie (cookie-in "cliki2auth"))
- (dot (position #\. cookie)))
- (awhen (with-lock-held (*session-secrets-lock*)
- (gethash cookie *session-secrets*))
- (if (string= (subseq cookie (1+ dot))
- (hash^2-account-password (subseq cookie 0 dot) it))
- it
+ (let* ((secret (cookie-in "cliki2auth")))
+ (awhen (with-lock-held ((session-lock *wiki*))
+ (gethash secret (sessions *wiki*)))
+ (if (and (< (get-universal-time) (session-expires-at it))
+ (string= (account-password-digest (session-account it))
+ (session-password-digest it)))
+ (progn (setf (session-expires-at it) (next-expiry-time))
+ (session-account it))
(logout)))))
-(defvar *account* nil)
-
-(defmacro with-account (&body body)
- `(let ((*account* (account-auth)))
- ,@body))
-
-(defmethod acceptor-dispatch-request :around ((acceptor cliki2-acceptor) request)
- (declare (ignorable request))
- (with-account (call-next-method)))
-
;;; captcha
(defvar captcha-ops '(floor ceiling truncate round))
View
7 src/dispatcher.lisp
@@ -34,10 +34,9 @@
(cond
((not article)
(setf (return-code*) 404)
- (with-account
- (render-page "Article not found"
- #H[<h1>Article not found</h1>
- <a href="$(#/site/edit-article?title={(guess-article-name)})">Create</a>])))
+ (render-page "Article not found"
+ #H[<h1>Article not found</h1>
+ <a href="$(#/site/edit-article?title={(guess-article-name)})">Create</a>]))
((get-parameter "download" request)
(redirect (elt
(nth-value
View
1 src/package.lisp
@@ -3,4 +3,5 @@
(defpackage #:cliki2
(:use #:cl #:named-readtables #:anaphora #:uri-template #:hunchentoot
#:bordeaux-threads)
+ (:shadow #:session)
(:export #:start-cliki-server))
View
6 src/wiki.lisp
@@ -12,6 +12,7 @@
(update-lock (make-lock "update lock"))
(data-lock (make-lock "data lock"))
(index-lock (make-lock "index lock"))
+ (session-lock (make-lock "session lock"))
;; data
(accounts (make-hash-table :test 'equal))
@@ -26,7 +27,10 @@
(category-index (make-hash-table :test 'equal)) ;; article name
(search-index (make-hash-table :test 'equal)) ;; article name
(author-index (make-hash-table :test 'equal)) ;; revision obj
- (recent-changes ())) ;; revision obj
+ (recent-changes ()) ;; revision obj
+
+ ;; sessions
+ (sessions (make-hash-table :test 'equal)))
;;; access

0 comments on commit 489a6d3

Please sign in to comment.
Something went wrong with that request. Please try again.