54695
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
1 ;;; url-dav.el --- WebDAV support
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
2
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
4
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
5 ;; Author: Bill Perry <wmperry@gnu.org>
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
6 ;; Maintainer: Bill Perry <wmperry@gnu.org>
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
7 ;; Keywords: url, vc
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
8
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
10 ;; it under the terms of the GNU General Public License as published by
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
12 ;; any later version.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
13
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
17 ;; GNU General Public License for more details.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
18
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
19 ;; You should have received a copy of the GNU General Public License
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
22 ;; Boston, MA 02111-1307, USA.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
23
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
24 (eval-when-compile
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
25 (require 'cl))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
26
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
27 (require 'xml)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
28 (require 'url-util)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
29 (require 'url-handlers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
30
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
31 (defvar url-dav-supported-protocols '(1 2)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
32 "List of supported DAV versions.")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
33
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
34 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
35 (defun url-dav-supported-p (url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
36 (and (featurep 'xml)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
37 (fboundp 'xml-expand-namespace)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
38 (intersection url-dav-supported-protocols
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
39 (plist-get (url-http-options url) 'dav))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
40
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
41 (defun url-dav-node-text (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
42 "Return the text data from the XML node NODE."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
43 (mapconcat (lambda (txt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
44 (if (stringp txt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
45 txt
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
46 "")) (xml-node-children node) " "))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
47
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
48
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
49 ;;; Parsing routines for the actual node contents.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
50 ;;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
51 ;;; I am not incredibly happy with how this code looks/works right
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
52 ;;; now, but it DOES work, and if we get the API right, our callers
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
53 ;;; won't have to worry about the internal representation.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
54
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
55 (defconst url-dav-datatype-attribute
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
56 'urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/dt)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
57
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
58 (defun url-dav-process-integer-property (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
59 (truncate (string-to-number (url-dav-node-text node))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
60
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
61 (defun url-dav-process-number-property (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
62 (string-to-number (url-dav-node-text node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
63
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
64 (defconst url-dav-iso8601-regexp
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
65 (let* ((dash "-?")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
66 (colon ":?")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
67 (4digit "\\([0-9][0-9][0-9][0-9]\\)")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
68 (2digit "\\([0-9][0-9]\\)")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
69 (date-fullyear 4digit)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
70 (date-month 2digit)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
71 (date-mday 2digit)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
72 (time-hour 2digit)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
73 (time-minute 2digit)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
74 (time-second 2digit)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
75 (time-secfrac "\\(\\.[0-9]+\\)?")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
76 (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
77 (time-offset (concat "Z" time-numoffset))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
78 (partial-time (concat time-hour colon time-minute colon time-second
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
79 time-secfrac))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
80 (full-date (concat date-fullyear dash date-month dash date-mday))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
81 (full-time (concat partial-time time-offset))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
82 (date-time (concat full-date "T" full-time)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
83 (list (concat "^" full-date)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
84 (concat "T" partial-time)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
85 (concat "Z" time-numoffset)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
86 "List of regular expressions matching iso8601 dates.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
87 1st regular expression matches the date.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
88 2nd regular expression matches the time.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
89 3rd regular expression matches the (optional) timezone specification.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
90 ")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
91
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
92 (defun url-dav-process-date-property (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
93 (require 'parse-time)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
94 (let* ((date-re (nth 0 url-dav-iso8601-regexp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
95 (time-re (nth 1 url-dav-iso8601-regexp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
96 (tz-re (nth 2 url-dav-iso8601-regexp))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
97 (date-string (url-dav-node-text node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
98 re-start
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
99 time seconds minute hour fractional-seconds
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
100 day month year day-of-week dst tz)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
101 ;; We need to populate 'time' with
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
102 ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
103
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
104 ;; Nobody else handles iso8601 correctly, lets do it ourselves.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
105 (when (string-match date-re date-string re-start)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
106 (setq year (string-to-int (match-string 1 date-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
107 month (string-to-int (match-string 2 date-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
108 day (string-to-int (match-string 3 date-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
109 re-start (match-end 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
110 (when (string-match time-re date-string re-start)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
111 (setq hour (string-to-int (match-string 1 date-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
112 minute (string-to-int (match-string 2 date-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
113 seconds (string-to-int (match-string 3 date-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
114 fractional-seconds (string-to-int (or
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
115 (match-string 4 date-string)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
116 "0"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
117 re-start (match-end 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
118 (when (string-match tz-re date-string re-start)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
119 (setq tz (match-string 1 date-string)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
120 (url-debug 'dav "Parsed iso8601%s date" (if tz "tz" ""))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
121 (setq time (list seconds minute hour day month year day-of-week dst tz))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
122
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
123 ;; Fall back to having Gnus do fancy things for us.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
124 (when (not time)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
125 (setq time (parse-time-string date-string)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
126
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
127 (if time
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
128 (setq time (apply 'encode-time time))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
129 (url-debug 'dav "Unable to decode date (%S) (%s)"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
130 (xml-node-name node) date-string))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
131 time))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
132
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
133 (defun url-dav-process-boolean-property (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
134 (/= 0 (string-to-int (url-dav-node-text node))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
135
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
136 (defun url-dav-process-uri-property (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
137 ;; Returns a parsed representation of the URL...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
138 (url-generic-parse-url (url-dav-node-text node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
139
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
140 (defun url-dav-find-parser (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
141 "Find a function to parse the XML node NODE."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
142 (or (get (xml-node-name node) 'dav-parser)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
143 (let ((fn (intern (format "url-dav-process-%s" (xml-node-name node)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
144 (if (not (fboundp fn))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
145 (setq fn 'url-dav-node-text)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
146 (put (xml-node-name node) 'dav-parser fn))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
147 fn)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
148
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
149 (defmacro url-dav-dispatch-node (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
150 `(funcall (url-dav-find-parser ,node) ,node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
151
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
152 (defun url-dav-process-DAV:prop (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
153 ;; A prop node has content model of ANY
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
154 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
155 ;; Some predefined nodes have special meanings though.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
156 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
157 ;; DAV:supportedlock - list of DAV:lockentry
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
158 ;; DAV:source
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
159 ;; DAV:iscollection - boolean
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
160 ;; DAV:getcontentlength - integer
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
161 ;; DAV:ishidden - boolean
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
162 ;; DAV:getcontenttype - string
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
163 ;; DAV:resourcetype - node who's name is the resource type
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
164 ;; DAV:getlastmodified - date
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
165 ;; DAV:creationdate - date
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
166 ;; DAV:displayname - string
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
167 ;; DAV:getetag - unknown
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
168 (let ((children (xml-node-children node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
169 (node-type nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
170 (props nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
171 (value nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
172 (handler-func nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
173 (when (not children)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
174 (error "No child nodes in DAV:prop"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
175
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
176 (while children
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
177 (setq node (car children)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
178 node-type (intern
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
179 (or
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
180 (cdr-safe (assq url-dav-datatype-attribute
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
181 (xml-node-attributes node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
182 "unknown"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
183 value nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
184
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
185 (case node-type
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
186 ((dateTime.iso8601tz
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
187 dateTime.iso8601
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
188 dateTime.tz
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
189 dateTime.rfc1123
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
190 dateTime
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
191 date) ; date is our 'special' one...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
192 ;; Some type of date/time string.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
193 (setq value (url-dav-process-date-property node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
194 (int
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
195 ;; Integer type...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
196 (setq value (url-dav-process-integer-property node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
197 ((number float)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
198 (setq value (url-dav-process-number-property node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
199 (boolean
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
200 (setq value (url-dav-process-boolean-property node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
201 (uri
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
202 (setq value (url-dav-process-uri-property node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
203 (otherwise
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
204 (if (not (eq node-type 'unknown))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
205 (url-debug 'dav "Unknown data type in url-dav-process-prop: %s"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
206 node-type))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
207 (setq value (url-dav-dispatch-node node))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
208
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
209 (setq props (plist-put props (xml-node-name node) value)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
210 children (cdr children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
211 props))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
212
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
213 (defun url-dav-process-DAV:supportedlock (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
214 ;; DAV:supportedlock is a list of DAV:lockentry items.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
215 ;; DAV:lockentry in turn contains a DAV:lockscope and DAV:locktype.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
216 ;; The DAV:lockscope must have a single node beneath it, ditto for
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
217 ;; DAV:locktype.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
218 (let ((children (xml-node-children node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
219 (results nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
220 scope type)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
221 (while children
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
222 (when (and (not (stringp (car children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
223 (eq (xml-node-name (car children)) 'DAV:lockentry))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
224 (setq scope (assq 'DAV:lockscope (xml-node-children (car children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
225 type (assq 'DAV:locktype (xml-node-children (car children))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
226 (when (and scope type)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
227 (setq scope (xml-node-name (car (xml-node-children scope)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
228 type (xml-node-name (car (xml-node-children type))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
229 (push (cons type scope) results)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
230 (setq children (cdr children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
231 results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
232
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
233 (defun url-dav-process-subnode-property (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
234 ;; Returns a list of child node names.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
235 (delq nil (mapcar 'car-safe (xml-node-children node))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
236
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
237 (defalias 'url-dav-process-DAV:depth 'url-dav-process-integer-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
238 (defalias 'url-dav-process-DAV:resourcetype 'url-dav-process-subnode-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
239 (defalias 'url-dav-process-DAV:locktype 'url-dav-process-subnode-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
240 (defalias 'url-dav-process-DAV:lockscope 'url-dav-process-subnode-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
241 (defalias 'url-dav-process-DAV:getcontentlength 'url-dav-process-integer-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
242 (defalias 'url-dav-process-DAV:getlastmodified 'url-dav-process-date-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
243 (defalias 'url-dav-process-DAV:creationdate 'url-dav-process-date-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
244 (defalias 'url-dav-process-DAV:iscollection 'url-dav-process-boolean-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
245 (defalias 'url-dav-process-DAV:ishidden 'url-dav-process-boolean-property)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
246
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
247 (defun url-dav-process-DAV:locktoken (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
248 ;; DAV:locktoken can have one or more DAV:href children.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
249 (delq nil (mapcar (lambda (n)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
250 (if (stringp n)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
251 n
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
252 (url-dav-dispatch-node n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
253 (xml-node-children node))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
254
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
255 (defun url-dav-process-DAV:owner (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
256 ;; DAV:owner can contain anything.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
257 (delq nil (mapcar (lambda (n)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
258 (if (stringp n)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
259 n
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
260 (url-dav-dispatch-node n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
261 (xml-node-children node))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
262
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
263 (defun url-dav-process-DAV:activelock (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
264 ;; DAV:activelock can contain:
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
265 ;; DAV:lockscope
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
266 ;; DAV:locktype
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
267 ;; DAV:depth
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
268 ;; DAV:owner (optional)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
269 ;; DAV:timeout (optional)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
270 ;; DAV:locktoken (optional)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
271 (let ((children (xml-node-children node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
272 (results nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
273 (while children
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
274 (if (listp (car children))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
275 (push (cons (xml-node-name (car children))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
276 (url-dav-dispatch-node (car children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
277 results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
278 (setq children (cdr children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
279 results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
280
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
281 (defun url-dav-process-DAV:lockdiscovery (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
282 ;; Can only contain a list of DAV:activelock objects.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
283 (let ((children (xml-node-children node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
284 (results nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
285 (while children
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
286 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
287 ((stringp (car children))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
288 ;; text node? why?
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
289 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
290 ((eq (xml-node-name (car children)) 'DAV:activelock)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
291 (push (url-dav-dispatch-node (car children)) results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
292 (t
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
293 ;; Ignore unknown nodes...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
294 nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
295 (setq children (cdr children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
296 results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
297
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
298 (defun url-dav-process-DAV:status (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
299 ;; The node contains a standard HTTP/1.1 response line... we really
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
300 ;; only care about the numeric status code.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
301 (let ((status (url-dav-node-text node)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
302 (if (string-match "\\`[ \r\t\n]*HTTP/[0-9.]+ \\([0-9]+\\)" status)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
303 (string-to-int (match-string 1 status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
304 500)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
305
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
306 (defun url-dav-process-DAV:propstat (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
307 ;; A propstate node can have the following children...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
308 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
309 ;; DAV:prop - a list of properties and values
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
310 ;; DAV:status - An HTTP/1.1 status line
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
311 (let ((children (xml-node-children node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
312 (props nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
313 (status nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
314 (when (not children)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
315 (error "No child nodes in DAV:propstat"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
316
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
317 (setq props (url-dav-dispatch-node (assq 'DAV:prop children))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
318 status (url-dav-dispatch-node (assq 'DAV:status children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
319
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
320 ;; Need to parse out the HTTP status
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
321 (setq props (plist-put props 'DAV:status status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
322 props))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
323
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
324 (defun url-dav-process-DAV:response (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
325 (let ((children (xml-node-children node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
326 (propstat nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
327 (href))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
328 (when (not children)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
329 (error "No child nodes in DAV:response"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
330
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
331 ;; A response node can have the following children...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
332 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
333 ;; DAV:href - URL the response is for.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
334 ;; DAV:propstat - see url-dav-process-propstat
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
335 ;; DAV:responsedescription - text description of the response
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
336 (setq propstat (assq 'DAV:propstat children)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
337 href (assq 'DAV:href children))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
338
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
339 (when (not href)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
340 (error "No href in DAV:response"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
341
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
342 (when (not propstat)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
343 (error "No propstat in DAV:response"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
344
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
345 (setq propstat (url-dav-dispatch-node propstat)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
346 href (url-dav-dispatch-node href))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
347 (cons href propstat)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
348
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
349 (defun url-dav-process-DAV:multistatus (node)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
350 (let ((children (xml-node-children node))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
351 (results nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
352 (while children
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
353 (push (url-dav-dispatch-node (car children)) results)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
354 (setq children (cdr children)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
355 results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
356
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
357
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
358 ;;; DAV request/response generation/processing
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
359 (defun url-dav-process-response (buffer url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
360 "Parses a WebDAV response from BUFFER, interpreting it relative to URL.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
361
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
362 The buffer must have been retrieved by HTTP or HTTPS and contain an
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
363 XML document.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
364 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
365 (declare (special url-http-content-type
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
366 url-http-response-status
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
367 url-http-end-of-headers))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
368 (let ((tree nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
369 (overall-status nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
370 (when buffer
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
371 (unwind-protect
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
372 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
373 (set-buffer buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
374 (goto-char url-http-end-of-headers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
375 (setq overall-status url-http-response-status)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
376
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
377 ;; XML documents can be transferred as either text/xml or
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
378 ;; application/xml, and we are required to accept both of
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
379 ;; them.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
380 (if (and
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
381 url-http-content-type
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
382 (or (string-match "^text/xml" url-http-content-type)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
383 (string-match "^application/xml" url-http-content-type)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
384 (setq tree (xml-parse-region (point) (point-max)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
385 ;; Clean up after ourselves.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
386 '(kill-buffer buffer)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
387
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
388 ;; We should now be
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
389 (if (eq (xml-node-name (car tree)) 'DAV:multistatus)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
390 (url-dav-dispatch-node (car tree))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
391 (url-debug 'dav "Got back singleton response for URL(%S)" url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
392 (let ((properties (url-dav-dispatch-node (car tree))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
393 ;; We need to make sure we have a DAV:status node in there for
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
394 ;; higher-level code;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
395 (setq properties (plist-put properties 'DAV:status overall-status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
396 ;; Make this look like a DAV:multistatus parse tree so that
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
397 ;; nobody but us needs to know the difference.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
398 (list (cons url properties))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
399
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
400 (defun url-dav-request (url method tag body
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
401 &optional depth headers namespaces)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
402 "Performs WebDAV operation METHOD on URL. Returns the parsed responses.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
403 Automatically creates an XML request body if TAG is non-nil.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
404 BODY is the XML document fragment to be enclosed by <TAG></TAG>.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
405
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
406 DEPTH is how deep the request should propogate. Default is 0, meaning
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
407 it should apply only to URL. A negative number means to use
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
408 `Infinity' for the depth. Not all WebDAV servers support this depth
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
409 though.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
410
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
411 HEADERS is an assoc list of extra headers to send in the request.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
412
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
413 NAMESPACES is an assoc list of (NAMESPACE . EXPANSION), and these are
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
414 added to the <TAG> element. The DAV=DAV: namespace is automatically
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
415 added to this list, so most requests can just pass in nil.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
416 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
417 ;; Take care of the default value for depth...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
418 (setq depth (or depth 0))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
419
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
420 ;; Now lets translate it into something webdav can understand.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
421 (if (< depth 0)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
422 (setq depth "Infinity")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
423 (setq depth (int-to-string depth)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
424 (if (not (assoc "DAV" namespaces))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
425 (setq namespaces (cons '("DAV" . "DAV:") namespaces)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
426
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
427 (let* ((url-request-extra-headers `(("Depth" . ,depth)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
428 ("Content-type" . "text/xml")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
429 ,@headers))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
430 (url-request-method method)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
431 (url-request-data
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
432 (if tag
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
433 (concat
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
434 "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
435 "<" (symbol-name tag) " "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
436 ;; add in the appropriate namespaces...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
437 (mapconcat (lambda (ns)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
438 (concat "xmlns:" (car ns) "='" (cdr ns) "'"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
439 namespaces "\n ")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
440 ">\n"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
441 body
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
442 "</" (symbol-name tag) ">\n"))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
443 (url-dav-process-response (url-retrieve-synchronously url) url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
444
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
445 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
446 (defun url-dav-get-properties (url &optional attributes depth namespaces)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
447 "Return properties for URL, up to DEPTH levels deep.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
448
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
449 Returns an assoc list, where the key is the filename (possibly a full
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
450 URI), and the value is a standard property list of DAV property
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
451 names (ie: DAV:resourcetype).
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
452 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
453 (url-dav-request url "PROPFIND" 'DAV:propfind
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
454 (if attributes
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
455 (mapconcat (lambda (attr)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
456 (concat "<DAV:prop><"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
457 (symbol-name attr)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
458 "/></DAV:prop>"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
459 attributes "\n ")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
460 " <DAV:allprop/>")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
461 depth nil namespaces))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
462
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
463 (defmacro url-dav-http-success-p (status)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
464 "Return whether PROPERTIES was the result of a successful DAV request."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
465 `(= (/ (or ,status 500) 100) 2))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
466
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
467
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
468 ;;; Locking support
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
469 (defvar url-dav-lock-identifier (concat "mailto:" user-mail-address)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
470 "*URL used as contact information when creating locks in DAV.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
471 This will be used as the contents of the DAV:owner/DAV:href tag to
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
472 identify the owner of a LOCK when requesting it. This will be shown
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
473 to other users when the DAV:lockdiscovery property is requested, so
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
474 make sure you are comfortable with it leaking to the outside world.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
475 ")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
476
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
477 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
478 (defun url-dav-lock-resource (url exclusive &optional depth)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
479 "Request a lock on URL. If EXCLUSIVE is non-nil, get an exclusive lock.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
480 Optional 3rd argument DEPTH says how deep the lock should go, default is 0
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
481 \(lock only the resource and none of its children\).
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
482
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
483 Returns a cons-cell of (SUCCESSFUL-RESULTS . FAILURE-RESULTS).
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
484 SUCCESSFUL-RESULTS is a list of (URL STATUS locktoken).
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
485 FAILURE-RESULTS is a list of (URL STATUS).
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
486 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
487 (setq exclusive (if exclusive "<DAV:exclusive/>" "<DAV:shared/>"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
488 (let* ((body
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
489 (concat
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
490 " <DAV:lockscope>" exclusive "</DAV:lockscope>\n"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
491 " <DAV:locktype> <DAV:write/> </DAV:locktype>\n"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
492 " <DAV:owner>\n"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
493 " <DAV:href>" url-dav-lock-identifier "</DAV:href>\n"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
494 " </DAV:owner>\n"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
495 (response nil) ; Responses to the LOCK request
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
496 (result nil) ; For walking thru the response list
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
497 (child-url nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
498 (child-status nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
499 (failures nil) ; List of failure cases (URL . STATUS)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
500 (successes nil)) ; List of success cases (URL . STATUS)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
501 (setq response (url-dav-request url "LOCK" 'DAV:lockinfo body
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
502 depth '(("Timeout" . "Infinite"))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
503
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
504 ;; Get the parent URL ready for expand-file-name
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
505 (if (not (vectorp url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
506 (setq url (url-generic-parse-url url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
507
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
508 ;; Walk thru the response list, fully expand the URL, and grab the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
509 ;; status code.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
510 (while response
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
511 (setq result (pop response)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
512 child-url (url-expand-file-name (pop result) url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
513 child-status (or (plist-get result 'DAV:status) 500))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
514 (if (url-dav-http-success-p child-status)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
515 (push (list url child-status "huh") successes)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
516 (push (list url child-status) failures)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
517 (cons successes failures)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
518
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
519 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
520 (defun url-dav-active-locks (url &optional depth)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
521 "Return an assoc list of all active locks on URL."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
522 (let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
523 (properties nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
524 (child nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
525 (child-url nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
526 (child-results nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
527 (results nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
528 (if (not (vectorp url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
529 (setq url (url-generic-parse-url url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
530
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
531 (while response
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
532 (setq child (pop response)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
533 child-url (pop child)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
534 child-results nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
535 (when (and (url-dav-http-success-p (plist-get child 'DAV:status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
536 (setq child (plist-get child 'DAV:lockdiscovery)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
537 ;; After our parser has had its way with it, The
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
538 ;; DAV:lockdiscovery property is a list of DAV:activelock
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
539 ;; objects, which are comprised of DAV:activelocks, which
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
540 ;; assoc lists of properties and values.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
541 (while child
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
542 (if (assq 'DAV:locktoken (car child))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
543 (let ((tokens (cdr (assq 'DAV:locktoken (car child))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
544 (owners (cdr (assq 'DAV:owner (car child)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
545 (dolist (token tokens)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
546 (dolist (owner owners)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
547 (push (cons token owner) child-results)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
548 (pop child)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
549 (if child-results
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
550 (push (cons (url-expand-file-name child-url url) child-results)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
551 results)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
552 results))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
553
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
554 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
555 (defun url-dav-unlock-resource (url lock-token)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
556 "Release the lock on URL represented by LOCK-TOKEN.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
557 Returns `t' iff the lock was successfully released.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
558 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
559 (declare (special url-http-response-status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
560 (let* ((url-request-extra-headers (list (cons "Lock-Token"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
561 (concat "<" lock-token ">"))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
562 (url-request-method "UNLOCK")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
563 (url-request-data nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
564 (buffer (url-retrieve-synchronously url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
565 (result nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
566 (when buffer
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
567 (unwind-protect
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
568 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
569 (set-buffer buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
570 (setq result (url-dav-http-success-p url-http-response-status)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
571 (kill-buffer buffer)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
572 result))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
573
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
574
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
575 ;;; file-name-handler stuff
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
576 (defun url-dav-file-attributes-mode-string (properties)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
577 (let ((modes (make-string 10 ?-))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
578 (supported-locks (plist-get properties 'DAV:supportedlock))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
579 (executable-p (equal (plist-get properties 'http://apache.org/dav/props/executable)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
580 "T"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
581 (directory-p (memq 'DAV:collection (plist-get properties 'DAV:resourcetype)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
582 (readable t)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
583 (lock nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
584 ;; Assume we can read this, otherwise the PROPFIND would have
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
585 ;; failed.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
586 (when readable
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
587 (aset modes 1 ?r)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
588 (aset modes 4 ?r)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
589 (aset modes 7 ?r))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
590
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
591 (when directory-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
592 (aset modes 0 ?d))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
593
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
594 (when executable-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
595 (aset modes 3 ?x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
596 (aset modes 6 ?x)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
597 (aset modes 9 ?x))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
598
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
599 (while supported-locks
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
600 (setq lock (car supported-locks)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
601 supported-locks (cdr supported-locks))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
602 (case (car lock)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
603 (DAV:write
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
604 (case (cdr lock)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
605 (DAV:shared ; group permissions (possibly world)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
606 (aset modes 5 ?w))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
607 (DAV:exclusive
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
608 (aset modes 2 ?w)) ; owner permissions?
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
609 (otherwise
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
610 (url-debug 'dav "Unrecognized DAV:lockscope (%S)" (cdr lock)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
611 (otherwise
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
612 (url-debug 'dav "Unrecognized DAV:locktype (%S)" (car lock)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
613 modes))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
614
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
615 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
616 (defun url-dav-file-attributes (url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
617 (let ((properties (cdar (url-dav-get-properties url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
618 (attributes nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
619 (if (and properties
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
620 (url-dav-http-success-p (plist-get properties 'DAV:status)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
621 ;; We got a good DAV response back..
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
622 (setq attributes
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
623 (list
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
624 ;; t for directory, string for symbolic link, or nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
625 ;; Need to support DAV Bindings to figure out the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
626 ;; symbolic link issues.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
627 (if (memq 'DAV:collection (plist-get properties 'DAV:resourcetype)) t nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
628
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
629 ;; Number of links to file... Needs DAV Bindings.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
630 1
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
631
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
632 ;; File uid - no way to figure out?
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
633 0
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
634
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
635 ;; File gid - no way to figure out?
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
636 0
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
637
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
638 ;; Last access time - ???
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
639 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
640
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
641 ;; Last modification time
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
642 (plist-get properties 'DAV:getlastmodified)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
643
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
644 ;; Last status change time... just reuse last-modified
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
645 ;; for now.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
646 (plist-get properties 'DAV:getlastmodified)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
647
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
648 ;; size in bytes
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
649 (or (plist-get properties 'DAV:getcontentlength) 0)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
650
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
651 ;; file modes as a string like `ls -l'
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
652 ;;
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
653 ;; Should be able to build this up from the
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
654 ;; DAV:supportedlock attribute pretty easily. Getting
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
655 ;; the group info could be impossible though.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
656 (url-dav-file-attributes-mode-string properties)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
657
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
658 ;; t iff file's gid would change if it were deleted &
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
659 ;; recreated. No way for us to know that thru DAV.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
660 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
661
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
662 ;; inode number - meaningless
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
663 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
664
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
665 ;; device number - meaningless
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
666 nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
667 ;; Fall back to just the normal http way of doing things.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
668 (setq attributes (url-http-head-file-attributes url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
669 attributes))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
670
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
671 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
672 (defun url-dav-save-resource (url obj &optional content-type lock-token)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
673 "Save OBJ as URL using WebDAV.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
674 URL must be a fully qualified URL.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
675 OBJ may be a buffer or a string."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
676 (let ((buffer nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
677 (result nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
678 (url-request-extra-headers nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
679 (url-request-method "PUT")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
680 (url-request-data
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
681 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
682 ((bufferp obj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
683 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
684 (set-buffer obj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
685 (buffer-string)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
686 ((stringp obj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
687 obj)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
688 (t
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
689 (error "Invalid object to url-dav-save-resource")))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
690
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
691 (if lock-token
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
692 (push
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
693 (cons "If" (concat "(<" lock-token ">)"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
694 url-request-extra-headers))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
695
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
696 ;; Everything must always have a content-type when we submit it.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
697 (push
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
698 (cons "Content-type" (or content-type "application/octet-stream"))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
699 url-request-extra-headers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
700
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
701 ;; Do the save...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
702 (setq buffer (url-retrieve-synchronously url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
703
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
704 ;; Sanity checking
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
705 (when buffer
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
706 (unwind-protect
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
707 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
708 (set-buffer buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
709 (setq result (url-dav-http-success-p url-http-response-status)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
710 (kill-buffer buffer)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
711 result))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
712
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
713 (eval-when-compile
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
714 (defmacro url-dav-delete-something (url lock-token &rest error-checking)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
715 "Delete URL completely, with no sanity checking whatsoever. DO NOT USE.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
716 This is defined as a macro that will not be visible from compiled files.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
717 Use with care, and even then think three times.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
718 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
719 `(progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
720 ,@error-checking
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
721 (url-dav-request ,url "DELETE" nil nil -1
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
722 (if ,lock-token
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
723 (list
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
724 (cons "If"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
725 (concat "(<" ,lock-token ">)"))))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
726
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
727
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
728 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
729 (defun url-dav-delete-directory (url &optional recursive lock-token)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
730 "Delete the WebDAV collection URL.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
731 If optional second argument RECURSIVE is non-nil, then delete all
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
732 files in the collection as well.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
733 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
734 (let ((status nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
735 (props nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
736 (props nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
737 (setq props (url-dav-delete-something
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
738 url lock-token
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
739 (setq props (url-dav-get-properties url '(DAV:getcontenttype) 1))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
740 (if (and (not recursive)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
741 (/= (length props) 1))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
742 (signal 'file-error (list "Removing directory"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
743 "directory not empty" url)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
744
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
745 (mapc (lambda (result)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
746 (setq status (plist-get (cdr result) 'DAV:status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
747 (if (not (url-dav-http-success-p status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
748 (signal 'file-error (list "Removing directory"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
749 "Errror removing"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
750 (car result) status))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
751 props))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
752 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
753
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
754 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
755 (defun url-dav-delete-file (url &optional lock-token)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
756 "Delete file named URL."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
757 (let ((props nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
758 (status nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
759 (setq props (url-dav-delete-something
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
760 url lock-token
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
761 (setq props (url-dav-get-properties url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
762 (if (eq (plist-get (cdar props) 'DAV:resourcetype) 'DAV:collection)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
763 (signal 'file-error (list "Removing old name" "is a collection" url)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
764
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
765 (mapc (lambda (result)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
766 (setq status (plist-get (cdr result) 'DAV:status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
767 (if (not (url-dav-http-success-p status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
768 (signal 'file-error (list "Removing old name"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
769 "Errror removing"
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
770 (car result) status))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
771 props))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
772 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
773
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
774 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
775 (defun url-dav-directory-files (url &optional full match nosort files-only)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
776 "Return a list of names of files in DIRECTORY.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
777 There are three optional arguments:
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
778 If FULL is non-nil, return absolute file names. Otherwise return names
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
779 that are relative to the specified directory.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
780 If MATCH is non-nil, mention only file names that match the regexp MATCH.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
781 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
782 NOSORT is useful if you plan to sort the result yourself.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
783 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
784 (let ((properties (url-dav-get-properties url '(DAV:resourcetype) 1))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
785 (child-url nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
786 (child-props nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
787 (files nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
788 (parsed-url (url-generic-parse-url url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
789
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
790 (if (= (length properties) 1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
791 (signal 'file-error (list "Opening directory" "not a directory" url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
792
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
793 (while properties
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
794 (setq child-props (pop properties)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
795 child-url (pop child-props))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
796 (if (and (eq (plist-get child-props 'DAV:resourcetype) 'DAV:collection)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
797 files-only)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
798 ;; It is a directory, and we were told to return just files.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
799 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
800
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
801 ;; Fully expand the URL and then rip off the beginning if we
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
802 ;; are not supposed to return fully-qualified names.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
803 (setq child-url (url-expand-file-name child-url parsed-url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
804 (if (not full)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
805 (setq child-url (substring child-url (length url))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
806
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
807 ;; We don't want '/' as the last character in filenames...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
808 (if (string-match "/$" child-url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
809 (setq child-url (substring child-url 0 -1)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
810
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
811 ;; If we have a match criteria, then apply it.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
812 (if (or (and match (not (string-match match child-url)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
813 (string= child-url "")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
814 (string= child-url url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
815 nil
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
816 (push child-url files))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
817
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
818 (if nosort
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
819 files
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
820 (sort files 'string-lessp))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
821
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
822 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
823 (defun url-dav-file-directory-p (url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
824 "Return t if URL names an existing DAV collection."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
825 (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
826 (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
827
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
828 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
829 (defun url-dav-make-directory (url &optional parents)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
830 "Create the directory DIR and any nonexistent parent dirs."
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
831 (declare (special url-http-response-status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
832 (let* ((url-request-extra-headers nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
833 (url-request-method "MKCOL")
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
834 (url-request-data nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
835 (buffer (url-retrieve-synchronously url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
836 (result nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
837 (when buffer
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
838 (unwind-protect
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
839 (save-excursion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
840 (set-buffer buffer)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
841 (case url-http-response-status
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
842 (201 ; Collection created in its entirety
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
843 (setq result t))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
844 (403 ; Forbidden
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
845 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
846 (405 ; Method not allowed
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
847 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
848 (409 ; Conflict
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
849 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
850 (415 ; Unsupported media type (WTF?)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
851 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
852 (507 ; Insufficient storage
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
853 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
854 (otherwise
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
855 nil)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
856 (kill-buffer buffer)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
857 result))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
858
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
859 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
860 (defun url-dav-rename-file (oldname newname &optional overwrite)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
861 (if (not (and (string-match url-handler-regexp oldname)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
862 (string-match url-handler-regexp newname)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
863 (signal 'file-error "Cannot rename between different URL backends" oldname newname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
864
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
865 (let* ((headers nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
866 (props nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
867 (status nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
868 (directory-p (url-dav-file-directory-p oldname))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
869 (exists-p (url-http-file-exists-p newname)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
870
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
871 (if (and exists-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
872 (or
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
873 (null overwrite)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
874 (and (numberp overwrite)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
875 (not (yes-or-no-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
876 (format "File %s already exists; rename to it anyway? "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
877 newname))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
878 (signal 'file-already-exists (list "File already exists" newname)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
879
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
880 ;; Honor the overwrite flag...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
881 (if overwrite (push '("Overwrite" . "T") headers))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
882
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
883 ;; Have to tell them where to copy it to!
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
884 (push (cons "Destination" newname) headers)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
885
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
886 ;; Always send a depth of -1 in case we are moving a collection.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
887 (setq props (url-dav-request oldname "MOVE" nil nil (if directory-p -1 0)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
888 headers))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
889
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
890 (mapc (lambda (result)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
891 (setq status (plist-get (cdr result) 'DAV:status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
892
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
893 (if (not (url-dav-http-success-p status))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
894 (signal 'file-error (list "Renaming" oldname newname status))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
895 props)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
896 t))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
897
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
898 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
899 (defun url-dav-file-name-all-completions (file url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
900 "Return a list of all completions of file name FILE in directory DIRECTORY.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
901 These are all file names in directory DIRECTORY which begin with FILE.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
902 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
903 (url-dav-directory-files url nil (concat "^" file ".*")))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
904
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
905 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
906 (defun url-dav-file-name-completion (file url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
907 "Complete file name FILE in directory DIRECTORY.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
908 Returns the longest string
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
909 common to all file names in DIRECTORY that start with FILE.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
910 If there is only one and FILE matches it exactly, returns t.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
911 Returns nil if DIR contains no name starting with FILE.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
912 "
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
913 (let ((matches (url-dav-file-name-all-completions file url))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
914 (result nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
915 (cond
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
916 ((null matches)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
917 ;; No matches
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
918 nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
919 ((and (= (length matches) 1)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
920 (string= file (car matches)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
921 ;; Only one file and FILE matches it exactly...
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
922 t)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
923 (t
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
924 ;; Need to figure out the longest string that they have in commmon
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
925 (setq matches (sort matches (lambda (a b) (> (length a) (length b)))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
926 (let ((n (length file))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
927 (searching t)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
928 (regexp nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
929 (failed nil))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
930 (while (and searching
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
931 (< n (length (car matches))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
932 (setq regexp (concat "^" (substring (car matches) 0 (1+ n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
933 failed nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
934 (dolist (potential matches)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
935 (if (not (string-match regexp potential))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
936 (setq failed t)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
937 (if failed
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
938 (setq searching nil)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
939 (incf n)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
940 (substring (car matches) 0 n))))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
941
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
942 (defun url-dav-register-handler (op)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
943 (put op 'url-file-handlers (intern-soft (format "url-dav-%s" op))))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
944
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
945 (mapcar 'url-dav-register-handler
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
946 '(file-name-all-completions
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
947 file-name-completion
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
948 rename-file
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
949 make-directory
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
950 file-directory-p
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
951 directory-files
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
952 delete-file
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
953 delete-directory
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
954 file-attributes))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
955
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
956
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
957 ;;; Version Control backend cruft
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
958
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
959 ;(put 'vc-registered 'url-file-handlers 'url-dav-vc-registered)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
960
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
961 ;;;###autoload
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
962 (defun url-dav-vc-registered (url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
963 (if (and (string-match "\\`https?" url)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
964 (plist-get (url-http-options url) 'dav))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
965 (progn
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
966 (vc-file-setprop url 'vc-backend 'dav)
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
967 t)))
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
968
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
969
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
970 ;;; Miscellaneous stuff.
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
971
|
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff
changeset
|
972 (provide 'url-dav)
|
54699
|
973
|
|
974 ;;; arch-tag: 2b14b7b3-888a-49b8-a490-17276a40e78e
|