diff --git a/pg-sessions.asd b/pg-sessions.asd index de32f87..4362160 100644 --- a/pg-sessions.asd +++ b/pg-sessions.asd @@ -1,8 +1,8 @@ (asdf:defsystem #:pg-sessions :serial t - :description "Describe hunchentoot-postmodern-sessions here" - :author "Your Name " - :license "Specify license here" + :description "Store hunchentoot sessions in a postgres database." + :author "Thomas Hintz" + :license "3-clause BSD." :depends-on (#:postmodern #:anaphora #:alexandria diff --git a/pg-sessions.lisp b/pg-sessions.lisp index 1db7573..40cd335 100644 --- a/pg-sessions.lisp +++ b/pg-sessions.lisp @@ -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))