-;;;; $Id: httpd.lisp,v 1.27 2012/09/19 06:08:24 mmondor Exp $
+;;;; $Id: httpd.lisp,v 1.28 2012/09/19 19:29:15 mmondor Exp $
#|
;;;; - Logging format customization
;;;; - Support standalone option which will use an embedded-compiled
;;;; configuration file and not allow the executable to load one
-;;;; - Support dynamic-only virtual-hosts (not needing a path for static
-;;;; files and not supporting static transfers)
+;;;; - For dynamic-only virtual-hosts, it'd be nice if some specific static
+;;;; files could be embedded as part of the executable to be served
+;;;; statically. This could be useful for self-contained applications
+;;;; which require some CSS or a small number of images, for instance.
+;;;; A utility could be provided to create byte vectors as a fasl under
+;;;; wanted symbols, and a hash table of path to vector could be filed by
+;;;; the configuration and used for lookup... The server-startup-time
+;;;; would be used as the modification timestamp for these "file" blobs.
+;;;; - Perhaps eventually support static linking of everything to ease
+;;;; deployment even more. This however might violate the LGPL license
+;;;; which ECL uses unless also distributing the HTTPd source, but this
+;;;; edition is already open-source, it could suffice to provide a link
+;;;; to this source as part of the documentation or logs.
(declaim (optimize (speed 3) (safety 1) (debug 3)))
(in-package :httpd)
(defparameter *rcsid*
- "$Id: httpd.lisp,v 1.27 2012/09/19 06:08:24 mmondor Exp $")
+ "$Id: httpd.lisp,v 1.28 2012/09/19 19:29:15 mmondor Exp $")
(defparameter *server-version*
(let ((parts (string-split *rcsid*
VIRTUAL: The virtual ROOT-based absolute fullpath, useful to report to
the user.
Note that the supplied ROOT should previously have been passed through
-PATH-VALID, and that both ROOT and PATH should be absolute paths."
+PATH-VALID, and that both ROOT and PATH should be absolute paths.
+The exception is if ROOT is NIL, in which case REAL will also be NIL,
+for virtual hosts without static content."
(let* ((virtual (path-valid (concatenate 'string "/" path)))
- (real (if virtual (path-valid (concatenate 'string
- "/" root "/" virtual))
- nil)))
- (if (and virtual real)
+ (real (if (null root)
+ nil
+ (if virtual (path-valid
+ (concatenate 'string
+ "/" root "/" virtual))
+ nil))))
+ (if (and virtual (or real (null root)))
(make-path :real real
:virtual virtual)
nil)))
(defstruct vhost
"Structure to configure/describe a virtual host."
(hostname "" :type string :read-only t)
- (root "/" :type string)
+ ;; If ROOT is NIL this VHOST only supports dynamic handlers, no files.
+ (root nil :type (or null string))
(index "/index.html" :type string)
(charset :utf-8 :type keyword)
(autoindex nil :type boolean)
(with-accessors ((name vhost-hostname)
(root vhost-root)
(index vhost-index)) vhost
- (unless (path-valid root)
- (error "Invalid root path \"~A\"" root))
+ (when root
+ (unless (path-valid root)
+ (error "Invalid root path \"~A\"" root)))
(unless (path-valid index)
(error "Invalid index path \"~A\"" index))
(mp:with-lock (*vhosts-lock*)
(t
nil))))))
+(declaim (inline vhost-path))
(defun vhost-path (vhost path)
"Validates user-supplied PATH for VHOST, and returns a PATH object if
-valid, or NIL. See PATH-VALID-VIRTUAL."
+valid, or NIL. See PATH-VALID-VIRTUAL for more details."
(path-valid-virtual (vhost-root vhost) path))
;;; VHost dynamic handlers
;; Prioritize any existing dynamic handler over static
(unless (http-dynamic-dispatch req connection path)
- (http-static-dispatch req connection path)))))
+ (if (path-real path)
+ (http-static-dispatch req connection path)
+ (http-error stream 404 "Not Found"
+ "\"~A\" could not be found."
+ (path-virtual path)))))))
(http-reply-signal-no-keepalive ()
(loop-finish))
Repositories / mmondor.git / commitdiff