src/middleware/session.lisp @ 743c0a981785
Oh boy, here we go... Finally getting back to poking at this. Apparently my Common Lisp has gotten better in the past six months because good lord this code looks bad now. Anyway, a few changes: * Make it run on CCL by working around a usocket bug. * Remove the workaround hacks. It's never gonna work with Fireplace anyway. * Make the socket stream once instead of on every read/write so the GC doesn't hate us.
| author | Steve Losh <steve@stevelosh.com> |
|---|---|
| date | Sat, 09 Apr 2016 20:42:34 +0000 |
| parents | 15af562c7bca |
| children | 9d3d9514dbd8 |
(in-package #:nrepl) (defvar *sessions* (make-hash-table :test #'equal)) (defvar *session* nil) (defun clear-sessions! () (setf *sessions* (make-hash-table :test #'equal))) (defun create-session () (fset:empty-map)) (defun register-session! (id session) (setf (gethash id *sessions*) session)) (defun remove-session! (id) (remhash id *sessions*)) (defun get-session (id) (gethash id *sessions*)) (defun get-sessions () (hash-keys *sessions*)) (defun wrap-session (h) "Handle wrapping incoming messages in sessions. If a message contains a session key, look up that session in the list of registered sessions and bind it into *session*. If a message comes in without a session id, create a new session for it and patch the session id into the message before continuing on down the middleware stack. Also binds the session into *session*. Note that this will NOT register the session into the main map of sessions. " (lambda (message) (let* ((session-id (fset:lookup message "session")) (session (if session-id (get-session session-id) (create-session))) (session-id (or session-id (random-uuid))) (*session* session)) (funcall h (fset:with message "session" session-id))))) (define-middleware wrap-session-ls "ls-sessions" message (respond message (make-map "status" '("done") "sessions" (get-sessions)))) (define-middleware wrap-session-close "close" message (remove-session! (fset:lookup message "session")) (respond message (make-map "status" '("session-closed")))) (define-middleware wrap-session-clone "clone" message (let ((new-id (register-session! (random-uuid) (fset:lookup message "session")))) (respond message (make-map "status" '("done") "new-session" new-id))))