From 12cd9563f8457d261fef1d8462dc4c140ca45aac Mon Sep 17 00:00:00 2001 From: "Pierre R. Mai" Date: Mon, 9 Oct 2000 22:41:11 +0000 Subject: [PATCH] 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. --- src/main/messages.cl | 54 +++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/src/main/messages.cl b/src/main/messages.cl index 7b3874c..2f90b92 100644 --- a/src/main/messages.cl +++ b/src/main/messages.cl @@ -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) - (multiple-value-bind (method url version) - (parse-request-line stream) - (let ((request (make-instance - (get-request-class-using-server server version) - :stream stream - :server server - :method method - :url url))) - (parse-request-remainder request stream) - request))) +(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) + :connection connection + :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, @@ -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)