bug#11916: 24.1.50; Making url-dav work

[David Engster <deng@randomsample.de>]

[-- Attachment #1: Type: text/plain, Size: 2427 bytes --]

Stefan Monnier writes:
>> You might get name clashes; for example, the code might parse a
>> 'collection' although it is actually not a "DAV:collection" but a
>> "FOOBAR:collection". Granted, it's not very likely, and if this would be
>> used in a read-only fashion (like parsing atom feeds) I'd drop the
>> namespaces in a heartbeat. But since url-dav will usually be used to
>> manipulate actual files on remote servers, I'd rather not risk it.
>
> I see.  So using libxml wouldn't be an option (or maybe libxml can also
> do it, but we'd need to change libxml-parse-xml-region for that?).

Yes, libxml can do namespace parsing.

>>> Of course, I was thinking of changing it in a backward compatible way,
>>> by letting the `parse-ns' argument specify which kind of result you
>>> want.  The changes should be mostly limited to xml-maybe-do-ns.
>> I could live with that.
>
> Could you prepare a patch for that?

Attached. I had to go another route, though; turns out the `parse-ns'
argument is already overloaded in `xml-parse-tag' (it can be used to
provide a namespace->URI mapping), but that wasn't mentioned in the
other parse functions. So I had to introduce an additional argument.

I also attached my current changes in url-dav.el, which next to
supporting the new `simple-qnames' argument contain a few other
fixes. Here's the complete ChangeLog:

xml.el:

(xml-node-name): Mention `simple-qnames' in doc-string.
(xml-parse-file, xml-parse-region, xml--parse-buffer)
(xml-parse-tag, xml-parse-tag-1, xml-parse-attlist): Add argument
`simple-qnames'.  Adapt all calls to parse functions to hand over this
new argument.  Adapt doc-strings to mention `simple-qnames' and also
mention that `parse-ns' can be used to provide namespace mappings.
(xml-maybe-do-ns): Return symbol instead of cons depending on
`simple-qnames' argument.


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 from XML
before parsing.  Change call to `xml-parse-region' to do namespace
expansion with simple qualified names.
(url-dav-request): Add autoload.
(url-dav-directory-files): Properly deal with empty directories.  Call
hexify before generating relative URLs.
(url-dav-file-directory-p): Fix bug when checking for 'DAV:collection
(resources are returned as a list).

-David


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: xml-diff.patch --]
[-- Type: text/x-patch, Size: 8633 bytes --]

=== modified file 'lisp/xml.el'
--- lisp/xml.el	2012-07-04 16:14:05 +0000
+++ lisp/xml.el	2012-07-21 10:47:53 +0000
@@ -118,16 +118,18 @@
   "Return the tag associated with NODE.
 Without namespace-aware parsing, the tag is a symbol.
 
-With namespace-aware parsing, the tag is a cons of a string
-representing the uri of the namespace with the local name of the
-tag.  For example,
+With namespace-aware parsing, by default the tag is a cons of a
+string representing the uri of the namespace with the local name
+of the tag.  For example,
 
     <foo>
 
 would be represented by
 
-    '(\"\" . \"foo\")."
+    '(\"\" . \"foo\").
 
