[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Wed Feb 11 23:42:18 UTC 2009
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
More information about the Bknr-cvs
mailing list