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/messages.cl

@@ -0,0 +1,175 @@
+;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
+;;;; This is copyrighted software.  See documentation for terms.
+;;;; 
+;;;; messages.cl --- HTTP Request and Response messages
+;;;; 
+;;;; Checkout Tag: $Name$
+;;;; $Id$
+
+(in-package :CLASH)
+
+;;;; %File Description:
+;;;; 
+;;;; 
+;;;; 
+
+(defclass http-message ()
+  ((server :initarg :server :reader http-message-server
+	   :documentation "The server this message belongs to.")))
+
+(defgeneric http-message-version (message)
+  (:documentation "Returns the HTTP-Version of the given message."))
+
+(defgeneric render-http-message (message stream)
+  (:documentation "Render the given message on the stream."))
+
+(defmethod print-object ((object http-message) stream)
+  (if (or *print-readably* *print-escape*)
+      (call-next-method)
+      (render-http-message object stream)))
+
+;;;; Requests
+
+(defclass request (http-message)
+  ((method :initarg :method :reader request-method)
+   (url :initarg :url :reader request-url)))
+
+;;;; Responses
+
+(defclass response (http-message)
+  ((request :initarg :request :reader response-request)
+   (status-code :initarg :status-code :reader response-status-code)
+   (general-headers :initarg :general-headers
+		    :reader response-general-headers)
+   (response-headers :initarg :response-headers
+		     :reader response-response-headers)
+   (entity :initarg :entity :reader response-entity)))
+
+;;;; Mapping between http-versions and request/response objects
+(defgeneric get-request-class (version)
+  (:documentation
+   "Return the Request class corresponding to the given version, which
+is either a http-version object, or nil, if no http-version was
+supplied in the request."))
+
+(defgeneric get-response-class (version)
+  (:documentation
+   "Return the Response class corresponding to the given version."))
+
+;;;; Creating responses for requests:
+(defgeneric create-response (request status-code &rest args))
+
+(defmethod create-response ((request request) status-code &rest args)
+  (apply #'create-response-using-server
+	 (http-message-server request)
+	 request
+	 status-code
+	 args))
+
+;;;; Request parsing framework
+(defgeneric parse-request (server stream)
+  (:documentation
+   "Parse a request from the given stream, returning the created
+request object, which references the given server."))
+
+(defmethod parse-request (server stream)
+  (multiple-value-bind (method url version)
+      (parse-request-line stream)
+    (let ((request (make-instance (get-request-class version)
+				  :server server
+				  :method method
+				  :url url)))
+      (parse-request-remainder request stream)
+      request)))
+
+(defun parse-request-line (stream)
+  "Parse a valid request-line from the stream, returning the method,
+url and http-version as a result."
+  (let ((request-line
+	 (loop for line = (read-http-line stream)
+	       while (and line (zerop (length line)))
+	       finally
+	       (if line
+		   (return line)
+		   (error 'simple-clash-error
+			  :code +HTTP-Code-Bad-Request+
+			  :format-control "Got no valid request-line.")))))
+    (flet ((report-error (fmt &rest args)
+	     (error 'simple-clash-error
+		    :code +HTTP-Code-Bad-Request+
+		    :format-control "~? in Request ~S."
+		    :format-arguments (list fmt args request-line))))
+      (loop with method-end = nil
+	    with url-end = nil
+	    with state = :in-method
+	    for pos from 0 below (length request-line)
+	    for char = (char request-line pos)
+	    do
+	    (case state
+	      (:in-method
+	       (when (char= char #\Space)
+		 (setq method-end pos
+		       state :in-method-delimiter)))
+	      (:in-method-delimiter
+	       (setq state :in-url))
+	      (:in-url
+	       (when (char= char #\Space)
+		 (setq url-end pos
+		       state :in-url-delimiter)))
+	      (:in-url-delimiter
+	       (setq state :in-http-version))
+	      (:in-http-version
+	       (unless (find char "HTP/0123456789.")
+		 (report-error "Strange HTTP-Version field"))))
+	    finally
+	    (case state
+	      ((:in-method :in-method-delimiter)
+	       (report-error "No Request-URI"))
+	      (:in-url-delimiter
+	       (report-error "No HTTP-Version in a non-simple Request"))
+	      ((:in-url :in-http-version)
+	       (return
+		 (values (get-method-symbol (subseq request-line 0 method-end))
+			 (parse-url-from-string
+			  (subseq request-line (1+ method-end) url-end))
+			 (if url-end
+			     (parse-http-version
+			      (subseq request-line (1+ url-end)))
+			     nil)))))))))
+
+(defgeneric parse-request-remainder (request stream)
+  (:documentation
+   "Parse the remainder of the request from the given stream, and
+validate the whole request, including method and url."))
+
+;;;; HTTP/0.9
+
+(defclass request/0.9 (request)
+  ((version :allocation :class :initform (get-http-version 0 9)
+	    :reader http-message-version)))
+
+(defmethod get-request-class ((version (eql nil)))
+  (find-class 'request/0.9))
+
+(defmethod get-request-class ((version (eql (get-http-version 0 9))))
+  (find-class 'request/0.9))
+
+(defmethod parse-request-remainder ((request request/0.9) stream)
+  (declare (ignore stream))
+  (unless (eq (request-method request) :GET)
+    (error 'simple-clash-error
+	   :code +HTTP-Code-Bad-Request+
+	   :format-control
+	   "Bad Request Method ~A for the request's HTTP-Version ~A."
+	   :format-arguments (list (request-method request)
+				   (http-message-version request))))
+  t)
+
+(defclass response/0.9 (response)
+  ((entity :initarg :entity :reader http-message-entity)))
+
+(defmethod get-response-class ((version (eql (get-http-version 0 9))))
+  (find-class 'response/0.9))
+
+(defmethod render-http-message ((message response/0.9) stream)
+  (render-entity-body (http-message-entity message) stream))