tjhintz/pg-sessions
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merged in testing-stashish (pull request #1)

Browse Source 
fu bar baz
This commit is contained in:
Thomas Hintz
2014-07-10 08:58:57 -07:00
parent 1688e7a875 982aaeb312
commit 4c9465d6ad
2 changed files with 6 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
pg-sessions.asd
View File

@@ -1,8 +1,8 @@
(asdf:defsystem #:pg-sessions
:serial t
:description "Describe hunchentoot-postmodern-sessions here"
:author "Your Name <your.name@example.com>"
:license "Specify license here"
:description "Store hunchentoot sessions in a postgres database."
:author "Thomas Hintz"
:license "3-clause BSD."
:depends-on (#:postmodern
#:anaphora
#:alexandria

35
pg-sessions.lisp
View File

@@ -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))