diff options
| author | David Engster | 2012-07-28 13:07:17 +0200 |
|---|---|---|
| committer | David Engster | 2012-07-28 13:07:17 +0200 |
| commit | 7fa20d96f1c9e351b783cfa3347de3ca7f26a7d6 (patch) | |
| tree | c7fd418ac5c9a187a0bbd785cf1286b28a19ce55 | |
| parent | 345a2258671ec587a32129daf37fb53b3eea903e (diff) | |
| download | emacs-7fa20d96f1c9e351b783cfa3347de3ca7f26a7d6.tar.gz emacs-7fa20d96f1c9e351b783cfa3347de3ca7f26a7d6.zip | |
Fix various issues with url-dav package (Bug#11916).
* url-dav.el (url-dav-supported-p): Added doc-string and remove
check for feature `xml' and function `xml-expand-namespace' which
never existed in Emacs proper.
(url-dav-process-response): Remove all indentation and newlines
from XML before parsing. Change call to `xml-parse-region' to do
namespace expansion with simple qualified names (Bug#11916).
(url-dav-request): Add autoload.
(url-dav-directory-files): Properly deal with empty directories.
Unhex URL before generating relative URLs.
(url-dav-file-directory-p): Fix check for 'DAV:collection.
| -rw-r--r-- | lisp/url/ChangeLog | 13 | ||||
| -rw-r--r-- | lisp/url/url-dav.el | 32 |
2 files changed, 34 insertions, 11 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 0fc48907f40..ae224f4102f 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog | |||
| @@ -1,3 +1,16 @@ | |||
| 1 | 2012-07-28 David Engster <deng@randomsample.de> | ||
| 2 | |||
| 3 | * url-dav.el (url-dav-supported-p): Added doc-string and remove | ||
| 4 | check for feature `xml' and function `xml-expand-namespace' which | ||
| 5 | never existed in Emacs proper. | ||
| 6 | (url-dav-process-response): Remove all indentation and newlines | ||
| 7 | from XML before parsing. Change call to `xml-parse-region' to do | ||
| 8 | namespace expansion with simple qualified names (Bug#11916). | ||
| 9 | (url-dav-request): Add autoload. | ||
| 10 | (url-dav-directory-files): Properly deal with empty directories. | ||
| 11 | Unhex URL before generating relative URLs. | ||
| 12 | (url-dav-file-directory-p): Fix check for 'DAV:collection. | ||
| 13 | |||
| 1 | 2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca> | 14 | 2012-07-11 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 15 | ||
| 3 | * url.el, url-queue.el, url-parse.el, url-http.el, url-future.el: | 16 | * url.el, url-queue.el, url-parse.el, url-http.el, url-future.el: |
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 77e48b0e47d..4bb03369b9b 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el | |||
| @@ -53,10 +53,10 @@ | |||
| 53 | 53 | ||
| 54 | ;;;###autoload | 54 | ;;;###autoload |
| 55 | (defun url-dav-supported-p (url) | 55 | (defun url-dav-supported-p (url) |
| 56 | (and (featurep 'xml) | 56 | "Return WebDAV protocol version supported by URL. |
| 57 | (fboundp 'xml-expand-namespace) | 57 | Returns nil if WebDAV is not supported." |
| 58 | (url-intersection url-dav-supported-protocols | 58 | (url-intersection url-dav-supported-protocols |
| 59 | (plist-get (url-http-options url) 'dav)))) | 59 | (plist-get (url-http-options url) 'dav))) |
| 60 | 60 | ||
| 61 | (defun url-dav-node-text (node) | 61 | (defun url-dav-node-text (node) |
| 62 | "Return the text data from the XML node NODE." | 62 | "Return the text data from the XML node NODE." |
| @@ -385,7 +385,12 @@ XML document." | |||
| 385 | (when buffer | 385 | (when buffer |
| 386 | (unwind-protect | 386 | (unwind-protect |
| 387 | (with-current-buffer buffer | 387 | (with-current-buffer buffer |
| 388 | ;; First remove all indentation and line endings | ||
| 388 | (goto-char url-http-end-of-headers) | 389 | (goto-char url-http-end-of-headers) |
| 390 | (indent-rigidly (point) (point-max) -1000) | ||
| 391 | (save-excursion | ||
| 392 | (while (re-search-forward "\r?\n" nil t) | ||
| 393 | (replace-match ""))) | ||
| 389 | (setq overall-status url-http-response-status) | 394 | (setq overall-status url-http-response-status) |
| 390 | 395 | ||
| 391 | ;; XML documents can be transferred as either text/xml or | 396 | ;; XML documents can be transferred as either text/xml or |
| @@ -395,7 +400,7 @@ XML document." | |||
| 395 | url-http-content-type | 400 | url-http-content-type |
| 396 | (string-match "\\`\\(text\\|application\\)/xml" | 401 | (string-match "\\`\\(text\\|application\\)/xml" |
| 397 | url-http-content-type)) | 402 | url-http-content-type)) |
| 398 | (setq tree (xml-parse-region (point) (point-max))))) | 403 | (setq tree (xml-parse-region (point) (point-max) nil nil 'symbol-qnames)))) |
| 399 | ;; Clean up after ourselves. | 404 | ;; Clean up after ourselves. |
| 400 | (kill-buffer buffer))) | 405 | (kill-buffer buffer))) |
| 401 | 406 | ||
| @@ -411,6 +416,7 @@ XML document." | |||
| 411 | ;; nobody but us needs to know the difference. | 416 | ;; nobody but us needs to know the difference. |
| 412 | (list (cons url properties)))))) | 417 | (list (cons url properties)))))) |
| 413 | 418 | ||
| 419 | ;;;###autoload | ||
| 414 | (defun url-dav-request (url method tag body | 420 | (defun url-dav-request (url method tag body |
| 415 | &optional depth headers namespaces) | 421 | &optional depth headers namespaces) |
| 416 | "Perform WebDAV operation METHOD on URL. Return the parsed responses. | 422 | "Perform WebDAV operation METHOD on URL. Return the parsed responses. |
| @@ -768,8 +774,8 @@ files in the collection as well." | |||
| 768 | (defun url-dav-directory-files (url &optional full match nosort files-only) | 774 | (defun url-dav-directory-files (url &optional full match nosort files-only) |
| 769 | "Return a list of names of files in URL. | 775 | "Return a list of names of files in URL. |
| 770 | There are three optional arguments: | 776 | There are three optional arguments: |
| 771 | If FULL is non-nil, return absolute file names. Otherwise return names | 777 | If FULL is non-nil, return absolute URLs. Otherwise return names |
| 772 | that are relative to the specified directory. | 778 | that are relative to the specified URL. |
| 773 | If MATCH is non-nil, mention only file names that match the regexp MATCH. | 779 | If MATCH is non-nil, mention only file names that match the regexp MATCH. |
| 774 | If NOSORT is non-nil, the list is not sorted--its order is unpredictable. | 780 | If NOSORT is non-nil, the list is not sorted--its order is unpredictable. |
| 775 | NOSORT is useful if you plan to sort the result yourself." | 781 | NOSORT is useful if you plan to sort the result yourself." |
| @@ -779,8 +785,9 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. | |||
| 779 | (files nil) | 785 | (files nil) |
| 780 | (parsed-url (url-generic-parse-url url))) | 786 | (parsed-url (url-generic-parse-url url))) |
| 781 | 787 | ||
| 782 | (if (= (length properties) 1) | 788 | (when (and (= (length properties) 1) |
| 783 | (signal 'file-error (list "Opening directory" "not a directory" url))) | 789 | (not (url-dav-file-directory-p url))) |
| 790 | (signal 'file-error (list "Opening directory" "not a directory" url))) | ||
| 784 | 791 | ||
| 785 | (while properties | 792 | (while properties |
| 786 | (setq child-props (pop properties) | 793 | (setq child-props (pop properties) |
| @@ -794,7 +801,9 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. | |||
| 794 | ;; are not supposed to return fully-qualified names. | 801 | ;; are not supposed to return fully-qualified names. |
| 795 | (setq child-url (url-expand-file-name child-url parsed-url)) | 802 | (setq child-url (url-expand-file-name child-url parsed-url)) |
| 796 | (if (not full) | 803 | (if (not full) |
| 797 | (setq child-url (substring child-url (length url)))) | 804 | ;; Parts of the URL might be hex'ed. |
| 805 | (setq child-url (substring (url-unhex-string child-url) | ||
| 806 | (length url)))) | ||
| 798 | 807 | ||
| 799 | ;; We don't want '/' as the last character in filenames... | 808 | ;; We don't want '/' as the last character in filenames... |
| 800 | (if (string-match "/$" child-url) | 809 | (if (string-match "/$" child-url) |
| @@ -814,7 +823,8 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. | |||
| 814 | (defun url-dav-file-directory-p (url) | 823 | (defun url-dav-file-directory-p (url) |
| 815 | "Return t if URL names an existing DAV collection." | 824 | "Return t if URL names an existing DAV collection." |
| 816 | (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype))))) | 825 | (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype))))) |
| 817 | (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection))) | 826 | (when (member 'DAV:collection (plist-get properties 'DAV:resourcetype)) |
| 827 | t))) | ||
| 818 | 828 | ||
| 819 | (defun url-dav-make-directory (url &optional parents) | 829 | (defun url-dav-make-directory (url &optional parents) |
| 820 | "Create the directory DIR and any nonexistent parent dirs." | 830 | "Create the directory DIR and any nonexistent parent dirs." |