;;;; 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))))