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:
@ -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)
|
||||
|
||||
Reference in New Issue
Block a user