[hunchentoot-devel] cl-webdav errors
Cyrus Harmon
ch-tbnl at bobobeach.com
Mon Jun 23 23:47:41 UTC 2008
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
More information about the Tbnl-devel
mailing list