Changeset 3339

Show
Ignore:
Timestamp:
06/25/08 09:57:00 (7 months ago)
Author:
edi
Message:

Patches from Cyrus Harmon to sync cl-webdav with Hunchentoot dev version

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/thirdparty/cl-webdav/handlers.lisp

    r3335 r3339  
    7979  "The handler for OPTIONS requests.  Output is basically 
    8080determined by *ALLOWED-METHODS* and *DAV-COMPLIANCE-CLASSES*." 
    81   (setf (content-type) nil 
    82         (header-out :allow) (format nil "~{~A~^, ~}" *allowed-methods*) 
     81  (setf (header-out :allow) (format nil "~{~A~^, ~}" *allowed-methods*) 
    8382        (header-out :dav) (format nil "~{~D~^,~}" *dav-compliance-classes*) 
    8483        ;; Win2k wants this - sigh... 
    …… 
    9291\"multistatus\" XML element using the methods for live and dead 
    9392properties." 
    94   (let* ((depth-header (header-in :depth)) 
     93  (let* ((depth-header (header-in* :depth)) 
    9594         (depth-value (cond ((or (null depth-header) 
    9695                                 (string-equal depth-header "infinity")) nil) 
    …… 
    178177      (catch 'handler-done 
    179178        (handle-if-modified-since write-date) 
    180         (when (equal etag (header-in :if-none-match)) 
     179        (when (equal etag (header-in* :if-none-match)) 
    181180          (setf (return-code) +http-not-modified+))) 
    182181      (when (eql (return-code) +http-not-modified+) 
    …… 
    220219  "The handler for DELETE requests.  Uses REMOVE-RESOURCE* to do 
    221220the actual work." 
    222   (let ((depth-header (header-in :depth))) 
     221  (let ((depth-header (header-in* :depth))) 
    223222    (unless (or (null depth-header) 
    224223                (string-equal depth-header "infinity")) 
    …… 
    244243      (when (or (null parent) (not (resource-exists parent))) 
    245244        (conflict))) 
    246     (let* ((content-length-header (cdr (assoc :content-length (headers-in)))) 
     245    (let* ((content-length-header (cdr (assoc :content-length (headers-in*)))) 
    247246           (content-length (and content-length-header 
    248247                                (parse-integer content-length-header :junk-allowed t)))) 
    …… 
    256255COPY-OR-MOVE-RESOURCE* to do the actual work.  Also doubles as a 
    257256handler for MOVE requests if MOVEP is true." 
    258   (let* ((depth-header (header-in :depth)) 
     257  (let* ((depth-header (header-in* :depth)) 
    259258         (depth-value (cond ((or (null depth-header) 
    260259                                 (string-equal depth-header "infinity")) nil) 
    …… 
    263262                            (t (warn "Depth header is ~S." depth-header) 
    264263                               (bad-request)))) 
    265          (overwrite (equal (header-in :overwrite) "T")) 
     264         (overwrite (equal (header-in* :overwrite) "T")) 
    266265         (source (get-resource))) 
    267266    ;; note that we ignore a possible request body and thus the 
    …… 
    270269    (unless (resource-exists source) 
    271270      (not-found)) 
    272     (let ((destination-header (header-in :destination))) 
     271    (let ((destination-header (header-in* :destination))) 
    273272      (unless destination-header 
    274273        (warn "No 'Destination' header.") 

  • trunk/thirdparty/cl-webdav/properties.lisp

    r3335 r3339  
    8181                      (get-property resource property-designator) 
    8282                    (error (condition) 
    83                       (log-message* "While trying to get property ~S for resource ~S: ~A" 
    84                                     (local-name property-designator) 
    85                                     (resource-script-name resource) 
    86                                     condition) 
     83                      (log-message "While trying to get property ~S for resource ~S: ~A" 
     84                                   (local-name property-designator) 
     85                                   (resource-script-name resource) 
     86                                   condition) 
    8787                      +http-internal-server-error+)))) 
    8888    (etypecase property 

  • trunk/thirdparty/cl-webdav/resources.lisp

    r3335 r3339  
    391391                  :script-name script-name))) 
    392392 
    393 (defun get-resource (&optional (script-name (url-decode* (script-name)))) 
     393(defun get-resource (&optional (script-name (url-decode* (script-name*)))) 
    394394  "Creates and returns an object of the type stored in 
    395395*RESOURCE-CLASS* corresponding to the script name SCRIPT-NAME." 

  • trunk/thirdparty/cl-webdav/specials.lisp

    r3335 r3339  
    3737       ,@(when doc (list doc))))) 
    3838 
     39(defun constantly-nil (&rest args) 
     40  (declare (ignore args)) 
     41  nil) 
     42 
    3943(defconstant +dav-property-alist+ 
    4044  `(("creationdate" . creation-date) 
    …… 
    4751    ("resourcetype" . resource-type) 
    4852    ("source" . resource-source) 
    49     ("lockdiscovery" . ,(constantly nil)) 
    50     ("supportedlock" . ,(constantly nil))) 
     53    ("lockdiscovery" . constantly-nil) 
     54    ("supportedlock" . constantly-nil)) 
    5155  "An alist mapping the \(names of the) standard DAV properties 
    5256to functions handling them.") 

  • trunk/thirdparty/cl-webdav/util.lisp

    r3335 r3339  
    9191  (handler-case 
    9292      (url-decode string +utf-8+) 
    93     (flex:flexi-stream-encoding-error () 
     93    (flex:external-format-encoding-error () 
    9494      (url-decode string +latin-1+))))