Revision: 4242 Author: edi URL: http://bknr.net/trac/changeset/4242
More session changes
U trunk/thirdparty/hunchentoot/packages.lisp U trunk/thirdparty/hunchentoot/request.lisp U trunk/thirdparty/hunchentoot/session.lisp U trunk/thirdparty/hunchentoot/specials.lisp
Modified: trunk/thirdparty/hunchentoot/packages.lisp =================================================================== --- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -179,6 +179,7 @@ "LOG-FILE" "LOG-MESSAGE" "MIME-TYPE" + "NEXT-SESSION-ID" "NO-CACHE" "PARAMETER" "POST-PARAMETER" @@ -199,6 +200,7 @@ "REMOVE-SESSION" "REPLY-EXTERNAL-FORMAT" "REQUEST" + "REQUEST-ACCEPTOR" "REQUEST-METHOD" "REQUEST-METHOD*" "REQUEST-URI" @@ -216,6 +218,7 @@ "SERVER-PROTOCOL*" "SESSION-COOKIE-NAME" "SESSION-COOKIE-VALUE" + "SESSION-CREATED" "SESSION-DB" "SESSION-DB-LOCK" "SESSION-GC"
Modified: trunk/thirdparty/hunchentoot/request.lisp =================================================================== --- trunk/thirdparty/hunchentoot/request.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/request.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -30,7 +30,10 @@ (in-package :hunchentoot)
(defclass request () - ((headers-in :initarg :headers-in + ((acceptor :initarg :acceptor + :documentation "The acceptor which created this request object." + :reader request-acceptor) + (headers-in :initarg :headers-in :documentation "An alist of the incoming headers." :reader headers-in) (method :initarg :method
Modified: trunk/thirdparty/hunchentoot/session.lisp =================================================================== --- trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/session.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -69,21 +69,19 @@ (defmethod (setf session-db) (new-value (acceptor t)) (setq *session-db* new-value))
+(defgeneric next-session-id (acceptor) + (:documentation "Returns the next sequential session ID, an integer, +which should be unique per session. The default method uses a simple +global counter and isn't guarded by a lock. For a high-performance +production environment you might consider to use a more robust +method.")) + (let ((session-id-counter 0)) - (defun get-next-session-id () - "Returns the next sequential session id." + (defmethod next-session-id ((acceptor t)) (incf session-id-counter)))
-(let ((global-session-usage-counter 0)) - (defun count-session-usage () - "Counts session usage globally and triggers session gc if necessary." - (when (and *session-gc-frequency* - (zerop (mod (incf global-session-usage-counter) - *session-gc-frequency*))) - (session-gc)))) - (defclass session () - ((session-id :initform (get-next-session-id) + ((session-id :initform (next-session-id (request-acceptor *request*)) :reader session-id :type integer :documentation "The unique ID (an INTEGER) of the session.") @@ -118,12 +116,10 @@ session expires if it's not used.")) (:documentation "SESSION objects are automatically maintained by Hunchentoot. They should not be created explicitly with MAKE-INSTANCE -but implicitly with START-SESSION. Note that SESSION objects can only -be created when the special variable *REQUEST* is bound to a REQUEST -object.")) +but implicitly with START-SESSION."))
(defun encode-session-string (id user-agent remote-addr start) - "Create a uniquely encoded session string based on the values ID, + "Creates a uniquely encoded session string based on the values ID, USER-AGENT, REMOTE-ADDR, and START" ;; *SESSION-SECRET* is used twice due to known theoretical ;; vulnerabilities of MD5 encoding @@ -223,11 +219,24 @@ (defmethod session-cookie-name ((acceptor t)) "hunchentoot-session")
+(defgeneric session-created (acceptor new-session) + (:documentation "This function is called whenever a new session has +been created. There's a default method which might trigger a session +GC based on the value of *SESSION-GC-FREQUENCY*.")) + +(let ((global-session-usage-counter 0)) + (defmethod session-created ((acceptor t) (session t)) + "Counts session usage globally and triggers session GC if +necessary." + (when (and *session-gc-frequency* + (zerop (mod (incf global-session-usage-counter) + *session-gc-frequency*))) + (session-gc)))) + (defun start-session () "Returns the current SESSION object. If there is no current session, creates one and updates the corresponding data structures. In this case the function will also send a session cookie to the browser." - (count-session-usage) (let ((session (session *request*))) (when session (return-from start-session session)) @@ -239,6 +248,7 @@ (set-cookie (session-cookie-name *acceptor*) :value (session-cookie-value session) :path "/") + (session-created *acceptor* session) (setq *session* session)))
(defun remove-session (session) @@ -303,22 +313,22 @@ user-agent (real-remote-addr request) (session-start session)))) - ;; The session key presented by the client is valid. + ;; the session key presented by the client is valid (setf (slot-value session 'last-click) (get-universal-time)) session) (session - ;; The session ID pointed to an existing session, but the - ;; session string did not match the expected session - ;; string. Report to the log file, remove the session to - ;; make sure that it can't be used again. The original - ;; legitimate user will be required to log in again. + ;; the session ID pointed to an existing session, but the + ;; session string did not match the expected session string (log-message* :warning "Fake session identifier '~A' (User-Agent: '~A', IP: '~A')" session-identifier user-agent remote-addr) + ;; remove the session to make sure that it can't be used + ;; again; the original legitimate user will be required to + ;; log in again (remove-session session) nil) (t - ;; No session was found under the ID given, presumably + ;; no session was found under the ID given, presumably ;; because it has expired. (log-message* :info "No session for session identifier '~A' (User-Agent: '~A', IP: '~A')"
Modified: trunk/thirdparty/hunchentoot/specials.lisp =================================================================== --- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 23:10:20 UTC (rev 4241) +++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-11 23:42:18 UTC (rev 4242) @@ -165,8 +165,8 @@
(defvar *session-gc-frequency* 50 "A session GC (see function SESSION-GC) will happen every -*SESSION-GC-FREQUENCY* requests (counting only requests which -use a session) if this variable is not NIL.") +*SESSION-GC-FREQUENCY* requests (counting only requests which create +a new session) if this variable is not NIL. See SESSION-CREATED.")
(defvar *use-user-agent-for-sessions* t "Whether the 'User-Agent' header should be encoded into the session