Permalink
Browse files

Added background thread to expire old sessions

  • Loading branch information...
1 parent bb09238 commit de8d6ae64395c926495613f07a1b6b07aa365e3c @vsedach committed Aug 9, 2012
Showing with 11 additions and 4 deletions.
  1. +4 −4 src/authentication.lisp
  2. +7 −0 src/start.lisp
View
@@ -12,12 +12,12 @@
(set-cookie "cliki2auth" :value "" :path "/")
nil)
-(defun expire-old-sessions ()
- (with-lock-held ((session-lock *wiki*))
- (loop for x being the hash-key of (sessions *wiki*)
+(defun expire-old-sessions (wiki)
+ (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*))))))
+ (remhash x (sessions wiki))))))
(defun next-expiry-time ()
(+ (get-universal-time) (* 60 60 24 180)))
View
@@ -23,6 +23,13 @@
(merge-pathnames "HyperSpec/Data/Symbol-Table.text" homedir)
clhs-lookup::*hyperspec-root* "/site/HyperSpec/")
+ (bt:make-thread
+ (lambda ()
+ (loop (map nil (lambda (x)
+ (expire-old-sessions (cadr x)))
+ wikis)
+ (sleep (* 60 60 24)))))
+
(let ((error-log (merge-pathnames "error-log" homedir)))
(open error-log :direction :probe :if-does-not-exist :create)
(let ((acceptor

0 comments on commit de8d6ae

Please sign in to comment.