Changes that bring CLASH up to extended HTTP/1.0 support:

Code to implement session management for resources.  The current
version supports transient cookie based session management, but other
forms of management could be added without undue hassle.
This commit is contained in:
2000-07-22 00:49:21 +00:00
parent a53e7391e9
commit f8834bce21

103
src/main/session.cl Normal file
View File

@ -0,0 +1,103 @@
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
;;;; This is copyrighted software. See documentation for terms.
;;;;
;;;; session.cl --- Session management resources
;;;;
;;;; Checkout Tag: $Name$
;;;; $Id$
(in-package :CLASH)
;;;; %File Description:
;;;;
;;;; The Resources in this file implement various session management
;;;; mechanisms for HTTP.
;;;;
;;; Ephemeral cookie-based session management
(defclass session-leader (resource)
((sessions :initform (make-hash-table :test #'equal)
:reader session-leader-sessions)
(session-name :initform "SESSIONID" :initarg :session-name
:reader session-leader-session-name)
(session-path :initform "/" :initarg :session-path
:reader session-leader-session-path)))
(defgeneric session-leader-new-id (leader)
(:documentation "Allocate and return a new transient session id."))
(defmethod session-leader-new-id ((leader session-leader))
(format nil "~D-~D" (get-universal-time) (get-internal-real-time)))
(defgeneric session-leader-new-session (leader session-data)
(:documentation
"Register a new session binding `session-data' to a newly allocated
session id, which is then returned."))
(defmethod session-leader-new-session ((leader session-leader) data)
(let ((new-id (session-leader-new-id leader)))
(setf (gethash new-id (session-leader-sessions leader)) data)
new-id))
(defgeneric session-leader-process-login (leader request)
(:documentation
"Process the :post request to handle a login."))
(defmacro with-new-session ((leader data) &body body)
`(let ((leader ,leader)
(data ,data)
(result (progn ,@body)))
(setf (slot-value result 'set-cookie)
(list (list (session-leader-session-name leader)
(session-leader-new-session leader data))
(list "path"
(session-leader-session-path leader))))
result))
(defmethod access-resource-using-method
((resource session-leader) request (method (eql :POST)))
(session-leader-process-login resource request))
(defgeneric get-session-data (leader request)
(:documentation
"Lookup a possible session-data item bound to the session id that
is included in a Cookie header in the given request. Returns nil of
no corresponding session-data item can be found."))
(defmethod get-session-data ((resource session-leader) request)
(when (header-exists-p request 'cookie)
(let* ((session-name (session-leader-session-name resource))
(cookie (assoc session-name (header-value request 'cookie)
:test #'string-equal)))
(when cookie
(gethash (cdr cookie)
(session-leader-sessions resource)
nil)))))
(defclass sessioned-resource (resource)
())
(defgeneric sessioned-resource-session-leader (resource)
(:documentation
"Determine the session-leader that is responsible for the
sessioned-resource."))
(defgeneric handle-missing-session (resource request)
(:documentation
"Handle a missing session in a `with-session-data' block."))
(defmacro with-session-data ((var resource request) &body body)
"Bind `var' to the session-data object for the session the request
belongs to. If no session-data object exists `handle-missing-session'
is invoked to handle the request."
(let ((res-var (gensym))
(req-var (gensym)))
`(let* ((,res-var ,resource)
(,req-var ,request)
(,var (get-session-data
(sessioned-resource-session-leader ,res-var)
,req-var)))
(if ,var
(progn ,@body)
(handle-missing-session ,res-var ,req-var)))))