sessions.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          sessions.lisp
   6 ;;;; Purpose:       Session handler
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  July 2003
   9 ;;;;
  10 ;;;; $Id: sessions.lisp,v 1.1 2003/07/16 16:02:21 kevin Exp $
  11 ;;;;
  12 ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg
  13 ;;;; *************************************************************************
  14
  15 (in-package #:wol)
  16
  17 (defun start-reaper ()
  18   (process-run-function "wol-reaper"
  19     (lambda () (reap-sessions) (kmrcl::process-sleep *reap-interval*))))
  20
  21 (defun reap-sessions ()
  22   (cmsg-c :debug "Reaping"))
  23
  24 (defun make-new-session-id ()
  25   (random-string :length 24 :set :lower-alphanumeric))
  26
  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
  31     (when session
  32       (cond
  33        ((null key)
  34         (make-websession req ent method))
  35        (t
  36         (maphash
  37          (lambda (k v)
  38            (declare (ignore k))
  39            (when (equal key (websession-key v))
  40              (setf (websession-lastref v) (get-universal-time))
  41              (return-from ensure-websession v)))
  42          sessions)
  43         (make-websession req ent method))))))
  44
  45
  46 (defun make-websession (req ent method)
  47   (let* ((key (random-string :length 24 :set :lower-alphanumeric))
  48          (sess (make-instance 'websession
  49                  :key key
  50                  :lastref (get-universal-time)
  51                  :method method))
  52          (hash (sessions (session-master (entity-project ent)))))
  53     (when hash
  54       (setf (gethash key hash) sess)
  55       (setf (websession-from-req req) sess)
  56       sess)))
  57
  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))))