X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=project.lisp;h=cf8c1910c44ddc516a34ec452a5151241d4d7fc0;hb=97e14ef9a350c61c9891c1d43aab815c574c1ce6;hp=d8a4d27d4fcbdc5105d7e6b5106c754972083d06;hpb=fe6fd1cd39dd145adb1c479cab619a2ce6d1c3eb;p=wol.git diff --git a/project.lisp b/project.lisp index d8a4d27..cf8c191 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$ ;;;; ;;;; 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) + :content-type (ml::format->string ,format) + :timeout ,timeout :response (case ,response-code (302 net.aserve::*response-moved-permanently*) @@ -350,7 +351,7 @@ ,result ,outstr ,stream) (declare (ignorable ,stream)) (write-header-line "Status" ,response-string) - (write-header-line "Content-Type" (ml::format-string ,fmt)) + (write-header-line "Content-Type" (ml::format->string ,fmt)) (dolist (,hdr ,headers) (write-header-line (car ,hdr) (cdr ,hdr))) (unless ,precomp