Pierre R. Mai
e1c4504ede
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.
127 lines
4.8 KiB
Common Lisp
127 lines
4.8 KiB
Common Lisp
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
|
|
;;;; This is copyrighted software. See documentation for terms.
|
|
;;;;
|
|
;;;; version.cl --- HTTP-Version handling
|
|
;;;;
|
|
;;;; Checkout Tag: $Name$
|
|
;;;; $Id$
|
|
|
|
(in-package :CLASH)
|
|
|
|
;;;; %File Description:
|
|
;;;;
|
|
;;;;
|
|
;;;;
|
|
|
|
;;;; Some typedef for version numbers
|
|
(deftype http-version-number-type ()
|
|
"Type for HTTP-Version major and minor version numbers."
|
|
`(integer 0 ,most-positive-fixnum))
|
|
|
|
(defstruct (http-version (:print-function print-http-version))
|
|
(major 0 :read-only t :type http-version-number-type)
|
|
(minor 0 :read-only t :type http-version-number-type))
|
|
|
|
;;; http-version objects are interned here, so that at most one
|
|
;;; version object for each version will ever be present in the
|
|
;;; system. This saves space and makes keying of the http-version
|
|
;;; by EQL tractable, which is quite useful.
|
|
|
|
(defvar *interned-http-version-hash*
|
|
(make-hash-table :test #'equal))
|
|
|
|
(defun get-http-version (major minor)
|
|
"Get the http-version object corresponding to major and minor
|
|
version numbers. This will retrieve any interned http-version for
|
|
those numbers, or create, intern and return a new http-version
|
|
object."
|
|
(check-type major http-version-number-type)
|
|
(check-type minor http-version-number-type)
|
|
(let* ((version-string (format nil "HTTP/~D.~D" major minor))
|
|
(http-version (gethash version-string
|
|
*interned-http-version-hash* nil)))
|
|
(or http-version
|
|
(setf (gethash version-string *interned-http-version-hash*)
|
|
(make-http-version :major major :minor minor)))))
|
|
|
|
(defun parse-http-version (string)
|
|
"Parse the HTTP-Version string given, returning the HTTP-VERSION
|
|
structure representing that version. If parsing fails, signals a
|
|
clash-error indicating so. The recognized syntax as per RFC 2068:
|
|
|
|
The version of an HTTP message is indicated by an HTTP-Version field
|
|
in the first line of the message.
|
|
|
|
HTTP-Version = \"HTTP\" \"/\" 1*DIGIT \".\" 1*DIGIT
|
|
|
|
Note that the major and minor numbers MUST be treated as separate
|
|
integers and that each may be incremented higher than a single digit.
|
|
Thus, HTTP/2.4 is a lower version than HTTP/2.13, which in turn is
|
|
lower than HTTP/12.3. Leading zeros MUST be ignored by recipients and
|
|
MUST NOT be sent."
|
|
(flet ((report-error ()
|
|
(error 'simple-clash-error
|
|
:code +HTTP-Code-Bad-Request+
|
|
:format-control "Bad HTTP-Version string ~S."
|
|
:format-arguments (list string))))
|
|
;; Try looking up the http-version object if it exists already
|
|
(let ((http-version (gethash string *interned-http-version-hash* nil)))
|
|
(when http-version
|
|
;; We got one, so this is obviously a correct version string,
|
|
;; so we can just return the corresponding http-version object.
|
|
(return-from parse-http-version http-version)))
|
|
|
|
;; Look-Up failed, so we have to do it the hard way by parsing.
|
|
(unless (and (>= (length string) 8)
|
|
(string= string "HTTP/" :end1 5)
|
|
(digit-char-p (char string 5)))
|
|
(report-error))
|
|
(multiple-value-bind (major rest-pos)
|
|
(parse-integer string :start 5 :junk-allowed t)
|
|
(unless (and major
|
|
(> rest-pos 5)
|
|
(<= rest-pos (- (length string) 2))
|
|
(char= (char string rest-pos) #\.)
|
|
(digit-char-p (char string (1+ rest-pos))))
|
|
(report-error))
|
|
(multiple-value-bind (minor final-pos)
|
|
(parse-integer string :start (1+ rest-pos) :junk-allowed t)
|
|
(unless (and minor (= final-pos (length string)))
|
|
(report-error))
|
|
;; Parsed successfully, construct, intern and return the
|
|
;; corresponding http-version object:
|
|
(setf (gethash string *interned-http-version-hash*)
|
|
(make-http-version :major major :minor minor))))))
|
|
|
|
(defun format-http-version (version-object)
|
|
"Format the given major and minor versions into a HTTP-Version string, as described by RFC 2068, and as recognized by `PARSE-HTTP-VERSION':
|
|
|
|
The version of an HTTP message is indicated by an HTTP-Version field
|
|
in the first line of the message.
|
|
|
|
HTTP-Version = \"HTTP\" \"/\" 1*DIGIT \".\" 1*DIGIT
|
|
|
|
Note that the major and minor numbers MUST be treated as separate
|
|
integers and that each may be incremented higher than a single digit.
|
|
Thus, HTTP/2.4 is a lower version than HTTP/2.13, which in turn is
|
|
lower than HTTP/12.3. Leading zeros MUST be ignored by recipients and
|
|
MUST NOT be sent."
|
|
(format nil "HTTP/~D.~D"
|
|
(http-version-major version-object)
|
|
(http-version-minor version-object)))
|
|
|
|
(defun print-http-version (object stream depth)
|
|
(declare (ignore depth))
|
|
(cond
|
|
((or *print-readably* *print-escape*)
|
|
(if *read-eval*
|
|
(format stream "#.(get-http-version ~D ~D)"
|
|
(http-version-major object)
|
|
(http-version-minor object))
|
|
(print-unreadable-object (object stream :type t)
|
|
(format stream "~D.~D"
|
|
(http-version-major object)
|
|
(http-version-minor object)))))
|
|
(t
|
|
(write-string (format-http-version object) stream))))
|