|
|
|
|
@ -37,10 +37,6 @@
|
|
|
|
|
:documentation "The session string encodes enough
|
|
|
|
|
data to safely retrieve this session. It is sent to the browser as a
|
|
|
|
|
cookie value or as a GET parameter.")
|
|
|
|
|
(user-agent :initarg :user-agent
|
|
|
|
|
:accessor pg-session-user-agent)
|
|
|
|
|
(remote-addr :initarg :remote-addr
|
|
|
|
|
:accessor pg-session-remote-addr)
|
|
|
|
|
(session-start :col-type bigint :initform (get-universal-time) :accessor pg-session-start)
|
|
|
|
|
(last-click :col-type bigint :initform (get-universal-time) :accessor pg-session-last-click
|
|
|
|
|
:documentation "The last time this session was used.")
|
|
|
|
|
@ -62,9 +58,7 @@ stored in the postmodern database."))
|
|
|
|
|
(loop for code across (md5:md5sum-string string)
|
|
|
|
|
do (format s "~2,'0x" code))))
|
|
|
|
|
|
|
|
|
|
(defun encode-session-string (id user-agent remote-addr start)
|
|
|
|
|
"Creates a uniquely encoded session string based on the values ID,
|
|
|
|
|
USER-AGENT, and START"
|
|
|
|
|
(defun encode-session-string (id start)
|
|
|
|
|
;; *PG-SESSION-SECRET* is used twice due to known theoretical
|
|
|
|
|
;; vulnerabilities of MD5 encoding
|
|
|
|
|
(md5-hex (concatenate 'string
|
|
|
|
|
@ -72,18 +66,12 @@ USER-AGENT, and START"
|
|
|
|
|
(md5-hex (format nil "~A~A~@[~A~]~@[~A~]~A"
|
|
|
|
|
*pg-session-secret*
|
|
|
|
|
id
|
|
|
|
|
(and hunchentoot:*use-user-agent-for-sessions*
|
|
|
|
|
user-agent)
|
|
|
|
|
(and hunchentoot:*use-remote-addr-for-sessions*
|
|
|
|
|
remote-addr)
|
|
|
|
|
start)))))
|
|
|
|
|
|
|
|
|
|
(defun stringify-session (session)
|
|
|
|
|
"Creates a string representing of the SESSION object SESSION. See
|
|
|
|
|
ENCODE-SESSION-STRING."
|
|
|
|
|
(encode-session-string (pg-session-id session)
|
|
|
|
|
(pg-session-user-agent session)
|
|
|
|
|
(pg-session-remote-addr session)
|
|
|
|
|
(pg-session-start session)))
|
|
|
|
|
|
|
|
|
|
(defun session-too-old-p (session)
|
|
|
|
|
@ -122,9 +110,7 @@ case the function will also send a session cookie to the browser."
|
|
|
|
|
(return-from pg-start-session session))
|
|
|
|
|
(setf session
|
|
|
|
|
(apply #'make-dao
|
|
|
|
|
(append `(,*session-type*
|
|
|
|
|
:user-agent ,(hunchentoot:user-agent hunchentoot:*request*)
|
|
|
|
|
:remote-addr ,(hunchentoot:real-remote-addr hunchentoot:*request*))
|
|
|
|
|
(append `(,*session-type*)
|
|
|
|
|
args)))
|
|
|
|
|
(setf (hunchentoot:session hunchentoot:*request*) session)
|
|
|
|
|
(setf (pg-session-string session) (stringify-session session))
|
|
|
|
|
@ -145,9 +131,6 @@ will not create a new one."
|
|
|
|
|
(hunchentoot:log-message* :info "Session with ID ~A too old" id))
|
|
|
|
|
(pg-remove-session session)
|
|
|
|
|
(setq session nil))
|
|
|
|
|
(when session
|
|
|
|
|
(setf (pg-session-user-agent session) (hunchentoot:user-agent request)
|
|
|
|
|
(pg-session-remote-addr session) (hunchentoot:real-remote-addr request)))
|
|
|
|
|
session))
|
|
|
|
|
|
|
|
|
|
(defmethod hunchentoot:session-verify ((request hunchentoot:request))
|
|
|
|
|
@ -168,17 +151,13 @@ will not create a new one."
|
|
|
|
|
(destructuring-bind (id-string session-string)
|
|
|
|
|
(cl-ppcre:split ":" session-identifier :limit 2)
|
|
|
|
|
(let* ((id (parse-integer id-string))
|
|
|
|
|
(session (get-stored-session id request))
|
|
|
|
|
(user-agent (hunchentoot:user-agent request))
|
|
|
|
|
(remote-addr (hunchentoot:remote-addr request)))
|
|
|
|
|
(session (get-stored-session id request)))
|
|
|
|
|
(cond
|
|
|
|
|
((and session
|
|
|
|
|
(string= session-string
|
|
|
|
|
(pg-session-string session))
|
|
|
|
|
(string= session-string
|
|
|
|
|
(encode-session-string id
|
|
|
|
|
user-agent
|
|
|
|
|
(hunchentoot:real-remote-addr request)
|
|
|
|
|
(pg-session-start session))))
|
|
|
|
|
;; the session key presented by the client is valid
|
|
|
|
|
(setf (pg-session-last-click session) (get-universal-time))
|
|
|
|
|
@ -215,11 +194,3 @@ SESSION \(the default is the current session) if it exists."
|
|
|
|
|
(,%symbol ,symbol))
|
|
|
|
|
(setf (slot-value ,%session ,%symbol) ,new-value)
|
|
|
|
|
(save-pg-session ,%session))))
|
|
|
|
|
|
|
|
|
|
;; (defun reset-sessions (&optional (acceptor *acceptor*))
|
|
|
|
|
;; "Removes ALL stored sessions of ACCEPTOR."
|
|
|
|
|
;; (with-session-lock-held ((session-db-lock acceptor))
|
|
|
|
|
;; (loop for (nil . session) in (session-db acceptor)
|
|
|
|
|
;; do (acceptor-remove-session acceptor session))
|
|
|
|
|
;; (setq *session-db* nil))
|
|
|
|
|
;; (values))
|
|
|
|
|
|
