[hunchentoot-devel] Re: session shearing question
Andrea Chiumenti
kiuma72 at gmail.com
Tue Jan 8 09:18:34 UTC 2008
sorry a missing paren in stringify-session
On Jan 8, 2008 10:12 AM, Andrea Chiumenti <kiuma72 at gmail.com> wrote:
> Hi Edi,
> are you interested in these modifications ?
>
>
> (defgeneric request-realm (req)
> (:documentation "Returns the realm under which the request has been
> sent.
> A realm is used to group resources under a common 'place', and is used for
> registered web applications
> to have different or common sessions for a give user."))
> (defgeneric (setf request-realm) (value req)
> (:documentation "Sets the realm under which the request has been sent,
> where value is the realm name.
> A realm is used to group resources under a common 'place', and is used for
> registered web applications
> to have different or common sessions for a give user."))
>
> (defmethod request-realm ((req hunchentoot::request))
> (aux-request-value 'realm req))
>
> (defmethod (setf request-realm) (value (req hunchentoot::request))
> (setf (aux-request-value req) value))
>
> (defclass session ()
> ((session-id :initform (get-next-session-id)
> :reader session-id
> :type integer
> :documentation "The unique ID \(an INTEGER) of the
> session.")
> (session-realm :initform (request-realm *request*)
> :reader session-realm
> :documentation "Defines a realm for this session.
> A realm is injected by *request* aux parameter, and is used to group
> resources that will share this session object.")
> (session-string :reader session-string
> :documentation "The session strings 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 :initform (user-agent *request*)
> :reader session-user-agent
> :documentation "The incoming 'User-Agent' header that
> was sent when this session was created.")
> (remote-addr :initform (real-remote-addr *request*)
> :reader session-remote-addr
> :documentation "The remote IP address of the client when
> this sessions was started as returned by REAL-REMOTE-ADDR.")
> (session-start :initform (get-universal-time)
> :reader session-start
> :documentation "The time this session was started.")
> (last-click :initform (get-universal-time)
> :reader session-last-click
> :documentation "The last time this session was used.")
> (session-data :initarg :session-data
> :initform nil
> :reader session-data
> :documentation "Data associated with this session -
> see SESSION-VALUE.")
> (session-counter :initform 0
> :reader session-counter
> :documentation "The number of times this session
> has been used.")
> (max-time :initarg :max-time
> :initform *session-max-time*
> :accessor session-max-time
> :type fixnum
> :documentation "The time \(in seconds) after which this
> 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."))
>
> (defun encode-session-string (id user-agent remote-addr start realm)
> "Create 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
> (md5-hex (concatenate 'string
> *session-secret*
> (md5-hex (format nil "~A~A~@[~A~]~@[~A~]~A~@[~A~]"
> *session-secret*
> id
> (and
> *use-user-agent-for-sessions*
> user-agent)
> (and
> *use-remote-addr-for-sessions*
> remote-addr)
> start
> realm)))))
>
> (defun stringify-session (session)
> "Creates a string representing the SESSION object SESSION. See
> ENCODE-SESSION-STRING."
> (encode-session-string (session-id session)
> (session-user-agent session)
> (session-remote-addr session)
> (session-start session)
> (session-realm session))
>
>
>
> (defun session-verify (request)
> "Tries to get a session identifier from the cookies \(or
> alternatively from the GET parameters) sent by the client. This
> identifier is then checked for validity against the REQUEST object
> REQUEST. On success the corresponding session object \(if not too old)
> is returned \(and updated). Otherwise NIL is returned."
> (let ((session-identifier (or (cookie-in *session-cookie-name* request)
> (get-parameter *session-cookie-name*
> request))))
> (unless (and session-identifier
> (stringp session-identifier)
> (plusp (length session-identifier)))
> (return-from session-verify nil))
> (destructuring-bind (id-string session-string)
> (split ":" session-identifier :limit 2)
> (let* ((id (and (scan "^\\d+$" id-string)
> (parse-integer id-string
> :junk-allowed t)))
> (session (and id
> (get-stored-session id)))
> (user-agent (user-agent request))
> (remote-addr (remote-addr request)))
> (unless (and session
> session-string
> (string= session-string
> (session-string session))
> (string= session-string
> (encode-session-string id
> user-agent
> (real-remote-addr
> request)
> (session-start
> session)
> (request-realm request))))
> (when *reply*
> (cond ((null session)
> (log-message :notice "No session for session
> identifier '~A' (User-Agent: '~A', IP: '~A')"
> session-identifier user-agent
> remote-addr))
> (t
> (log-message :warning "Fake session identifier '~A'
> (User-Agent: '~A', IP: '~A')"
> session-identifier user-agent
> remote-addr))))
> (when session
> (remove-session session))
> (return-from session-verify nil))
> (incf (slot-value session 'session-counter))
> (setf (slot-value session 'last-click) (get-universal-time))
> session))))
>
> (defun start-session (&optional (path "/"))
> "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.
> This function slightly differs from standard hunchentoot implementation
> because
> it can bound a session to a specific url inside the same server instance."
> (count-session-usage)
> (let ((session (session *request*)))
> (when session
> (return-from start-session session))
> (setf session (make-instance 'session)
> (session *request*) session)
> (with-lock (*session-data-lock*)
> (setq *session-data* (acons (session-id session) session
> *session-data*)))
> (set-cookie *session-cookie-name*
> :value (session-cookie-value session)
> :path path)
> (setq *session* session)))
>
>
> On Jan 7, 2008 7:43 AM, Andrea Chiumenti < kiuma72 at gmail.com> wrote:
>
> > Hello, Edi
> >
> > I've spent the weekend on figuring out how to bind sessions for each
> > application registered and finally I've found a solution!
> > Before writing function redefinitions into my project, thing that I find
> > a bit 'dirty', do you want me to post here my modifications so
> > that sessions have their own realm and session cookies are bound to
> > specific applications ?
> >
> > Cheers,
> > kiuma
> >
> >
> > On Jan 7, 2008 5:45 AM, Edi Weitz < edi at agharta.de> wrote:
> >
> > > On Sat, 5 Jan 2008 11:31:06 +0100, "Andrea Chiumenti" <
> > > kiuma72 at gmail.com> wrote:
> > >
> > > > now my question is *session-data* common to all hunchentoot servers
> > > > instantiated on the same lisp instance ?
> > >
> > > Yes, it's a global special variable.
> > >
> > > > Another question, now suppose we have in a single hunchentoot server
> > > > serves two applications ( distinguished by their path ). It seems
> > > > that hunchentoot shares the session between these two, and sometime
> > > > it's good, but what should I do if I want applications to share
> > > > different sessions ?
> > >
> > > There's currently no mechanism for this. Unless you write your own,
> > > of course.
> > > _______________________________________________
> > > tbnl-devel site list
> > > tbnl-devel at common-lisp.net
> > > http://common-lisp.net/mailman/listinfo/tbnl-devel
> > >
> >
> >
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/tbnl-devel/attachments/20080108/9b548a78/attachment.html>
More information about the Tbnl-devel
mailing list