;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: sessions.lisp ;;;; Purpose: Session handler ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2003 ;;;; ;;;; $Id: sessions.lisp,v 1.1 2003/07/16 16:02:21 kevin Exp $ ;;;; ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg ;;;; ************************************************************************* (in-package #:wol) (defun start-reaper () (process-run-function "wol-reaper" (lambda () (reap-sessions) (kmrcl::process-sleep *reap-interval*)))) (defun reap-sessions () (cmsg-c :debug "Reaping")) (defun make-new-session-id () (random-string :length 24 :set :lower-alphanumeric)) (defun ensure-websession (key req ent method) "Find or make websession for key" (let ((sessions (sessions (session-master (entity-project ent))))) ;; if sessions doesn't exist, then project is not session enabled (when session (cond ((null key) (make-websession req ent method)) (t (maphash (lambda (k v) (declare (ignore k)) (when (equal key (websession-key v)) (setf (websession-lastref v) (get-universal-time)) (return-from ensure-websession v))) sessions) (make-websession req ent method)))))) (defun make-websession (req ent method) (let* ((key (random-string :length 24 :set :lower-alphanumeric)) (sess (make-instance 'websession :key key :lastref (get-universal-time) :method method)) (hash (sessions (session-master (entity-project ent))))) (when hash (setf (gethash key hash) sess) (setf (websession-from-req req) sess) sess))) (defun compute-session (req ent) (awhen (and (request-plist req) (getf (request-plist req) :session-id)) (setf (websession-from-req req) (ensure-websession it req ent :uri))))