This is the first checked-in completely working version. It contains

nearly all concepts and simple implementations thereof needed to get a
simple HTTP/0.9 "compliant" server working (there are some hacks
needed that we don't yet provide, since the correct things will be
added shortly, like complete HTTP/1.1 request parsing.  The hacks
needed are provided as part of the basic HTTP/0.9 server demo in
src/test/basic-demo.cl).

Further work is needed to clean up some things, Entity and Resource
handling needs to be implemented right and less "naive" (the current
implementations are just simple place-holders to get things up and
running).  Connections need to have knowledge of client identity
(passed from the driver, this is implementation-specific stuff).
Logging needs to be implemented (probably as server mixins).
Condition handling needs to generate better responses for HTTP/0.9,
and the division between condition handling and normal handling needs
to be documented/rethought.  Content generation is totally missing
currently and needs to be implemented.  If this is all in place, an
HTTP/1.0 conforming server should be possible, and after porting the
drivers to ACL and LW, we can make a first release.

src/main/server.cl

@@ -0,0 +1,127 @@
+;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
+;;;; This is copyrighted software.  See documentation for terms.
+;;;; 
+;;;; server.cl --- Basic HTTP Server definition
+;;;; 
+;;;; Checkout Tag: $Name$
+;;;; $Id$
+
+(in-package :CLASH)
+
+;;;; %File Description:
+;;;; 
+;;;; 
+;;;; 
+
+(defclass http-server ()
+  ((namespace :initarg :namespace :accessor http-server-namespace)))
+
+(defgeneric serve-connection (server connection)
+  (:documentation
+   "Let the server serve the connection.  The
+server is responsible for closing the connection on return.  Methods
+on SERVE-CONNECTION may, but are not forced to, use the generic
+functions READ-REQUEST, SERVE-REQUEST and WRITE-RESPONSE to serve the
+connection.  Likewise the server is allowed and not forced to use the
+generic function handle-server-error to handle server errors."))
+
+(defgeneric read-request (server connection)
+  (:method :before (server connection)
+	   (declare (ignorable server))
+	   (setf (connection-state connection) :read-request))
+  (:method :after (server connection)
+	   (declare (ignorable server))
+	   (setf (connection-state connection) :processing-request))
+  (:documentation "Read a request from the connection."))
+
+(defgeneric serve-request (server request)
+  (:documentation
+   "Let the server handle the request, creating a valid response
+object that is to be returned."))
+
+(defgeneric create-response-using-server
+    (server request status-code &rest args)
+  (:documentation "Create an apropriate response object for server and
+request, using the detailed information provided by the resource, via
+CREATE-RESPONSE.  A server must implement apropriate methods for this
+generic function, to ensure conformant generation of response messages."))
+
+(defgeneric write-response (server connection response)
+  (:method :before (server connection response)
+	   (declare (ignorable server response))
+	   (setf (connection-state connection) :write-request))
+  (:method :after (server connection response)
+	   (declare (ignorable server response))
+	   (setf (connection-state connection) :idle))
+  (:documentation
+   "Forward the calculated response object to the connection."))
+
+(defgeneric handle-server-error (server connection condition)
+  (:documentation
+   "Handle the condition that occurred while server served the given
+connection."))
+
+(defmacro with-server-handler ((server connection) &body body)
+  (let ((server-sym (gensym))
+	(connection-sym (gensym)))
+    `(let ((,server-sym ,server)
+	   (,connection-sym ,connection))
+       (catch 'exit-connection
+	 (handler-bind ((error #'(lambda (condition)
+				   (handle-server-error
+				    ,server-sym
+				    ,connection-sym
+				    condition))))
+	   ,@body)))))
+
+(defclass http-server/0.9 (http-server)
+  ()
+  (:default-initargs :namespace (make-instance 'simple-namespace)))
+
+(defmethod serve-connection ((server http-server/0.9) connection)
+  (with-server-handler (server connection)
+    (let* ((request (read-request server connection))
+	   (response (serve-request server request)))
+      (write-response server connection response)))
+  (close-connection connection))
+
+(defmethod read-request ((server http-server/0.9) connection)
+  (parse-request server (connection-stream connection)))
+
+(defmethod serve-request ((server http-server/0.9) request)
+  (let ((resource (namespace-lookup-url (http-server-namespace server)
+					(request-url request))))
+    (unless resource
+      (error 'clash-error :code +HTTP-Code-Not-Found+))
+    (access-resource resource request)))
+
+(defmethod write-response ((server http-server/0.9) connection response)
+  (princ response (connection-stream connection)))
+
+(defmethod write-response :after ((server http-server/0.9) connection response)
+  (declare (ignorable server response))
+  (setf (connection-state connection) :finished))
+
+(defmethod create-response-using-server
+    ((server http-server/0.9) request status-code &rest args)
+  (apply #'make-instance
+	 (get-response-class (get-http-version 0 9))
+	 :server server
+	 :request request
+	 :status-code status-code
+	 args))
+
+(defmethod handle-server-error ((server http-server/0.9) connection condition)
+  (ignore-errors
+    (let ((response (make-instance
+		     'response/0.9
+		     :server server
+		     :status-code
+		     +HTTP-Code-Internal-Server-Error+
+		     :entity
+		     (make-instance 'simple-entity
+				    :body
+				    (format nil
+					    "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>500 Internal Server Error</TITLE>~%</HEAD>~%<BODY>~%<H1>Internal Server Error</H1>~%<P>An internal server error occured:</P>~%<PRE>~%~A~%</PRE>~%</BODY></HTML>" condition)))))
+      (write-response server connection response)))
+  (throw 'exit-connection nil))