Index: resources.lisp =================================================================== --- resources.lisp (revision 4468) +++ resources.lisp (working copy) @@ -204,9 +204,9 @@ method if you're sitting behind a proxy.") (:method (resource) (format nil "http~:[~;s~]://~A~@[:~A~]/" - (ssl-p) - (ppcre:regex-replace ":\\d+$" (host) "") - (server-port)))) + (acceptor-ssl-p *acceptor*) + (ppcre:regex-replace ":\\d+$" (acceptor-address *acceptor*) "") + (acceptor-port *acceptor*)))) (defgeneric get-dead-properties (resource) (:documentation "This function must return all dead properties @@ -399,9 +399,9 @@ "Utility function which sets up Hunchentoot's *REPLY* object for a +HTTP-CREATED+ response corresponding to the newly-created resource RESOURCE." - (setf (content-type) (get-content-type resource) + (setf (content-type*) (get-content-type resource) (header-out :location) (resource-script-name resource) - (return-code) +http-created+) + (return-code*) +http-created+) (let ((etag (resource-etag resource)) (content-language (resource-content-language resource))) (when etag Index: handlers.lisp =================================================================== --- handlers.lisp (revision 4468) +++ handlers.lisp (working copy) @@ -102,8 +102,8 @@ (not-found)) (multiple-value-bind (properties propname) (parse-propfind (raw-post-data :force-binary t)) - (setf (content-type) "text/xml; charset=utf-8" - (return-code) +http-multi-status+) + (setf (content-type*) "text/xml; charset=utf-8" + (return-code*) +http-multi-status+) (let ((result ;; loop through the resource and its descendants until ;; depth limit is reached @@ -145,8 +145,8 @@ (push (cons +http-conflict+ property) results)) (t (funcall property-handler resource property) (push (cons +http-ok+ property) results)))))) - (setf (content-type) "text/xml; charset=utf-8" - (return-code) +http-multi-status+) + (setf (content-type*) "text/xml; charset=utf-8" + (return-code*) +http-multi-status+) (serialize-xmls-node (dav-node "multistatus" (apply #'dav-node "response" @@ -169,7 +169,7 @@ (let ((etag (resource-etag resource)) (write-date (resource-write-date resource)) (content-language (resource-content-language resource))) - (setf (content-type) (resource-content-type resource)) + (setf (content-type*) (resource-content-type resource)) (when etag (setf (header-out :etag) etag)) (when content-language @@ -177,11 +177,11 @@ (catch 'handler-done (handle-if-modified-since write-date) (when (equal etag (header-in* :if-none-match)) - (setf (return-code) +http-not-modified+))) - (when (eql (return-code) +http-not-modified+) + (setf (return-code*) +http-not-modified+))) + (when (eql (return-code*) +http-not-modified+) (throw 'handler-done nil)) (setf (header-out :last-modified) (rfc-1123-date write-date) - (content-length) (resource-length resource)) + (content-length*) (resource-length resource)) (unless head-request-p (send-content resource (send-headers)))))) @@ -198,10 +198,10 @@ response will be generated and DEFAULT-RETURN-CODE will be used instead." (unless results - (setf (return-code) default-return-code) + (setf (return-code*) default-return-code) (throw 'handler-done nil)) - (setf (content-type) "text/xml; charset=utf-8" - (return-code) +http-multi-status+) + (setf (content-type*) "text/xml; charset=utf-8" + (return-code*) +http-multi-status+) ;; use a hash table to group by status code (let ((status-hash (make-hash-table))) (loop for (status . resource) in results @@ -297,8 +297,8 @@ (failed-dependency))) (let ((results (copy-or-move-resource* source destination movep depth-value))) (cond (results (multi-status results)) - (destination-exists (setf (return-code) +http-no-content+ - (content-type) nil) + (destination-exists (setf (return-code*) +http-no-content+ + (content-type*) nil) nil) (t (resource-created destination)))))))) @@ -324,7 +324,7 @@ (error (condition) (warn "While trying to create collection ~S: ~A" (resource-script-name resource) condition) - (setf (return-code) +http-internal-server-error+)) + (setf (return-code*) +http-internal-server-error+)) (:no-error (&rest args) (declare (ignore args)) - (resource-created resource))))) \ No newline at end of file + (resource-created resource)))))