;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: July 2003
;;;;
-;;;; $Id: project.lisp,v 1.5 2003/07/23 23:08:28 kevin Exp $
+;;;; $Id: project.lisp,v 1.6 2003/08/05 23:00:28 kevin Exp $
;;;;
;;;; This file and Wol are Copyright (c) 2001-2003 by Kevin M. Rosenberg
;;;; *************************************************************************
(sessions t) (session-lifetime 18000)
(reap-interval 300) server
(connector :modlisp))
-
(unless server
(setq server
(ecase connector
(let ((req
(make-instance 'http-request
:host (header-value command :host)
- :raw-uri (puri:intern-uri (header-value command :url))
- :uri (puri:intern-uri (command->uri command))
+ :raw-uri (aif (ignore-errors
+ (puri:intern-uri (header-value command :url)))
+ it
+ (header-value command :url))
+ :uri (aif (ignore-errors
+ (puri:intern-uri (command->uri command)))
+ it
+ (command->uri command))
:protocol (ensure-keyword
(header-value command :server-protocol))
:protocol-string (header-value command :server-protocol)
(defun command->uri (command)
(format nil "http://~A:~D~A"
(header-value command :host)
- (awhen (header-value
- command :server-ip-port)
- (parse-integer it))
+ (header-value command :server-ip-port)
(header-value command :url)))
(defun is-index-request (req ent)
(format nil "~{~D~^.~}" *wol-version*))
(defun request-query (req &key (uri t) (post t))
- (append
- (when (and uri (request-uri-query req))
- (aif (request-query-alist req)
- it
- (setf (request-query-alist req)
- (query-to-alist (request-uri-query req)))))
- (when (and post (request-posted-content req))
- (query-to-alist (request-posted-content req)))))
+ (let ((desired (cons uri post)))
+ (if (equal desired (request-desired-query req))
+ ;; Same desired as cached
+ (request-query-alist req)
+ (progn
+ (setf (request-desired-query req) desired)
+ (setf (request-query-alist req)
+ (append
+ (when (and uri (request-uri-query req))
+ (query-to-alist (request-uri-query req)))
+ (when (and post (request-posted-content req))
+ (query-to-alist (request-posted-content req)))))))))
(defun request-query-value (key req &key (uri t) (post t))
(cdr (assoc key (request-query req :uri uri :post post)
(defmacro with-wol-page ((req ent
&key (format :html) (precompute t) headers)
&body body)
+ (declare (ignore req ent))
(let ((fmt (gensym "FMT-"))
(precomp (gensym "PRE-"))
(result (gensym "RES-"))