1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: sessions.lisp
6 ;;;; Purpose: Session handler
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: July 2003
10 ;;;; $Id: sessions.lisp,v 1.1 2003/07/16 16:02:21 kevin Exp $
12 ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
13 ;;;; *************************************************************************
17 (defun start-reaper ()
18 (process-run-function "wol-reaper"
19 (lambda () (reap-sessions) (kmrcl::process-sleep *reap-interval*))))
21 (defun reap-sessions ()
22 (cmsg-c :debug "Reaping"))
24 (defun make-new-session-id ()
25 (random-string :length 24 :set :lower-alphanumeric))
27 (defun ensure-websession (key req ent method)
28 "Find or make websession for key"
29 (let ((sessions (sessions (session-master (entity-project ent)))))
30 ;; if sessions doesn't exist, then project is not session enabled
34 (make-websession req ent method))
39 (when (equal key (websession-key v))
40 (setf (websession-lastref v) (get-universal-time))
41 (return-from ensure-websession v)))
43 (make-websession req ent method))))))
46 (defun make-websession (req ent method)
47 (let* ((key (random-string :length 24 :set :lower-alphanumeric))
48 (sess (make-instance 'websession
50 :lastref (get-universal-time)
52 (hash (sessions (session-master (entity-project ent)))))
54 (setf (gethash key hash) sess)
55 (setf (websession-from-req req) sess)
58 (defun compute-session (req ent)
59 (awhen (and (request-plist req)
60 (getf (request-plist req) :session-id))
61 (setf (websession-from-req req)
62 (ensure-websession it req ent :uri))))