+If you would rather like a plain symbol instead, provide a
+non-nil SIMPLE-QNAMES argument to the parser functions."
   (car node))
 
 (defsubst xml-node-attributes (node)
@@ -309,17 +311,24 @@
 ;;; Entry points:
 
 ;;;###autoload
-(defun xml-parse-file (file &optional parse-dtd parse-ns)
+(defun xml-parse-file (file &optional parse-dtd parse-ns simple-qnames)
   "Parse the well-formed XML file FILE.
 Return the top node with all its children.
 If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
-If PARSE-NS is non-nil, then QNAMES are expanded."
+If PARSE-NS is non-nil, expand QNAMES; if the value of PARSE-NS
+is a list, use it as an alist mapping namespaces to URIs.
+Expanded names will by default be returned as a cons
+
+  (\"foo:\" . \"bar\").
+
+If you would like to get a plain symbol 'foo:bar instead, set
+SIMPLE-QNAMES to a non-nil value."
   (with-temp-buffer
     (insert-file-contents file)
-    (xml--parse-buffer parse-dtd parse-ns)))
+    (xml--parse-buffer parse-dtd parse-ns simple-qnames)))
 
 ;;;###autoload
-(defun xml-parse-region (&optional beg end buffer parse-dtd parse-ns)
+(defun xml-parse-region (&optional beg end buffer parse-dtd parse-ns simple-qnames)
   "Parse the region from BEG to END in BUFFER.
 Return the XML parse tree, or raise an error if the region does
 not contain well-formed XML.
@@ -329,14 +338,21 @@
 If BUFFER is nil, it defaults to the current buffer.
 If PARSE-DTD is non-nil, parse the DTD and return it as the first
 element of the list.
-If PARSE-NS is non-nil, expand QNAMES."
+If PARSE-NS is non-nil, expand QNAMES; if the value of PARSE-NS
+is a list, use it as an alist mapping namespaces to URIs.
+Expanded names will by default be returned as a cons
+
+  (\"foo:\" . \"bar\").
+
+If you would like to get a plain symbol 'foo:bar instead, set
+SIMPLE-QNAMES to a non-nil value."
   ;; Use fixed syntax table to ensure regexp char classes and syntax
   ;; specs DTRT.
   (unless buffer
     (setq buffer (current-buffer)))
   (with-temp-buffer
     (insert-buffer-substring-no-properties buffer beg end)
-    (xml--parse-buffer parse-dtd parse-ns)))
+    (xml--parse-buffer parse-dtd parse-ns simple-qnames)))
 
 ;; XML [5]
 
@@ -344,7 +360,7 @@
 ;;   document  ::=  prolog element Misc*
 ;;   prolog    ::=  XMLDecl? Misc* (doctypedecl Misc*)?
 
-(defun xml--parse-buffer (parse-dtd parse-ns)
+(defun xml--parse-buffer (parse-dtd parse-ns simple-qnames)
   (with-syntax-table xml-syntax-table
     (let ((case-fold-search nil)	; XML is case-sensitive.
 	  ;; Prevent entity definitions from changing the defaults
@@ -356,7 +372,7 @@
 	(if (search-forward "<" nil t)
 	    (progn
 	      (forward-char -1)
-	      (setq result (xml-parse-tag-1 parse-dtd parse-ns))
+	      (setq result (xml-parse-tag-1 parse-dtd parse-ns simple-qnames))
 	      (cond
 	       ((null result)
 		;; Not looking at an xml start tag.
@@ -377,7 +393,7 @@
 	  (cons dtd (nreverse xml))
 	(nreverse xml)))))
 
-(defun xml-maybe-do-ns (name default xml-ns)
+(defun xml-maybe-do-ns (name default xml-ns simple-qnames)
   "Perform any namespace expansion.
 NAME is the name to perform the expansion on.
 DEFAULT is the default namespace.  XML-NS is a cons of namespace
@@ -386,7 +402,10 @@
 
 During namespace-aware parsing, any name without a namespace is
 put into the namespace identified by DEFAULT.  nil is used to
-specify that the name shouldn't be given a namespace."
+specify that the name shouldn't be given a namespace.
+Expanded names will by default be returned as a cons.  If you
+would like to get plain symbols, set SIMPLE-QNAMES to a non-nil
+value."
   (if (consp xml-ns)
       (let* ((nsp (string-match ":" name))
 	     (lname (if nsp (substring name (match-end 0)) name))
@@ -397,15 +416,24 @@
 	     (ns (or (cdr (assoc (if special "xmlns" prefix)
                                  xml-ns))
                      "")))
-        (cons ns (if special "" lname)))
+	(if (and simple-qnames
+		 (not (string= prefix "xmlns")))
+	    (intern (concat ns lname))
+	  (cons ns (if special "" lname))))
     (intern name)))
 
-(defun xml-parse-tag (&optional parse-dtd parse-ns)
+(defun xml-parse-tag (&optional parse-dtd parse-ns simple-qnames)
   "Parse the tag at point.
 If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and
 returned as the first element in the list.
 If PARSE-NS is non-nil, expand QNAMES; if the value of PARSE-NS
 is a list, use it as an alist mapping namespaces to URIs.
+Expanded names will by default be returned as a cons
+
+  (\"foo:\" . \"bar\").
+
+If you would like to get a plain symbol 'foo:bar instead, set
+SIMPLE-QNAMES to a non-nil value.
 
 Return one of:
  - a list : the matching node
@@ -421,9 +449,9 @@
       (with-syntax-table xml-syntax-table
 	(insert-buffer-substring-no-properties buf pos)
 	(goto-char (point-min))
-	(xml-parse-tag-1 parse-dtd parse-ns)))))
+	(xml-parse-tag-1 parse-dtd parse-ns simple-qnames)))))
 
-(defun xml-parse-tag-1 (&optional parse-dtd parse-ns)
+(defun xml-parse-tag-1 (&optional parse-dtd parse-ns simple-qnames)
   "Like `xml-parse-tag', but possibly modify the buffer while working."
   (let ((xml-validating-parser (or parse-dtd xml-validating-parser))
 	(xml-ns (cond ((consp parse-ns) parse-ns)
@@ -433,7 +461,7 @@
      ((looking-at "<\\?")
       (search-forward "?>")
       (skip-syntax-forward " ")
-      (xml-parse-tag-1 parse-dtd xml-ns))
+      (xml-parse-tag-1 parse-dtd xml-ns simple-qnames))
      ;; Character data (CDATA) sections, in which no tag should be interpreted
      ((looking-at "<!\\[CDATA\\[")
       (let ((pos (match-end 0)))
@@ -447,8 +475,8 @@
       (let ((dtd (xml-parse-dtd parse-ns)))
 	(skip-syntax-forward " ")
 	(if xml-validating-parser
-	    (cons dtd (xml-parse-tag-1 nil xml-ns))
-	  (xml-parse-tag-1 nil xml-ns))))
+	    (cons dtd (xml-parse-tag-1 nil xml-ns simple-qnames))
+	  (xml-parse-tag-1 nil xml-ns simple-qnames))))
      ;; skip comments
      ((looking-at "<!--")
       (search-forward "-->")
@@ -456,7 +484,7 @@
       (skip-syntax-forward " ")
       (unless (eobp)
 	(let ((xml-sub-parser t))
-	  (xml-parse-tag-1 parse-dtd xml-ns))))
+	  (xml-parse-tag-1 parse-dtd xml-ns simple-qnames))))
      ;; end tag
      ((looking-at "</")
       '())
@@ -466,7 +494,7 @@
       ;; Parse this node
       (let* ((node-name (match-string-no-properties 1))
 	     ;; Parse the attribute list.
-	     (attrs (xml-parse-attlist xml-ns))
+	     (attrs (xml-parse-attlist xml-ns simple-qnames))
 	     children)
 	;; add the xmlns:* attrs to our cache
 	(when (consp xml-ns)
@@ -476,7 +504,8 @@
 			      (caar attr)))
 	      (push (cons (cdar attr) (cdr attr))
 		    xml-ns))))
