;;; url-dav.el --- WebDAV support
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: Bill Perry <wmperry@gnu.org>
;; Keywords: url, vc
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; DAV is in RFC 2518.
+;;; Commentary:
+
+;;; Code:
+
(eval-when-compile
(require 'cl))
\f
;;; Parsing routines for the actual node contents.
-;;;
-;;; I am not incredibly happy with how this code looks/works right
-;;; now, but it DOES work, and if we get the API right, our callers
-;;; won't have to worry about the internal representation.
+;;
+;; I am not incredibly happy with how this code looks/works right
+;; now, but it DOES work, and if we get the API right, our callers
+;; won't have to worry about the internal representation.
(defconst url-dav-datatype-attribute
'urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/dt)
"List of regular expressions matching iso8601 dates.
1st regular expression matches the date.
2nd regular expression matches the time.
-3rd regular expression matches the (optional) timezone specification.
-")
+3rd regular expression matches the (optional) timezone specification.")
(defun url-dav-process-date-property (node)
(require 'parse-time)
\f
;;; DAV request/response generation/processing
(defun url-dav-process-response (buffer url)
- "Parses a WebDAV response from BUFFER, interpreting it relative to URL.
+ "Parse a WebDAV response from BUFFER, interpreting it relative to URL.
The buffer must have been retrieved by HTTP or HTTPS and contain an
-XML document.
-"
+XML document."
(declare (special url-http-content-type
url-http-response-status
url-http-end-of-headers))
(overall-status nil))
(when buffer
(unwind-protect
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(goto-char url-http-end-of-headers)
(setq overall-status url-http-response-status)
;; them.
(if (and
url-http-content-type
- (or (string-match "^text/xml" url-http-content-type)
- (string-match "^application/xml" url-http-content-type)))
+ (string-match "\\`\\(text\\|application\\)/xml"
+ url-http-content-type))
(setq tree (xml-parse-region (point) (point-max)))))
;; Clean up after ourselves.
- '(kill-buffer buffer)))
+ (kill-buffer buffer)))
- ;; We should now be
+ ;; We should now be
(if (eq (xml-node-name (car tree)) 'DAV:multistatus)
(url-dav-dispatch-node (car tree))
(url-debug 'dav "Got back singleton response for URL(%S)" url)
(defun url-dav-request (url method tag body
&optional depth headers namespaces)
- "Performs WebDAV operation METHOD on URL. Returns the parsed responses.
+ "Perform WebDAV operation METHOD on URL. Return the parsed responses.
Automatically creates an XML request body if TAG is non-nil.
BODY is the XML document fragment to be enclosed by <TAG></TAG>.
NAMESPACES is an assoc list of (NAMESPACE . EXPANSION), and these are
added to the <TAG> element. The DAV=DAV: namespace is automatically
-added to this list, so most requests can just pass in nil.
-"
+added to this list, so most requests can just pass in nil."
;; Take care of the default value for depth...
(setq depth (or depth 0))
Returns an assoc list, where the key is the filename (possibly a full
URI), and the value is a standard property list of DAV property
-names (ie: DAV:resourcetype).
-"
+names (ie: DAV:resourcetype)."
(url-dav-request url "PROPFIND" 'DAV:propfind
(if attributes
(mapconcat (lambda (attr)
This will be used as the contents of the DAV:owner/DAV:href tag to
identify the owner of a LOCK when requesting it. This will be shown
to other users when the DAV:lockdiscovery property is requested, so
-make sure you are comfortable with it leaking to the outside world.
-")
+make sure you are comfortable with it leaking to the outside world.")
;;;###autoload
(defun url-dav-lock-resource (url exclusive &optional depth)
Returns a cons-cell of (SUCCESSFUL-RESULTS . FAILURE-RESULTS).
SUCCESSFUL-RESULTS is a list of (URL STATUS locktoken).
-FAILURE-RESULTS is a list of (URL STATUS).
-"
+FAILURE-RESULTS is a list of (URL STATUS)."
(setq exclusive (if exclusive "<DAV:exclusive/>" "<DAV:shared/>"))
(let* ((body
(concat
;;;###autoload
(defun url-dav-unlock-resource (url lock-token)
"Release the lock on URL represented by LOCK-TOKEN.
-Returns `t' iff the lock was successfully released.
-"
+Returns t iff the lock was successfully released."
(declare (special url-http-response-status))
(let* ((url-request-extra-headers (list (cons "Lock-Token"
(concat "<" lock-token ">"))))
(result nil))
(when buffer
(unwind-protect
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq result (url-dav-http-success-p url-http-response-status)))
(kill-buffer buffer)))
result))
(autoload 'url-http-head-file-attributes "url-http")
;;;###autoload
-(defun url-dav-file-attributes (url)
+(defun url-dav-file-attributes (url &optional id-format)
(let ((properties (cdar (url-dav-get-properties url)))
(attributes nil))
(if (and properties
;; device number - meaningless
nil))
;; Fall back to just the normal http way of doing things.
- (setq attributes (url-http-head-file-attributes url)))
+ (setq attributes (url-http-head-file-attributes url id-format)))
attributes))
;;;###autoload
(url-request-data
(cond
((bufferp obj)
- (save-excursion
- (set-buffer obj)
+ (with-current-buffer obj
(buffer-string)))
((stringp obj)
obj)
;; Sanity checking
(when buffer
(unwind-protect
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq result (url-dav-http-success-p url-http-response-status)))
(kill-buffer buffer)))
result))
(defun url-dav-delete-directory (url &optional recursive lock-token)
"Delete the WebDAV collection URL.
If optional second argument RECURSIVE is non-nil, then delete all
-files in the collection as well.
-"
+files in the collection as well."
(let ((status nil)
(props nil)
(props nil))
that are relative to the specified directory.
If MATCH is non-nil, mention only file names that match the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
- NOSORT is useful if you plan to sort the result yourself.
-"
+ NOSORT is useful if you plan to sort the result yourself."
(let ((properties (url-dav-get-properties url '(DAV:resourcetype) 1))
(child-url nil)
(child-props nil)
(result nil))
(when buffer
(unwind-protect
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(case url-http-response-status
(201 ; Collection created in its entirety
(setq result t))
;;;###autoload
(defun url-dav-file-name-all-completions (file url)
"Return a list of all completions of file name FILE in directory DIRECTORY.
-These are all file names in directory DIRECTORY which begin with FILE.
-"
+These are all file names in directory DIRECTORY which begin with FILE."
(url-dav-directory-files url nil (concat "^" file ".*")))
;;;###autoload
Returns the longest string
common to all file names in DIRECTORY that start with FILE.
If there is only one and FILE matches it exactly, returns t.
-Returns nil if DIR contains no name starting with FILE.
-"
+Returns nil if DIR contains no name starting with FILE."
(let ((matches (url-dav-file-name-all-completions file url))
(result nil))
(cond
(provide 'url-dav)
-;;; arch-tag: 2b14b7b3-888a-49b8-a490-17276a40e78e
+;; arch-tag: 2b14b7b3-888a-49b8-a490-17276a40e78e
+;;; url-dav.el ends here