Changed request object to carry a reference to the connection object

instead of the stream, in our effort to reduce the passing around of
streams.  This is also necessary in order to allow request handlers to
check for the address and/or hostname of the connection the request
came in from.  Changed `parse-request' accordingly.  TODO: Rendering
of messages should probably change over, too.

Added handling of Authority request-header, and WWW-Authenticate
response-headers.  Changed order of response-header rendering to
follow RFC guidelines.  Added automatic generation of Server
response-header, added correct handling and automatic initialization
of Date response-header.  This should bring us closer to correct and
full handling of at least all HTTP/1.0 headers in responses.  Request
parsing of some headers remains to be done.

Added ignore declarations to quiet the compiler.
This commit is contained in:
2000-10-09 22:41:11 +00:00
parent c883fcadf6
commit 12cd9563f8

View File

@ -60,7 +60,7 @@ raised."))
;;;; Requests
(defclass request (http-message)
((stream :initarg :stream :reader request-stream)
((connection :initarg :connection :reader request-connection)
(method :initarg :method :reader request-method)
(url :initarg :url :reader request-url)))
@ -81,22 +81,23 @@ raised."))
args))
;;;; Request parsing framework
(defgeneric parse-request (server stream)
(defgeneric parse-request (server connection)
(:documentation
"Parse a request from the given stream, returning the created
request object, which references the given server."))
"Parse a request from the given connection, returning the created
request object, which references the given server and connection."))
(defmethod parse-request (server stream)
(defmethod parse-request (server connection)
(let ((stream (connection-stream connection)))
(multiple-value-bind (method url version)
(parse-request-line stream)
(let ((request (make-instance
(get-request-class-using-server server version)
:stream stream
:connection connection
:server server
:method method
:url url)))
(parse-request-remainder request stream)
request)))
request))))
(defun parse-request-line (stream)
"Parse a valid request-line from the stream, returning the method,
@ -274,7 +275,8 @@ is appended to the list of unprocessed headers."
(entity :initarg :entity :reader http-message-entity)))
(defmethod initialize-instance :after
((instance response/0.9) &rest initargs &allow-other-keys)
((instance response/0.9) &rest initargs &key &allow-other-keys)
(declare (ignorable initargs instance))
t)
(defmethod render-http-message ((message response/0.9) stream)
@ -313,7 +315,7 @@ used to call `reinitialize-instance'."))
(defmethod compute-request-initargs ((request request/1.0) headers)
(multiple-value-bind (initargs rest)
(process-http-headers (h v) headers
:authorization
(:authorization (parse-authority-string v))
:date
:from
:if-modified-since
@ -340,7 +342,7 @@ used to call `reinitialize-instance'."))
(let* ((headers (slot-value request 'entity-headers))
(length-cons (assoc "content-length" headers :test #'string-equal))
(length (and length-cons (parse-integer (cdr length-cons))))
(stream (request-stream request)))
(stream (connection-stream (request-connection request))))
(when length
(let ((buffer (make-string length)))
(do ((start 0))
@ -354,9 +356,11 @@ used to call `reinitialize-instance'."))
(defclass response/1.0 (response)
((version :allocation :class :initform (get-http-version 1 0)
:reader http-message-version)
(date :initarg :date :reader response-date)
(location :initarg :location :reader response-location)
(date :initarg :date :initform (get-universal-time) :reader response-date)
(pragma :initarg :pragma :reader response-pragma)
(location :initarg :location :reader response-location)
(www-authenticate :initarg :www-authenticate
:reader response-www-authenticate)
(set-cookie :initarg :set-cookie :reader response-set-cookie)
(entity :initarg :entity :reader http-message-entity)))
@ -367,11 +371,15 @@ used to call `reinitialize-instance'."))
(http-terpri stream)
(render-slots (message stream)
(date "Date"
(format stream "~A" date))
(location "Location"
(format stream "~A" location))
(write-string (rfc1123-format-time date) stream))
(pragma "Pragma"
(format stream "~{~A~^, ~:}" pragma))
(location "Location"
(format stream "~A" location))
(server "Server"
(format stream "~{~A~^ ~}" (server-product-info server)))
(www-authenticate "WWW-Authenticate"
(format stream "~:{~A realm=~S~@{,~A=~S~}~:^ , ~}" www-authenticate))
(set-cookie "Set-Cookie"
(format stream "~:{~A~@[=~A~]~^;~:}" set-cookie)))
(when (slot-boundp message 'entity)