[hunchentoot-devel] cl-webdav errors
Cyrus Harmon
ch-tbnl at bobobeach.com
Tue Jun 24 05:05:31 UTC 2008
The following patch (along with the patch from the pervious email)
fixes the error I was seeing before:
diff --git a/handlers.lisp b/handlers.lisp
index 8f00ea6..ccc25b7 100755
--- a/handlers.lisp
+++ b/handlers.lisp
@@ -78,8 +78,7 @@ is needed to work around problems with some
Microsoft DAV clients.")
(defun options-handler ()
"The handler for OPTIONS requests. Output is basically
determined by *ALLOWED-METHODS* and *DAV-COMPLIANCE-CLASSES*."
- (setf (content-type) nil
- (header-out :allow) (format nil "~{~A~^, ~}" *allowed-methods*)
+ (setf (header-out :allow) (format nil "~{~A~^, ~}" *allowed-methods*)
(header-out :dav) (format nil "~{~D~^,~}" *dav-compliance-
classes*)
;; Win2k wants this - sigh...
(header-out :ms-author-via) "DAV")
This gets cl-webdav (at least for the trivial stuff I tried) working
again on the new hunchentoot code.
Cyrus
On Jun 23, 2008, at 4:47 PM, Cyrus Harmon wrote:
>
> Now I get the following:
>
> [2008-06-23 16:38:23 [ERROR]] The value of HUNCHENTOOT::NEW-VALUE is
> NIL, which is not of type STRING.
> 0: (SB-DEBUG::MAP-BACKTRACE #<CLOSURE (LAMBDA #) {11DC2185}>)
> [:EXTERNAL]
> 1: (BACKTRACE 536870911 #<SB-IMPL::STRING-OUTPUT-STREAM {11DC2121}>)
> 2: (HUNCHENTOOT:GET-BACKTRACE #<unavailable argument>)
> 3: ((FLET #:LAMBDA452) #<SIMPLE-TYPE-ERROR {11DC1DA9}>)
> 4: (SIGNAL #<SIMPLE-TYPE-ERROR {11DC1DA9}>)[:EXTERNAL]
> 5: (ERROR #<SIMPLE-TYPE-ERROR {11DC1DA9}>)[:EXTERNAL]
> 6: (SB-KERNEL:CHECK-TYPE-ERROR HUNCHENTOOT::NEW-VALUE NIL STRING NIL)
> 7: ((SB-PCL::FAST-METHOD (SETF HUNCHENTOOT:HEADER-OUT) :AFTER
> (T (EQL :CONTENT-TYPE)))
> #<unused argument>
> #<unused argument>
> #<unavailable argument>
> #<unused argument>
> #<HUNCHENTOOT::REPLY {11DBEDC1}>)
> 8: ((LAMBDA
> (SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. SB-PCL::.ARG0. SB-
> PCL::.ARG1.
> SB-INT:&MORE SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-
> COUNT.))
> #<unused argument>
> #<unused argument>
> NIL
> :CONTENT-TYPE
> 32810581
> 1)
> 9: (CL-WEBDAV:OPTIONS-HANDLER)
> 10: ((LAMBDA ()))
> 11: (HUNCHENTOOT::PROCESS-REQUEST #<HUNCHENTOOT:REQUEST {11DC1AA9}>)
> 12: ((SB-PCL::FAST-METHOD HUNCHENTOOT::PROCESS-CONNECTION (T T))
> #<unavailable argument>
> #<unavailable argument>
> #<HUNCHENTOOT::SERVER (host *, port 4242)>
> #<USOCKET:STREAM-USOCKET {11DB9CA1}>)
> 13: ((SB-PCL::FAST-METHOD HUNCHENTOOT::PROCESS-CONNECTION :AROUND (T
> T))
> #<unavailable argument>
> #S(SB-PCL::FAST-METHOD-CALL
> :FUNCTION #<FUNCTION #>
> :PV NIL
> :NEXT-METHOD-CALL NIL
> :ARG-INFO (2))
> #<HUNCHENTOOT::SERVER (host *, port 4242)>
> #<USOCKET:STREAM-USOCKET {11DB9CA1}>)
> 14: ((FLET SB-THREAD::WITH-MUTEX-THUNK))
> 15: ((FLET #:WITHOUT-INTERRUPTS-BODY-[CALL-WITH-MUTEX]479))
> 16: (SB-THREAD::CALL-WITH-MUTEX
> #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK) {7D29DA5}>
> #S(SB-THREAD:MUTEX
> :NAME "thread result lock"
> :%OWNER #<SB-THREAD:THREAD "Hunchentoot worker (client:
> 127.0.0.1:59658)" RUNNING {11DBCE49}>
> :LUTEX #<unknown pointer object, widetag=#x5E {11DBCE17}>)
> #<SB-THREAD:THREAD "Hunchentoot worker (client:
> 127.0.0.1:59658)" RUNNING {11DBCE49}>
> T)
> 17: ((LAMBDA ()))
> 18: ("foreign function: call_into_lisp")
> 19: ("foreign function: funcall0")
> 20: ("foreign function: new_thread_trampoline")
> 21: ("foreign function: _pthread_start")
> 22: ("foreign function: thread_start")
>
>
> still digging...
>
> Cyrus
>
> On Jun 23, 2008, at 4:36 PM, Cyrus Harmon wrote:
>
>>
>> On Jun 23, 2008, at 4:16 PM, Edi Weitz wrote:
>>
>>> On Mon, 23 Jun 2008 15:50:27 -0700, Cyrus Harmon <ch-tbnl at bobobeach.com
>>> > wrote:
>>>
>>>> I'm getting some errors attempting to build the latest cl-webdav
>>>> with the latest ediware/sbcl combo.
>>>
>>> Yes, that's to be expected. I haven't looked at cl-webdav in the
>>> last
>>> months.
>>
>> Hmm... ok.
>>
>>>> are we attempting to do something out of the CL spec here or is
>>>> SBCL
>>>> choking on legal code?
>>>
>>> I think SBCL is right. (CONSTANTLY NIL) should be replaced by the
>>> name of a function which does the same.
>>
>> Alright, I'm taking a stab at getting this to work then. It sort
>> builds now, but doesn't work.
>>
>> In an effort to figure out why not, I've discovered that
>> tbnl:*catch-errors-p* is still exported but doesn't exist anymore.
>>
>>
>> Here's my first cut at things:
>>
>>
>> diff --git a/handlers.lisp b/handlers.lisp
>> index 8f00ea6..2facb08 100755
>> --- a/handlers.lisp
>> +++ b/handlers.lisp
>> @@ -91,7 +91,7 @@ determined by *ALLOWED-METHODS* and *DAV-
>> COMPLIANCE-CLASSES*."
>> content body \(if there is one) and returns a corresponding
>> \"multistatus\" XML element using the methods for live and dead
>> properties."
>> - (let* ((depth-header (header-in :depth))
>> + (let* ((depth-header (header-in* :depth))
>> (depth-value (cond ((or (null depth-header)
>> (string-equal depth-header
>> "infinity")) nil)
>> ((string= depth-header "0") 0)
>> @@ -177,7 +177,7 @@ HEAD-REQUEST-P is true."
>> (setf (header-out :content-language) content-language))
>> (catch 'handler-done
>> (handle-if-modified-since write-date)
>> - (when (equal etag (header-in :if-none-match))
>> + (when (equal etag (header-in* :if-none-match))
>> (setf (return-code) +http-not-modified+)))
>> (when (eql (return-code) +http-not-modified+)
>> (throw 'handler-done nil))
>> @@ -219,7 +219,7 @@ instead."
>> (defun delete-handler ()
>> "The handler for DELETE requests. Uses REMOVE-RESOURCE* to do
>> the actual work."
>> - (let ((depth-header (header-in :depth)))
>> + (let ((depth-header (header-in* :depth)))
>> (unless (or (null depth-header)
>> (string-equal depth-header "infinity"))
>> (warn "Depth header is ~S." depth-header)
>> @@ -243,7 +243,7 @@ new resource from the contents sent by the
>> client."
>> (let ((parent (resource-parent resource)))
>> (when (or (null parent) (not (resource-exists parent)))
>> (conflict)))
>> - (let* ((content-length-header (cdr (assoc :content-length
>> (headers-in))))
>> + (let* ((content-length-header (cdr (assoc :content-length
>> (headers-in*))))
>> (content-length (and content-length-header
>> (parse-integer content-length-
>> header :junk-allowed t))))
>> (unless content-length
>> @@ -255,21 +255,21 @@ new resource from the contents sent by the
>> client."
>> "The handler for COPY requests which internally uses
>> COPY-OR-MOVE-RESOURCE* to do the actual work. Also doubles as a
>> handler for MOVE requests if MOVEP is true."
>> - (let* ((depth-header (header-in :depth))
>> + (let* ((depth-header (header-in* :depth))
>> (depth-value (cond ((or (null depth-header)
>> (string-equal depth-header
>> "infinity")) nil)
>> ((and (string= depth-header "0")
>> (not movep)) 0)
>> (t (warn "Depth header is ~S." depth-
>> header)
>> (bad-request))))
>> - (overwrite (equal (header-in :overwrite) "T"))
>> + (overwrite (equal (header-in* :overwrite) "T"))
>> (source (get-resource)))
>> ;; note that we ignore a possible request body and thus the
>> ;; "propertybehaviour" XML element for now - we just try to use
>> ;; best effort to copy/move all properties
>> (unless (resource-exists source)
>> (not-found))
>> - (let ((destination-header (header-in :destination)))
>> + (let ((destination-header (header-in* :destination)))
>> (unless destination-header
>> (warn "No 'Destination' header.")
>> (bad-request))
>> diff --git a/properties.lisp b/properties.lisp
>> index f0b0b28..49489c2 100755
>> --- a/properties.lisp
>> +++ b/properties.lisp
>> @@ -80,10 +80,10 @@ found) the property itself."
>> (let ((property (handler-case
>> (get-property resource property-designator)
>> (error (condition)
>> - (log-message* "While trying to get property
>> ~S for resource ~S: ~A"
>> - (local-name property-designator)
>> - (resource-script-name resource)
>> - condition)
>> + (log-message "While trying to get property
>> ~S for resource ~S: ~A"
>> + (local-name property-designator)
>> + (resource-script-name resource)
>> + condition)
>> +http-internal-server-error+))))
>> (etypecase property
>> (null (values +http-ok+ property-designator))
>> diff --git a/resources.lisp b/resources.lisp
>> index 55cffdf..613667d 100755
>> --- a/resources.lisp
>> +++ b/resources.lisp
>> @@ -390,7 +390,7 @@ name SCRIPT-NAME \(which is already URL-
>> decoded).")
>> (make-instance resource-class-name
>> :script-name script-name)))
>>
>> -(defun get-resource (&optional (script-name (url-decode* (script-
>> name))))
>> +(defun get-resource (&optional (script-name (url-decode* (script-
>> name*))))
>> "Creates and returns an object of the type stored in
>> *RESOURCE-CLASS* corresponding to the script name SCRIPT-NAME."
>> (create-resource *resource-class* script-name))
>> diff --git a/specials.lisp b/specials.lisp
>> index f4fefc7..2bfb12f 100755
>> --- a/specials.lisp
>> +++ b/specials.lisp
>> @@ -36,6 +36,10 @@
>> `(cl:defconstant ,name (if (boundp ',name) (symbol-value
>> ',name) ,value)
>> ,@(when doc (list doc)))))
>>
>> +(defun constantly-nil (&rest args)
>> + (declare (ignore args))
>> + nil)
>> +
>> (defconstant +dav-property-alist+
>> `(("creationdate" . creation-date)
>> ("displayname" . resource-display-name)
>> @@ -46,8 +50,8 @@
>> ("getcontentlanguage" . resource-content-language)
>> ("resourcetype" . resource-type)
>> ("source" . resource-source)
>> - ("lockdiscovery" . ,(constantly nil))
>> - ("supportedlock" . ,(constantly nil)))
>> + ("lockdiscovery" . constantly-nil)
>> + ("supportedlock" . constantly-nil))
>> "An alist mapping the \(names of the) standard DAV properties
>> to functions handling them.")
>>
>> diff --git a/util.lisp b/util.lisp
>> index 85b3afd..4f85165 100755
>> --- a/util.lisp
>> +++ b/util.lisp
>> @@ -90,5 +90,5 @@ then uses LATIN-1 if that fails."
>> ;; LATIN-1...
>> (handler-case
>> (url-decode string +utf-8+)
>> - (flex:flexi-stream-encoding-error ()
>> + (flex:external-format-encoding-error ()
>> (url-decode string +latin-1+))))
>>
>>
>>
>> _______________________________________________
>> tbnl-devel site list
>> tbnl-devel at common-lisp.net
>> http://common-lisp.net/mailman/listinfo/tbnl-devel
>
> _______________________________________________
> tbnl-devel site list
> tbnl-devel at common-lisp.net
> http://common-lisp.net/mailman/listinfo/tbnl-devel
More information about the Tbnl-devel
mailing list