From: Kevin M. Rosenberg Date: Sun, 10 Aug 2003 17:56:44 +0000 (+0000) Subject: r5489: *** empty log message *** X-Git-Url: http://git.kpe.io/?p=wol.git;a=commitdiff_plain;h=ca586910648f4844e335d92f23e619fd2b84f969 r5489: *** empty log message *** --- diff --git a/classes.lisp b/classes.lisp index 2a49ec1..766fce0 100644 --- a/classes.lisp +++ b/classes.lisp @@ -1,4 +1,4 @@ -x;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*- +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -7,7 +7,7 @@ x;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*- ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2003 ;;;; -;;;; $Id: classes.lisp,v 1.7 2003/08/10 07:38:37 kevin Exp $ +;;;; $Id: classes.lisp,v 1.8 2003/08/10 17:56:44 kevin Exp $ ;;;; ;;;; This file and Wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -70,9 +70,10 @@ x;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: wol -*- (posted-content :initarg :posted-content :accessor request-posted-content) (headers :initarg :headers :accessor request-headers) (page :initarg :page :initform nil :accessor request-page) + (url-plist :initarg :url-plist :initform nil :accessor request-url-plist) (plist :initarg :plist :initform nil :accessor request-plist) - (next-plists :initarg :next-plists :initform nil - :accessor request-next-plists) + (url-next-plists :initarg :url-next-plists :initform nil + :accessor request-url-next-plists) (uri-query :initarg :uri-query :initform nil :accessor request-uri-query) (query-alist :initarg :query-alist :initform nil diff --git a/log.lisp b/log.lisp index 3793720..4a8cde2 100644 --- a/log.lisp +++ b/log.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2003 ;;;; -;;;; $Id: log.lisp,v 1.1 2003/07/16 16:40:35 kevin Exp $ +;;;; $Id: log.lisp,v 1.2 2003/08/10 17:56:44 kevin Exp $ ;;;; ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -15,4 +15,5 @@ (in-package #:wol) (defun add-log-entry (project fmt &rest args) + (declare (ignore project)) (apply #'cmsg fmt args)) diff --git a/package.lisp b/package.lisp index c13e9a1..9f2014c 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: April 2001 ;;;; -;;;; $Id: package.lisp,v 1.4 2003/08/10 05:16:52 kevin Exp $ +;;;; $Id: package.lisp,v 1.5 2003/08/10 17:56:44 kevin Exp $ ;;;; ;;;; This file and wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -27,13 +27,13 @@ #:websession-data #:websession-variable #:websession-key - #:request-plist + #:request-url-plist + #:request-url-next-plists #:request-posted-content #:request-raw-uri ;; projects.lisp #:wol-project - #:stop-wol-project #:header-slot-value #:request-query #:request-query-value diff --git a/project.lisp b/project.lisp index d8a4d27..a6a00fe 100644 --- a/project.lisp +++ b/project.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2003 ;;;; -;;;; $Id: project.lisp,v 1.12 2003/08/10 07:38:37 kevin Exp $ +;;;; $Id: project.lisp,v 1.13 2003/08/10 17:56:44 kevin Exp $ ;;;; ;;;; This file and Wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -15,9 +15,10 @@ (in-package #:wol) (defun wol-project (name &key (project-prefix "/") map index - (sessions t) (session-lifetime 18000) - (reap-interval 300) server - (connector :modlisp)) + (sessions t) (session-lifetime 18000) + (reap-interval 300) server + (connector :modlisp) + timeout) (unless server (setq server (ecase connector @@ -53,7 +54,8 @@ (:aserve (net.aserve:publish-prefix :prefix project-prefix :server server - :function 'wol-aserve-processor))) + :function 'wol-aserve-processor + :timeout timeout))) (if sessions (when (null (sessions (session-master project))) @@ -66,9 +68,6 @@ (when (and sessions (null *reaper-process*)) (setq *reaper-process* (start-reaper))))) -(defun stop-wol-project (name) - (remhash name *active-projects*)) - (defun wol-ml-processor (command) "Processes an incoming modlisp command" (let* ((req (command->request command @@ -303,13 +302,15 @@ (defmacro with-wol-page ((req ent &key (format :html) (precompute t) headers - (response-code 200)) + (response-code 200) + timeout) &body body) `(if (request-aserve-server ,req) (net.aserve:with-http-response ((aserve-request ,req) (entity-aserve-entity ,ent) :content-type (ml::format-string ,format) + :timeout ,timeout :response (case ,response-code (302 net.aserve::*response-moved-permanently*) diff --git a/tests.lisp b/tests.lisp index 6fceef8..c2f91ea 100644 --- a/tests.lisp +++ b/tests.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Id: $Id: tests.lisp,v 1.2 2003/08/10 05:16:52 kevin Exp $ +;;;; Id: $Id: tests.lisp,v 1.3 2003/08/10 17:56:44 kevin Exp $ ;;;; Purpose: Self Test suite for WOL ;;;; ;;;; ************************************************************************* @@ -88,8 +88,8 @@ (defmethod tear-down ((self test-server)) - (net.aserve:shutdown :server (wserver self)) - (stop-wol-project (name self))) + (net.aserve:shutdown :server (wserver self))) + (def-test-method test-server-index ((self test-server) :run nil) (multiple-value-bind (body response-code headers uri) @@ -171,9 +171,7 @@ (defmethod tear-down ((self test-two-projects)) - (net.aserve:shutdown :server (wserver self)) - (stop-wol-project (name1 self)) - (stop-wol-project (name2 self))) + (net.aserve:shutdown :server (wserver self))) (def-test-method test-two-project-index ((self test-two-projects) :run nil) (multiple-value-bind (body response-code headers uri) @@ -221,8 +219,7 @@ (defmethod tear-down ((self test-sessions)) - (net.aserve:shutdown :server (wserver self)) - (stop-wol-project (name self))) + (net.aserve:shutdown :server (wserver self))) (defun test-sessions-index (req ent) (let ((session (websession-from-req req))) @@ -278,8 +275,7 @@ )))) (defmethod tear-down ((self test-no-sessions)) - (net.aserve:shutdown :server (wserver self)) - (stop-wol-project (name self))) + (net.aserve:shutdown :server (wserver self))) (def-test-method test-no-sessions ((self test-no-sessions) :run nil) (multiple-value-bind (body response-code headers uri) diff --git a/uri.lisp b/uri.lisp index 4fe67dd..76eab37 100644 --- a/uri.lisp +++ b/uri.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2003 ;;;; -;;;; $Id: uri.lisp,v 1.9 2003/08/10 07:38:37 kevin Exp $ +;;;; $Id: uri.lisp,v 1.10 2003/08/10 17:56:44 kevin Exp $ ;;;; ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg ;;;; ************************************************************************* @@ -57,10 +57,10 @@ (when page (setf (request-page req) (base-page-name page ent))) (when plists - (setf (request-plist req) (car plists)) - (setf (request-next-plists req) (cdr plists)) + (setf (request-url-plist req) (car plists)) + (setf (request-url-next-plists req) (cdr plists)) (when (null page) - (awhen (getf (request-plist req) :page) + (awhen (getf (request-url-plist req) :page) (setf (request-page req) it)))) (setf (request-uri-query req) query)))) diff --git a/wol.asd b/wol.asd index e4ab748..21f671e 100644 --- a/wol.asd +++ b/wol.asd @@ -7,14 +7,15 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2003 ;;;; -;;;; $Id: wol.asd,v 1.7 2003/08/10 05:16:52 kevin Exp $ +;;;; $Id: wol.asd,v 1.8 2003/08/10 17:56:44 kevin Exp $ ;;;; ;;;; This file and Wol are Copyright (c) 2003 by Kevin M. Rosenberg ;;;; ************************************************************************* (in-package #:cl-user) -#+(or cmu lispworks (and allegro (not common-lisp-controller))) (require :aserve) +#+(or cmu lispworks sbcl openmcl + (and allegro (not common-lisp-controller))) (require :aserve) #+(and allegro common-lisp-controller) (c-l-c::original-require :aserve) #+allegro (require :smtp) #+allegro (require :phtml)