X-Git-Url: http://git.kpe.io/?p=wol.git;a=blobdiff_plain;f=sessions.lisp;h=6c63e0433bd82499164e6655b6dac95db9d4736c;hp=9b7d2913fde81be0bc77e3c5892b45774d0e5266;hb=HEAD;hpb=7a32ea0dccd70ba9ac40122e929980726feb1357 diff --git a/sessions.lisp b/sessions.lisp index 9b7d291..6c63e04 100644 --- a/sessions.lisp +++ b/sessions.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2003 ;;;; -;;;; $Id: sessions.lisp,v 1.6 2003/08/23 22:30:30 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -21,24 +21,24 @@ (lambda (k v) (declare (ignore k)) (when (equal key (websession-key v)) - (setf (websession-lastref v) (get-universal-time)) - (return-from find-websession v))) + (setf (websession-lastref v) (get-universal-time)) + (return-from find-websession v))) sessions) nil)) (defun is-session-enabled (ent) (not (null (sessions (session-master (entity-project ent)))))) - + (defun make-websession (req ent) (let* ((key (random-string :length +length-session-id+ - :set :lower-alphanumeric)) - (sess (make-instance 'websession - :key key - :lastref (get-universal-time) - :lifetime (lifetime (session-master (entity-project ent))) - :method :try-cookie)) - (hash (sessions (session-master (entity-project ent))))) + :set :lower-alphanumeric)) + (sess (make-instance 'websession + :key key + :lastref (get-universal-time) + :lifetime (lifetime (session-master (entity-project ent))) + :method :try-cookie)) + (hash (sessions (session-master (entity-project ent))))) (when hash (setf (gethash key hash) sess) (setf (websession-from-req req) sess) @@ -48,19 +48,19 @@ (defun compute-session (req ent url-session-id) (when (is-session-enabled ent) (let* ((cookie-session-id (cookie-session-key ent (request-cookies req))) - (session-id (or url-session-id cookie-session-id)) - (found-session (when session-id - (find-websession session-id ent))) - (session (aif found-session - it - (make-websession req ent)))) + (session-id (or url-session-id cookie-session-id)) + (found-session (when session-id + (find-websession session-id ent))) + (session (aif found-session + it + (make-websession req ent)))) (cond - (cookie-session-id - (setf (websession-method session) :cookies)) - (url-session-id - (setf (websession-method session) :url))) + (cookie-session-id + (setf (websession-method session) :cookies)) + (url-session-id + (setf (websession-method session) :url))) (setf (websession-from-req req) session)))) - + ;;; Reap expired sessions @@ -76,33 +76,33 @@ (defun find-expired-sessions () (loop for s in (all-sessions) - when (is-session-expired (car s)) - collect s)) + when (is-session-expired (car s)) + collect s)) (defun all-sessions (&aux s) (maphash (lambda (name proj) (declare (ignore name)) (let* ((sm (session-master proj)) - (sessions (when sm (sessions sm)))) + (sessions (when sm (sessions sm)))) (when sessions - (maphash - (lambda (k v) - (declare (ignore k)) - (push (cons v proj) s)) - sessions)))) + (maphash + (lambda (k v) + (declare (ignore k)) + (push (cons v proj) s)) + sessions)))) *active-projects*) s) (defmethod flush-expired (s) (let ((sessions (sessions (session-master (cdr s))))) (remhash (car s) sessions) - (add-log-entry (cdr s) "flush expired session: key=~A" - (websession-key (car s))))) + (add-log-entry (cdr s) "flush expired session: key=~A" + (websession-key (car s))))) (defun is-session-expired (ws) (> (get-universal-time) (+ (websession-lastref ws) - (websession-lifetime ws)))) + (websession-lifetime ws)))) (defun is-raw-session-id (str) (and (stringp str)