-	(setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
+	(setq children (list attrs (xml-maybe-do-ns node-name ""
+						    xml-ns simple-qnames)))
 	(cond
 	 ;; is this an empty element ?
 	 ((looking-at "/>")
@@ -502,7 +531,7 @@
 		       node-name))
 	       ;; Read a sub-element and push it onto CHILDREN.
 	       ((= (char-after) ?<)
-		(let ((tag (xml-parse-tag-1 nil xml-ns)))
+		(let ((tag (xml-parse-tag-1 nil xml-ns simple-qnames)))
 		  (when tag
 		    (push tag children))))
 	       ;; Read some character data.
@@ -585,7 +614,7 @@
       (goto-char end-marker)
       (buffer-substring start (point)))))
 
-(defun xml-parse-attlist (&optional xml-ns)
+(defun xml-parse-attlist (&optional xml-ns simple-qnames)
   "Return the attribute-list after point.
 Leave point at the first non-blank character after the tag."
   (let ((attlist ())
@@ -594,7 +623,8 @@
     (while (looking-at (eval-when-compile
 			 (concat "\\(" xml-name-re "\\)\\s-*=\\s-*")))
       (setq end-pos (match-end 0))
-      (setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns))
+      (setq name (xml-maybe-do-ns (match-string-no-properties 1)
+				  nil xml-ns simple-qnames))
       (goto-char end-pos)
 
       ;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: url-dav-diff.patch --]
[-- Type: text/x-patch, Size: 3842 bytes --]

=== modified file 'lisp/url/url-dav.el'
--- lisp/url/url-dav.el	2012-07-11 23:13:41 +0000
+++ lisp/url/url-dav.el	2012-07-21 11:45:23 +0000
@@ -53,10 +53,10 @@
 
 ;;;###autoload
 (defun url-dav-supported-p (url)
-  (and (featurep 'xml)
-       (fboundp 'xml-expand-namespace)
-       (url-intersection url-dav-supported-protocols
-			 (plist-get (url-http-options url) 'dav))))
+  "Return WebDAV protocol version supported by URL.
+Returns nil if WebDAV is not supported."
+  (url-intersection url-dav-supported-protocols
+		    (plist-get (url-http-options url) 'dav)))
 
 (defun url-dav-node-text (node)
   "Return the text data from the XML node NODE."
@@ -385,7 +385,12 @@
     (when buffer
       (unwind-protect
 	  (with-current-buffer buffer
+	    ;; First remove all indentation and line endings
 	    (goto-char url-http-end-of-headers)
+	    (indent-rigidly (point) (point-max) -1000)
+	    (save-excursion
+	      (while (re-search-forward "\r?\n" nil t)
+		(replace-match "")))
 	    (setq overall-status url-http-response-status)
 
 	    ;; XML documents can be transferred as either text/xml or
@@ -395,7 +400,7 @@
 		 url-http-content-type
 		 (string-match "\\`\\(text\\|application\\)/xml"
 			       url-http-content-type))
-		(setq tree (xml-parse-region (point) (point-max)))))
+		(setq tree (xml-parse-region (point) (point-max) nil nil t t))))
 	;; Clean up after ourselves.
 	(kill-buffer buffer)))
 
@@ -411,6 +416,7 @@
 	;; nobody but us needs to know the difference.
 	(list (cons url properties))))))
 
+;;;###autoload
 (defun url-dav-request (url method tag body
 				 &optional depth headers namespaces)
   "Perform WebDAV operation METHOD on URL.  Return the parsed responses.
@@ -768,8 +774,8 @@
 (defun url-dav-directory-files (url &optional full match nosort files-only)
   "Return a list of names of files in URL.
 There are three optional arguments:
-If FULL is non-nil, return absolute file names.  Otherwise return names
- that are relative to the specified directory.
+If FULL is non-nil, return absolute URLs.  Otherwise return names
+ that are relative to the specified URL.
 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."
@@ -779,8 +785,9 @@
 	(files nil)
 	(parsed-url (url-generic-parse-url url)))
 
-    (if (= (length properties) 1)
-	(signal 'file-error (list "Opening directory" "not a directory" url)))
+    (when (and (= (length properties) 1)
+	       (not (url-dav-file-directory-p url)))
+      (signal 'file-error (list "Opening directory" "not a directory" url)))
 
     (while properties
       (setq child-props (pop properties)
@@ -791,10 +798,13 @@
 	  nil
 
 	;; Fully expand the URL and then rip off the beginning if we
-	;; are not supposed to return fully-qualified names.
+	;; are not supposed to return fully-qualified names.  
 	(setq child-url (url-expand-file-name child-url parsed-url))
 	(if (not full)
-	    (setq child-url (substring child-url (length url))))
+	    ;; Parts of the URL might be hex'ed.
+	    (setq child-url (url-unhex-string
+			     (substring (url-hexify-string child-url)
+					(length (url-hexify-string url))))))
 
 	;; We don't want '/' as the last character in filenames...
 	(if (string-match "/$" child-url)
@@ -814,7 +824,8 @@
 (defun url-dav-file-directory-p (url)
   "Return t if URL names an existing DAV collection."
   (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype)))))
-    (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection)))
+    (when (member 'DAV:collection (plist-get properties 'DAV:resourcetype))
+      t)))
 
 (defun url-dav-make-directory (url &optional parents)
   "Create the directory DIR and any nonexistent parent dirs."