[hunchentoot-devel] PATCH: Some minor fixes for cl-webdav under hunchentoot 1.0

[Matthew Curry]

Edi,

I took a look at it tonight anyway, and there where some obvious minor
fixes I spotted right away, attached is a patch that gets (using
cadaver) an initial connection, a put, and a get to work.  Just
functions that were renamed in the new hunchentoot.
Delete doesn't work, complains about a handler-done tag being unknown
(but thrown).  Here's the message log entry:
[2009-11-15 20:55:06 [ERROR]] attempt to THROW to a tag that does not
exist: HANDLER-DONE
I'm not too familiar with older versions of hunchentoot, does that
ring a bell for you?

I'll keep looking.

-Matt
-------------- next part --------------
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)))))