Commit | Line | Data |
---|---|---|
eeb44655 MA |
1 | ;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2009-2014 Free Software Foundation, Inc. |
eeb44655 MA |
4 | |
5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
6 | ;; Keywords: comm, processes | |
bd78fa1d | 7 | ;; Package: tramp |
eeb44655 | 8 | |
e65f32c1 GM |
9 | ;; This file is part of GNU Emacs. |
10 | ||
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
eeb44655 MA |
12 | ;; it under the terms of the GNU General Public License as published by |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
e65f32c1 GM |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
eeb44655 MA |
20 | |
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ||
26 | ;; Access functions for the GVFS daemon from Tramp. Tested with GVFS | |
3675b169 | 27 | ;; 1.0 (Ubuntu 8.10, Gnome 2.24). It has been reported also to run |
f0dbdc25 MA |
28 | ;; with GVFS 0.2.5 (Ubuntu 8.04, Gnome 2.22), but there is an |
29 | ;; incompatibility with the mount_info structure, which has been | |
30 | ;; worked around. | |
eeb44655 | 31 | |
3675b169 | 32 | ;; It has also been tested with GVFS 1.6 (Ubuntu 10.04, Gnome 2.30), |
1efeec86 MA |
33 | ;; where the default_location has been added to mount_info (see |
34 | ;; <https://bugzilla.gnome.org/show_bug.cgi?id=561998>. | |
35 | ||
3675b169 MA |
36 | ;; With GVFS 1.14 (Ubuntu 12.10, Gnome 3.6) the interfaces have been |
37 | ;; changed, again. So we must introspect the D-Bus interfaces. | |
38 | ||
eeb44655 MA |
39 | ;; All actions to mount a remote location, and to retrieve mount |
40 | ;; information, are performed by D-Bus messages. File operations | |
41 | ;; themselves are performed via the mounted filesystem in ~/.gvfs. | |
f0dbdc25 | 42 | ;; Consequently, GNU Emacs 23.1 with enabled D-Bus bindings is a |
eeb44655 MA |
43 | ;; precondition. |
44 | ||
3675b169 MA |
45 | ;; The GVFS D-Bus interface is said to be unstable. There were even |
46 | ;; no introspection data before GVFS 1.14. The interface, as | |
47 | ;; discovered during development time, is given in respective | |
48 | ;; comments. | |
eeb44655 MA |
49 | |
50 | ;; The customer option `tramp-gvfs-methods' contains the list of | |
d557e7a6 MA |
51 | ;; supported connection methods. Per default, these are "dav", |
52 | ;; "davs", "obex" and "synce". Note that with "obex" it might be | |
53 | ;; necessary to pair with the other bluetooth device, if it hasn't | |
54 | ;; been done already. There might be also some few seconds delay in | |
55 | ;; discovering available bluetooth devices. | |
eeb44655 MA |
56 | |
57 | ;; Other possible connection methods are "ftp", "sftp" and "smb". | |
58 | ;; When one of these methods is added to the list, the remote access | |
59 | ;; for that method is performed via GVFS instead of the native Tramp | |
60 | ;; implementation. | |
61 | ||
62 | ;; GVFS offers even more connection methods. The complete list of | |
63 | ;; connection methods of the actual GVFS implementation can be | |
64 | ;; retrieved by: | |
65 | ;; | |
66 | ;; (message | |
67 | ;; "%s" | |
68 | ;; (mapcar | |
69 | ;; 'car | |
70 | ;; (dbus-call-method | |
71 | ;; :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker | |
72 | ;; tramp-gvfs-interface-mounttracker "listMountableInfo"))) | |
73 | ||
74 | ;; Note that all other connection methods are not tested, beside the | |
75 | ;; ones offered for customization in `tramp-gvfs-methods'. If you | |
76 | ;; request an additional connection method to be supported, please | |
77 | ;; drop me a note. | |
78 | ||
79 | ;; For hostname completion, information is retrieved either from the | |
d557e7a6 MA |
80 | ;; bluez daemon (for the "obex" method), the hal daemon (for the |
81 | ;; "synce" method), or from the zeroconf daemon (for the "dav", | |
82 | ;; "davs", and "sftp" methods). The zeroconf daemon is pre-configured | |
83 | ;; to discover services in the "local" domain. If another domain | |
84 | ;; shall be used for discovering services, the customer option | |
85 | ;; `tramp-gvfs-zeroconf-domain' can be set accordingly. | |
eeb44655 MA |
86 | |
87 | ;; Restrictions: | |
88 | ||
89 | ;; * The current GVFS implementation does not allow to write on the | |
90 | ;; remote bluetooth device via OBEX. | |
91 | ;; | |
92 | ;; * Two shares of the same SMB server cannot be mounted in parallel. | |
93 | ||
94 | ;;; Code: | |
95 | ||
96 | ;; D-Bus support in the Emacs core can be disabled with configuration | |
97 | ;; option "--without-dbus". Declare used subroutines and variables. | |
eeb44655 | 98 | (declare-function dbus-get-unique-name "dbusbind.c") |
eeb44655 | 99 | |
eeb44655 | 100 | (require 'tramp) |
03c1ad43 | 101 | |
eeb44655 MA |
102 | (require 'dbus) |
103 | (require 'url-parse) | |
1efeec86 | 104 | (require 'url-util) |
eeb44655 MA |
105 | (require 'zeroconf) |
106 | ||
b74f0d96 MA |
107 | ;; Pacify byte-compiler. |
108 | (eval-when-compile | |
109 | (require 'cl) | |
f95527c8 MA |
110 | (require 'custom)) |
111 | (defvar ls-lisp-use-insert-directory-program) | |
b74f0d96 | 112 | |
0f34aa77 | 113 | ;;;###tramp-autoload |
7ae3ea65 | 114 | (defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce") |
fb7ada5f | 115 | "List of methods for remote files, accessed with GVFS." |
eeb44655 | 116 | :group 'tramp |
f0dbdc25 | 117 | :version "23.2" |
eeb44655 MA |
118 | :type '(repeat (choice (const "dav") |
119 | (const "davs") | |
120 | (const "ftp") | |
121 | (const "obex") | |
122 | (const "sftp") | |
7ae3ea65 MA |
123 | (const "smb") |
124 | (const "synce")))) | |
eeb44655 | 125 | |
d557e7a6 MA |
126 | ;; Add a default for `tramp-default-user-alist'. Rule: For the SYNCE |
127 | ;; method, no user is chosen. | |
b191c9d9 | 128 | ;;;###tramp-autoload |
66feec8b | 129 | (add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil)) |
d557e7a6 | 130 | |
eeb44655 | 131 | (defcustom tramp-gvfs-zeroconf-domain "local" |
fb7ada5f | 132 | "Zeroconf domain to be used for discovering services, like host names." |
eeb44655 | 133 | :group 'tramp |
f0dbdc25 | 134 | :version "23.2" |
eeb44655 MA |
135 | :type 'string) |
136 | ||
137 | ;; Add the methods to `tramp-methods', in order to allow minibuffer | |
138 | ;; completion. | |
0f34aa77 MA |
139 | ;;;###tramp-autoload |
140 | (when (featurep 'dbusbind) | |
141 | (dolist (elt tramp-gvfs-methods) | |
142 | (unless (assoc elt tramp-methods) | |
143 | (add-to-list 'tramp-methods (cons elt nil))))) | |
eeb44655 | 144 | |
eeb44655 | 145 | (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp") |
97610156 | 146 | "The preceding object path for own objects.") |
eeb44655 MA |
147 | |
148 | (defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon" | |
149 | "The well known name of the GVFS daemon.") | |
150 | ||
91aafa16 MA |
151 | ;; D-Bus integration is available since Emacs 23 on some system types. |
152 | ;; We don't call `dbus-ping', because this would load dbus.el. | |
153 | (defconst tramp-gvfs-enabled | |
154 | (ignore-errors | |
155 | (and (featurep 'dbusbind) | |
2f7e72f8 | 156 | (tramp-compat-funcall 'dbus-get-unique-name :system) |
91aafa16 MA |
157 | (tramp-compat-funcall 'dbus-get-unique-name :session) |
158 | (or (tramp-compat-process-running-p "gvfs-fuse-daemon") | |
159 | (tramp-compat-process-running-p "gvfsd-fuse")))) | |
160 | "Non-nil when GVFS is available.") | |
eeb44655 MA |
161 | |
162 | (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker" | |
163 | "The object path of the GVFS daemon.") | |
164 | ||
165 | (defconst tramp-gvfs-interface-mounttracker "org.gtk.vfs.MountTracker" | |
166 | "The mount tracking interface in the GVFS daemon.") | |
167 | ||
3675b169 MA |
168 | ;; Introspection data exist since GVFS 1.14. If there are no such |
169 | ;; data, we expect an earlier interface. | |
170 | (defconst tramp-gvfs-methods-mounttracker | |
171 | (dbus-introspect-get-method-names | |
172 | :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker | |
173 | tramp-gvfs-interface-mounttracker) | |
174 | "The list of supported methods of the mount tracking interface.") | |
175 | ||
176 | (defconst tramp-gvfs-listmounts | |
177 | (if (member "ListMounts" tramp-gvfs-methods-mounttracker) | |
178 | "ListMounts" | |
179 | "listMounts") | |
180 | "The name of the \"listMounts\" method. | |
181 | It has been changed in GVFS 1.14.") | |
182 | ||
183 | (defconst tramp-gvfs-mountlocation | |
184 | (if (member "MountLocation" tramp-gvfs-methods-mounttracker) | |
185 | "MountLocation" | |
186 | "mountLocation") | |
187 | "The name of the \"mountLocation\" method. | |
188 | It has been changed in GVFS 1.14.") | |
189 | ||
190 | (defconst tramp-gvfs-mountlocation-signature | |
191 | (dbus-introspect-get-signature | |
192 | :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker | |
193 | tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation) | |
194 | "The D-Bus signature of the \"mountLocation\" method. | |
195 | It has been changed in GVFS 1.14.") | |
196 | ||
eeb44655 MA |
197 | ;; <interface name='org.gtk.vfs.MountTracker'> |
198 | ;; <method name='listMounts'> | |
199 | ;; <arg name='mount_info_list' | |
4f201088 | 200 | ;; type='a{sosssssbay{aya{say}}ay}' |
eeb44655 MA |
201 | ;; direction='out'/> |
202 | ;; </method> | |
203 | ;; <method name='mountLocation'> | |
204 | ;; <arg name='mount_spec' type='{aya{say}}' direction='in'/> | |
205 | ;; <arg name='dbus_id' type='s' direction='in'/> | |
206 | ;; <arg name='object_path' type='o' direction='in'/> | |
207 | ;; </method> | |
208 | ;; <signal name='mounted'> | |
209 | ;; <arg name='mount_info' | |
4f201088 | 210 | ;; type='{sosssssbay{aya{say}}ay}'/> |
eeb44655 MA |
211 | ;; </signal> |
212 | ;; <signal name='unmounted'> | |
213 | ;; <arg name='mount_info' | |
4f201088 | 214 | ;; type='{sosssssbay{aya{say}}ay}'/> |
eeb44655 MA |
215 | ;; </signal> |
216 | ;; </interface> | |
217 | ;; | |
218 | ;; STRUCT mount_info | |
219 | ;; STRING dbus_id | |
220 | ;; OBJECT_PATH object_path | |
221 | ;; STRING display_name | |
222 | ;; STRING stable_name | |
f0dbdc25 | 223 | ;; STRING x_content_types Since GVFS 1.0 only !!! |
eeb44655 | 224 | ;; STRING icon |
fa463103 | 225 | ;; STRING preferred_filename_encoding |
eeb44655 MA |
226 | ;; BOOLEAN user_visible |
227 | ;; ARRAY BYTE fuse_mountpoint | |
228 | ;; STRUCT mount_spec | |
229 | ;; ARRAY BYTE mount_prefix | |
230 | ;; ARRAY | |
231 | ;; STRUCT mount_spec_item | |
232 | ;; STRING key (server, share, type, user, host, port) | |
233 | ;; ARRAY BYTE value | |
4f201088 | 234 | ;; ARRAY BYTE default_location Since GVFS 1.5 only !!! |
eeb44655 MA |
235 | |
236 | (defconst tramp-gvfs-interface-mountoperation "org.gtk.vfs.MountOperation" | |
237 | "Used by the dbus-proxying implementation of GMountOperation.") | |
238 | ||
239 | ;; <interface name='org.gtk.vfs.MountOperation'> | |
240 | ;; <method name='askPassword'> | |
d3e97185 | 241 | ;; <arg name='message' type='s' direction='in'/> |
eeb44655 MA |
242 | ;; <arg name='default_user' type='s' direction='in'/> |
243 | ;; <arg name='default_domain' type='s' direction='in'/> | |
244 | ;; <arg name='flags' type='u' direction='in'/> | |
245 | ;; <arg name='handled' type='b' direction='out'/> | |
246 | ;; <arg name='aborted' type='b' direction='out'/> | |
247 | ;; <arg name='password' type='s' direction='out'/> | |
248 | ;; <arg name='username' type='s' direction='out'/> | |
249 | ;; <arg name='domain' type='s' direction='out'/> | |
250 | ;; <arg name='anonymous' type='b' direction='out'/> | |
251 | ;; <arg name='password_save' type='u' direction='out'/> | |
252 | ;; </method> | |
253 | ;; <method name='askQuestion'> | |
254 | ;; <arg name='message' type='s' direction='in'/> | |
255 | ;; <arg name='choices' type='as' direction='in'/> | |
256 | ;; <arg name='handled' type='b' direction='out'/> | |
257 | ;; <arg name='aborted' type='b' direction='out'/> | |
258 | ;; <arg name='choice' type='u' direction='out'/> | |
259 | ;; </method> | |
260 | ;; </interface> | |
261 | ||
262 | ;; The following flags are used in "askPassword". They are defined in | |
263 | ;; /usr/include/glib-2.0/gio/gioenums.h. | |
264 | ||
265 | (defconst tramp-gvfs-password-need-password 1 | |
266 | "Operation requires a password.") | |
267 | ||
268 | (defconst tramp-gvfs-password-need-username 2 | |
269 | "Operation requires a username.") | |
270 | ||
271 | (defconst tramp-gvfs-password-need-domain 4 | |
272 | "Operation requires a domain.") | |
273 | ||
274 | (defconst tramp-gvfs-password-saving-supported 8 | |
275 | "Operation supports saving settings.") | |
276 | ||
277 | (defconst tramp-gvfs-password-anonymous-supported 16 | |
278 | "Operation supports anonymous users.") | |
279 | ||
280 | (defconst tramp-bluez-service "org.bluez" | |
281 | "The well known name of the BLUEZ service.") | |
282 | ||
283 | (defconst tramp-bluez-interface-manager "org.bluez.Manager" | |
284 | "The manager interface of the BLUEZ daemon.") | |
285 | ||
286 | ;; <interface name='org.bluez.Manager'> | |
287 | ;; <method name='DefaultAdapter'> | |
288 | ;; <arg type='o' direction='out'/> | |
289 | ;; </method> | |
290 | ;; <method name='FindAdapter'> | |
291 | ;; <arg type='s' direction='in'/> | |
292 | ;; <arg type='o' direction='out'/> | |
293 | ;; </method> | |
294 | ;; <method name='ListAdapters'> | |
295 | ;; <arg type='ao' direction='out'/> | |
296 | ;; </method> | |
297 | ;; <signal name='AdapterAdded'> | |
298 | ;; <arg type='o'/> | |
299 | ;; </signal> | |
300 | ;; <signal name='AdapterRemoved'> | |
301 | ;; <arg type='o'/> | |
302 | ;; </signal> | |
303 | ;; <signal name='DefaultAdapterChanged'> | |
304 | ;; <arg type='o'/> | |
305 | ;; </signal> | |
306 | ;; </interface> | |
307 | ||
308 | (defconst tramp-bluez-interface-adapter "org.bluez.Adapter" | |
309 | "The adapter interface of the BLUEZ daemon.") | |
310 | ||
311 | ;; <interface name='org.bluez.Adapter'> | |
312 | ;; <method name='GetProperties'> | |
313 | ;; <arg type='a{sv}' direction='out'/> | |
314 | ;; </method> | |
315 | ;; <method name='SetProperty'> | |
316 | ;; <arg type='s' direction='in'/> | |
317 | ;; <arg type='v' direction='in'/> | |
318 | ;; </method> | |
319 | ;; <method name='RequestMode'> | |
320 | ;; <arg type='s' direction='in'/> | |
321 | ;; </method> | |
322 | ;; <method name='ReleaseMode'/> | |
323 | ;; <method name='RequestSession'/> | |
324 | ;; <method name='ReleaseSession'/> | |
325 | ;; <method name='StartDiscovery'/> | |
326 | ;; <method name='StopDiscovery'/> | |
327 | ;; <method name='ListDevices'> | |
328 | ;; <arg type='ao' direction='out'/> | |
329 | ;; </method> | |
330 | ;; <method name='CreateDevice'> | |
331 | ;; <arg type='s' direction='in'/> | |
332 | ;; <arg type='o' direction='out'/> | |
333 | ;; </method> | |
334 | ;; <method name='CreatePairedDevice'> | |
335 | ;; <arg type='s' direction='in'/> | |
336 | ;; <arg type='o' direction='in'/> | |
337 | ;; <arg type='s' direction='in'/> | |
338 | ;; <arg type='o' direction='out'/> | |
339 | ;; </method> | |
340 | ;; <method name='CancelDeviceCreation'> | |
341 | ;; <arg type='s' direction='in'/> | |
342 | ;; </method> | |
343 | ;; <method name='RemoveDevice'> | |
344 | ;; <arg type='o' direction='in'/> | |
345 | ;; </method> | |
346 | ;; <method name='FindDevice'> | |
347 | ;; <arg type='s' direction='in'/> | |
348 | ;; <arg type='o' direction='out'/> | |
349 | ;; </method> | |
350 | ;; <method name='RegisterAgent'> | |
351 | ;; <arg type='o' direction='in'/> | |
352 | ;; <arg type='s' direction='in'/> | |
353 | ;; </method> | |
354 | ;; <method name='UnregisterAgent'> | |
355 | ;; <arg type='o' direction='in'/> | |
356 | ;; </method> | |
357 | ;; <signal name='DeviceCreated'> | |
358 | ;; <arg type='o'/> | |
359 | ;; </signal> | |
360 | ;; <signal name='DeviceRemoved'> | |
361 | ;; <arg type='o'/> | |
362 | ;; </signal> | |
363 | ;; <signal name='DeviceFound'> | |
364 | ;; <arg type='s'/> | |
365 | ;; <arg type='a{sv}'/> | |
366 | ;; </signal> | |
367 | ;; <signal name='PropertyChanged'> | |
368 | ;; <arg type='s'/> | |
369 | ;; <arg type='v'/> | |
370 | ;; </signal> | |
371 | ;; <signal name='DeviceDisappeared'> | |
372 | ;; <arg type='s'/> | |
373 | ;; </signal> | |
374 | ;; </interface> | |
375 | ||
376 | (defcustom tramp-bluez-discover-devices-timeout 60 | |
377 | "Defines seconds since last bluetooth device discovery before rescanning. | |
378 | A value of 0 would require an immediate discovery during hostname | |
379 | completion, nil means to use always cached values for discovered | |
380 | devices." | |
381 | :group 'tramp | |
f0dbdc25 | 382 | :version "23.2" |
eeb44655 MA |
383 | :type '(choice (const nil) integer)) |
384 | ||
385 | (defvar tramp-bluez-discovery nil | |
386 | "Indicator for a running bluetooth device discovery. | |
387 | It keeps the timestamp of last discovery.") | |
388 | ||
389 | (defvar tramp-bluez-devices nil | |
390 | "Alist of detected bluetooth devices. | |
391 | Every entry is a list (NAME ADDRESS).") | |
392 | ||
d557e7a6 MA |
393 | (defconst tramp-hal-service "org.freedesktop.Hal" |
394 | "The well known name of the HAL service.") | |
395 | ||
396 | (defconst tramp-hal-path-manager "/org/freedesktop/Hal/Manager" | |
397 | "The object path of the HAL daemon manager.") | |
398 | ||
399 | (defconst tramp-hal-interface-manager "org.freedesktop.Hal.Manager" | |
400 | "The manager interface of the HAL daemon.") | |
401 | ||
402 | (defconst tramp-hal-interface-device "org.freedesktop.Hal.Device" | |
403 | "The device interface of the HAL daemon.") | |
404 | ||
405 | \f | |
eeb44655 MA |
406 | ;; New handlers should be added here. |
407 | (defconst tramp-gvfs-file-name-handler-alist | |
a43dc424 | 408 | '((access-file . ignore) |
eeb44655 | 409 | (add-name-to-file . tramp-gvfs-handle-copy-file) |
99278f8a | 410 | ;; `byte-compiler-base-file-name' performed by default handler. |
a43dc424 | 411 | ;; `copy-directory' performed by default handler. |
eeb44655 MA |
412 | (copy-file . tramp-gvfs-handle-copy-file) |
413 | (delete-directory . tramp-gvfs-handle-delete-directory) | |
414 | (delete-file . tramp-gvfs-handle-delete-file) | |
99278f8a | 415 | ;; `diff-latest-backup-file' performed by default handler. |
eeb44655 | 416 | (directory-file-name . tramp-handle-directory-file-name) |
3675b169 | 417 | (directory-files . tramp-handle-directory-files) |
eeb44655 | 418 | (directory-files-and-attributes |
3675b169 | 419 | . tramp-handle-directory-files-and-attributes) |
eeb44655 MA |
420 | (dired-call-process . ignore) |
421 | (dired-compress-file . ignore) | |
422 | (dired-uncache . tramp-handle-dired-uncache) | |
423 | (expand-file-name . tramp-gvfs-handle-expand-file-name) | |
10ffd0be | 424 | (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) |
3675b169 | 425 | (file-acl . ignore) |
eeb44655 | 426 | (file-attributes . tramp-gvfs-handle-file-attributes) |
0f34aa77 | 427 | (file-directory-p . tramp-gvfs-handle-file-directory-p) |
a43dc424 | 428 | ;; `file-equal-p' performed by default handler. |
eeb44655 | 429 | (file-executable-p . tramp-gvfs-handle-file-executable-p) |
3675b169 | 430 | (file-exists-p . tramp-handle-file-exists-p) |
a43dc424 | 431 | ;; `file-in-directory-p' performed by default handler. |
eeb44655 | 432 | (file-local-copy . tramp-gvfs-handle-file-local-copy) |
3675b169 | 433 | (file-modes . tramp-handle-file-modes) |
eeb44655 MA |
434 | (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) |
435 | (file-name-as-directory . tramp-handle-file-name-as-directory) | |
436 | (file-name-completion . tramp-handle-file-name-completion) | |
437 | (file-name-directory . tramp-handle-file-name-directory) | |
438 | (file-name-nondirectory . tramp-handle-file-name-nondirectory) | |
99278f8a | 439 | ;; `file-name-sans-versions' performed by default handler. |
eeb44655 | 440 | (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) |
a43dc424 MA |
441 | (file-notify-add-watch . tramp-gvfs-handle-file-notify-add-watch) |
442 | (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) | |
eeb44655 MA |
443 | (file-ownership-preserved-p . ignore) |
444 | (file-readable-p . tramp-gvfs-handle-file-readable-p) | |
445 | (file-regular-p . tramp-handle-file-regular-p) | |
632c5478 | 446 | (file-remote-p . tramp-handle-file-remote-p) |
3675b169 | 447 | (file-selinux-context . ignore) |
eeb44655 | 448 | (file-symlink-p . tramp-handle-file-symlink-p) |
99278f8a | 449 | ;; `file-truename' performed by default handler. |
eeb44655 MA |
450 | (file-writable-p . tramp-gvfs-handle-file-writable-p) |
451 | (find-backup-file-name . tramp-handle-find-backup-file-name) | |
99278f8a MA |
452 | ;; `find-file-noselect' performed by default handler. |
453 | ;; `get-file-buffer' performed by default handler. | |
eeb44655 | 454 | (insert-directory . tramp-gvfs-handle-insert-directory) |
f8f91d5d | 455 | (insert-file-contents . tramp-handle-insert-file-contents) |
eeb44655 | 456 | (load . tramp-handle-load) |
af9ff9e8 | 457 | (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) |
eeb44655 MA |
458 | (make-directory . tramp-gvfs-handle-make-directory) |
459 | (make-directory-internal . ignore) | |
50bfdd5d | 460 | (make-symbolic-link . tramp-handle-make-symbolic-link) |
3675b169 | 461 | (process-file . ignore) |
eeb44655 | 462 | (rename-file . tramp-gvfs-handle-rename-file) |
3675b169 MA |
463 | (set-file-acl . ignore) |
464 | (set-file-modes . ignore) | |
465 | (set-file-selinux-context . ignore) | |
a43dc424 MA |
466 | (set-file-times . ignore) |
467 | (set-visited-file-modtime . tramp-handle-set-visited-file-modtime) | |
3675b169 MA |
468 | (shell-command . ignore) |
469 | (start-file-process . ignore) | |
eeb44655 MA |
470 | (substitute-in-file-name . tramp-handle-substitute-in-file-name) |
471 | (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) | |
472 | (vc-registered . ignore) | |
a43dc424 MA |
473 | (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) |
474 | (write-region . tramp-gvfs-handle-write-region)) | |
eeb44655 MA |
475 | "Alist of handler functions for Tramp GVFS method. |
476 | Operations not mentioned here will be handled by the default Emacs primitives.") | |
477 | ||
b421decc MA |
478 | ;; It must be a `defsubst' in order to push the whole code into |
479 | ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. | |
0f34aa77 MA |
480 | ;;;###tramp-autoload |
481 | (defsubst tramp-gvfs-file-name-p (filename) | |
eeb44655 MA |
482 | "Check if it's a filename handled by the GVFS daemon." |
483 | (and (tramp-tramp-file-p filename) | |
484 | (let ((method | |
485 | (tramp-file-name-method (tramp-dissect-file-name filename)))) | |
486 | (and (stringp method) (member method tramp-gvfs-methods))))) | |
487 | ||
0f34aa77 | 488 | ;;;###tramp-autoload |
eeb44655 MA |
489 | (defun tramp-gvfs-file-name-handler (operation &rest args) |
490 | "Invoke the GVFS related OPERATION. | |
491 | First arg specifies the OPERATION, second arg is a list of arguments to | |
492 | pass to the OPERATION." | |
91aafa16 | 493 | (unless tramp-gvfs-enabled |
95beaef3 | 494 | (tramp-user-error nil "Package `tramp-gvfs' not supported")) |
eeb44655 MA |
495 | (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) |
496 | (if fn | |
497 | (save-match-data (apply (cdr fn) args)) | |
498 | (tramp-run-real-handler operation args)))) | |
499 | ||
500 | ;; This might be moved to tramp.el. It shall be the first file name | |
501 | ;; handler. | |
0f34aa77 MA |
502 | ;;;###tramp-autoload |
503 | (when (featurep 'dbusbind) | |
504 | (add-to-list 'tramp-foreign-file-name-handler-alist | |
505 | (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler))) | |
eeb44655 | 506 | |
3675b169 MA |
507 | \f |
508 | ;; D-Bus helper function. | |
509 | ||
510 | (defun tramp-gvfs-dbus-string-to-byte-array (string) | |
511 | "Like `dbus-string-to-byte-array' but add trailing \\0 if needed." | |
512 | (dbus-string-to-byte-array | |
513 | (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature) | |
514 | (concat string (string 0)) string))) | |
515 | ||
516 | (defun tramp-gvfs-dbus-byte-array-to-string (byte-array) | |
517 | "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists." | |
518 | ;; The byte array could be a variant. Take care. | |
519 | (let ((byte-array | |
520 | (if (and (consp byte-array) (atom (car byte-array))) | |
521 | byte-array (car byte-array)))) | |
522 | (dbus-byte-array-to-string | |
523 | (if (and (consp byte-array) (zerop (car (last byte-array)))) | |
524 | (butlast byte-array) byte-array)))) | |
525 | ||
1efeec86 MA |
526 | (defun tramp-gvfs-stringify-dbus-message (message) |
527 | "Convert a D-Bus message into readable UTF8 strings, used for traces." | |
528 | (cond | |
529 | ((and (consp message) (characterp (car message))) | |
3675b169 | 530 | (format "%S" (tramp-gvfs-dbus-byte-array-to-string message))) |
1efeec86 MA |
531 | ((consp message) |
532 | (mapcar 'tramp-gvfs-stringify-dbus-message message)) | |
533 | ((stringp message) | |
534 | (format "%S" message)) | |
535 | (t message))) | |
536 | ||
eeb44655 MA |
537 | (defmacro with-tramp-dbus-call-method |
538 | (vec synchronous bus service path interface method &rest args) | |
539 | "Apply a D-Bus call on bus BUS. | |
540 | ||
541 | If SYNCHRONOUS is non-nil, the call is synchronously. Otherwise, | |
542 | it is an asynchronous call, with `ignore' as callback function. | |
543 | ||
544 | The other arguments have the same meaning as with `dbus-call-method' | |
545 | or `dbus-call-method-asynchronously'. Additionally, the call | |
546 | will be traced by Tramp with trace level 6." | |
547 | `(let ((func (if ,synchronous | |
548 | 'dbus-call-method 'dbus-call-method-asynchronously)) | |
549 | (args (append (list ,bus ,service ,path ,interface ,method) | |
550 | (if ,synchronous (list ,@args) (list 'ignore ,@args)))) | |
551 | result) | |
552 | (tramp-message ,vec 6 "%s %s" func args) | |
553 | (setq result (apply func args)) | |
1efeec86 | 554 | (tramp-message ,vec 6 "%s" (tramp-gvfs-stringify-dbus-message result)) |
eeb44655 MA |
555 | result)) |
556 | ||
557 | (put 'with-tramp-dbus-call-method 'lisp-indent-function 2) | |
558 | (put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body)) | |
6139f995 MA |
559 | (tramp-compat-font-lock-add-keywords |
560 | 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) | |
eeb44655 | 561 | |
eeb44655 MA |
562 | (defvar tramp-gvfs-dbus-event-vector nil |
563 | "Current Tramp file name to be used, as vector. | |
564 | It is needed when D-Bus signals or errors arrive, because there | |
565 | is no information where to trace the message.") | |
566 | ||
567 | (defun tramp-gvfs-dbus-event-error (event err) | |
7b1bf173 | 568 | "Called when a D-Bus error message arrives, see `dbus-event-error-functions'." |
d3e97185 | 569 | (when tramp-gvfs-dbus-event-vector |
d3e97185 MA |
570 | (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) |
571 | (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) | |
eeb44655 | 572 | |
5504e2c7 MA |
573 | ;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'. |
574 | (add-hook | |
575 | (if (boundp 'dbus-event-error-functions) | |
576 | 'dbus-event-error-functions 'dbus-event-error-hooks) | |
577 | 'tramp-gvfs-dbus-event-error) | |
eeb44655 MA |
578 | |
579 | \f | |
580 | ;; File name primitives. | |
581 | ||
582 | (defun tramp-gvfs-handle-copy-file | |
632c5478 | 583 | (filename newname &optional ok-if-already-exists keep-date |
53b6a8b1 | 584 | preserve-uid-gid preserve-extended-attributes) |
eeb44655 | 585 | "Like `copy-file' for Tramp files." |
1efeec86 MA |
586 | (with-parsed-tramp-file-name |
587 | (if (tramp-tramp-file-p filename) filename newname) nil | |
3675b169 MA |
588 | |
589 | (when (and (not ok-if-already-exists) (file-exists-p newname)) | |
590 | (tramp-error | |
591 | v 'file-already-exists "File %s already exists" newname)) | |
592 | ||
593 | (if (or (and (tramp-tramp-file-p filename) | |
594 | (not (tramp-gvfs-file-name-p filename))) | |
595 | (and (tramp-tramp-file-p newname) | |
596 | (not (tramp-gvfs-file-name-p newname)))) | |
597 | ||
af9ff9e8 MA |
598 | ;; We cannot call `copy-file' directly. Use |
599 | ;; `tramp-compat-funcall' for backward compatibility (number | |
600 | ;; of arguments). | |
3675b169 MA |
601 | (let ((tmpfile (tramp-compat-make-temp-file filename))) |
602 | (cond | |
603 | (preserve-extended-attributes | |
af9ff9e8 MA |
604 | (tramp-compat-funcall |
605 | 'copy-file | |
3675b169 MA |
606 | filename tmpfile t keep-date preserve-uid-gid |
607 | preserve-extended-attributes)) | |
608 | (preserve-uid-gid | |
af9ff9e8 MA |
609 | (tramp-compat-funcall |
610 | 'copy-file filename tmpfile t keep-date preserve-uid-gid)) | |
3675b169 MA |
611 | (t |
612 | (copy-file filename tmpfile t keep-date))) | |
613 | (rename-file tmpfile newname ok-if-already-exists)) | |
614 | ||
615 | ;; Direct copy. | |
616 | (with-tramp-progress-reporter | |
617 | v 0 (format "Copying %s to %s" filename newname) | |
618 | (unless | |
619 | (let ((args | |
620 | (append (if (or keep-date preserve-uid-gid) | |
621 | (list "--preserve") | |
622 | nil) | |
623 | (list | |
624 | (tramp-gvfs-url-file-name filename) | |
625 | (tramp-gvfs-url-file-name newname))))) | |
626 | (apply 'tramp-gvfs-send-command v "gvfs-copy" args)) | |
627 | ;; Propagate the error. | |
628 | (with-current-buffer (tramp-get-connection-buffer v) | |
629 | (goto-char (point-min)) | |
630 | (tramp-error-with-buffer | |
631 | nil v 'file-error | |
632 | "Copying failed, see buffer `%s' for details." (buffer-name))))) | |
633 | ||
4c1f03ef | 634 | (when (tramp-tramp-file-p newname) |
3675b169 MA |
635 | (with-parsed-tramp-file-name newname nil |
636 | (tramp-flush-file-property v (file-name-directory localname)) | |
637 | (tramp-flush-file-property v localname)))))) | |
638 | ||
639 | (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) | |
eeb44655 | 640 | "Like `delete-directory' for Tramp files." |
3675b169 MA |
641 | (when (and recursive (not (file-symlink-p directory))) |
642 | (mapc (lambda (file) | |
643 | (if (eq t (car (file-attributes file))) | |
644 | (tramp-compat-delete-directory file recursive trash) | |
645 | (tramp-compat-delete-file file trash))) | |
646 | (directory-files | |
647 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | |
648 | (with-parsed-tramp-file-name directory nil | |
649 | (tramp-flush-file-property v (file-name-directory localname)) | |
650 | (tramp-flush-directory-property v localname) | |
651 | (unless | |
652 | (tramp-gvfs-send-command | |
653 | v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm") | |
654 | (tramp-gvfs-url-file-name directory)) | |
655 | ;; Propagate the error. | |
656 | (with-current-buffer (tramp-get-connection-buffer v) | |
657 | (goto-char (point-min)) | |
658 | (tramp-error-with-buffer | |
659 | nil v 'file-error "Couldn't delete %s" directory))))) | |
eeb44655 | 660 | |
eba082a2 | 661 | (defun tramp-gvfs-handle-delete-file (filename &optional trash) |
eeb44655 | 662 | "Like `delete-file' for Tramp files." |
3675b169 MA |
663 | (with-parsed-tramp-file-name filename nil |
664 | (tramp-flush-file-property v (file-name-directory localname)) | |
665 | (tramp-flush-directory-property v localname) | |
666 | (unless | |
667 | (tramp-gvfs-send-command | |
668 | v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm") | |
669 | (tramp-gvfs-url-file-name filename)) | |
670 | ;; Propagate the error. | |
671 | (with-current-buffer (tramp-get-connection-buffer v) | |
672 | (goto-char (point-min)) | |
673 | (tramp-error-with-buffer | |
674 | nil v 'file-error "Couldn't delete %s" filename))))) | |
eeb44655 MA |
675 | |
676 | (defun tramp-gvfs-handle-expand-file-name (name &optional dir) | |
677 | "Like `expand-file-name' for Tramp files." | |
678 | ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". | |
679 | (setq dir (or dir default-directory "/")) | |
680 | ;; Unless NAME is absolute, concat DIR and NAME. | |
681 | (unless (file-name-absolute-p name) | |
682 | (setq name (concat (file-name-as-directory dir) name))) | |
683 | ;; If NAME is not a Tramp file, run the real handler. | |
684 | (if (not (tramp-tramp-file-p name)) | |
685 | (tramp-run-real-handler 'expand-file-name (list name nil)) | |
686 | ;; Dissect NAME. | |
687 | (with-parsed-tramp-file-name name nil | |
4f201088 MA |
688 | ;; If there is a default location, expand tilde. |
689 | (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname) | |
690 | (save-match-data | |
2fe4b125 | 691 | (tramp-gvfs-maybe-open-connection (vector method user host "/" hop))) |
4f201088 MA |
692 | (setq localname |
693 | (replace-match | |
694 | (tramp-get-file-property v "/" "default-location" "~") | |
695 | nil t localname 1))) | |
eeb44655 MA |
696 | ;; Tilde expansion is not possible. |
697 | (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) | |
698 | (tramp-error | |
699 | v 'file-error | |
700 | "Cannot expand tilde in file `%s'" name)) | |
701 | (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) | |
702 | (setq localname (concat "/" localname))) | |
703 | ;; We do not pass "/..". | |
704 | (if (string-equal "smb" method) | |
705 | (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname) | |
706 | (setq localname (replace-match "/" t t localname 1))) | |
707 | (when (string-match "^/\\.\\./?" localname) | |
708 | (setq localname (replace-match "/" t t localname)))) | |
709 | ;; There might be a double slash. Remove this. | |
710 | (while (string-match "//" localname) | |
711 | (setq localname (replace-match "/" t t localname))) | |
712 | ;; No tilde characters in file name, do normal | |
713 | ;; `expand-file-name' (this does "/./" and "/../"). | |
714 | (tramp-make-tramp-file-name | |
715 | method user host | |
716 | (tramp-run-real-handler | |
717 | 'expand-file-name (list localname)))))) | |
718 | ||
719 | (defun tramp-gvfs-handle-file-attributes (filename &optional id-format) | |
720 | "Like `file-attributes' for Tramp files." | |
3675b169 MA |
721 | (unless id-format (setq id-format 'integer)) |
722 | ;; Don't modify `last-coding-system-used' by accident. | |
723 | (let ((last-coding-system-used last-coding-system-used) | |
724 | dirp res-symlink-target res-numlinks res-uid res-gid res-access | |
725 | res-mod res-change res-size res-filemodes res-inode res-device) | |
726 | (with-parsed-tramp-file-name filename nil | |
727 | (with-tramp-file-property | |
728 | v localname (format "file-attributes-%s" id-format) | |
729 | (tramp-message v 5 "file attributes: %s" localname) | |
730 | (tramp-gvfs-send-command | |
731 | v "gvfs-info" (tramp-gvfs-url-file-name filename)) | |
732 | ;; Parse output ... | |
733 | (with-current-buffer (tramp-get-connection-buffer v) | |
734 | (goto-char (point-min)) | |
735 | (when (re-search-forward "attributes:" nil t) | |
736 | ;; ... directory or symlink | |
737 | (goto-char (point-min)) | |
738 | (setq dirp (if (re-search-forward "type:\\s-+directory" nil t) t)) | |
739 | (goto-char (point-min)) | |
740 | (setq res-symlink-target | |
741 | (if (re-search-forward | |
742 | "standard::symlink-target:\\s-+\\(\\S-+\\)" nil t) | |
743 | (match-string 1))) | |
744 | ;; ... number links | |
745 | (goto-char (point-min)) | |
746 | (setq res-numlinks | |
747 | (if (re-search-forward "unix::nlink:\\s-+\\([0-9]+\\)" nil t) | |
748 | (string-to-number (match-string 1)) 0)) | |
749 | ;; ... uid and gid | |
750 | (goto-char (point-min)) | |
751 | (setq res-uid | |
752 | (or (if (eq id-format 'integer) | |
753 | (if (re-search-forward | |
754 | "unix::uid:\\s-+\\([0-9]+\\)" nil t) | |
755 | (string-to-number (match-string 1))) | |
756 | (if (re-search-forward | |
757 | "owner::user:\\s-+\\(\\S-+\\)" nil t) | |
758 | (match-string 1))) | |
759 | (tramp-get-local-uid id-format))) | |
760 | (setq res-gid | |
761 | (or (if (eq id-format 'integer) | |
762 | (if (re-search-forward | |
763 | "unix::gid:\\s-+\\([0-9]+\\)" nil t) | |
764 | (string-to-number (match-string 1))) | |
765 | (if (re-search-forward | |
766 | "owner::group:\\s-+\\(\\S-+\\)" nil t) | |
767 | (match-string 1))) | |
768 | (tramp-get-local-gid id-format))) | |
769 | ;; ... last access, modification and change time | |
770 | (goto-char (point-min)) | |
771 | (setq res-access | |
772 | (if (re-search-forward | |
773 | "time::access:\\s-+\\([0-9]+\\)" nil t) | |
774 | (seconds-to-time (string-to-number (match-string 1))) | |
775 | '(0 0))) | |
776 | (goto-char (point-min)) | |
777 | (setq res-mod | |
778 | (if (re-search-forward | |
779 | "time::modified:\\s-+\\([0-9]+\\)" nil t) | |
780 | (seconds-to-time (string-to-number (match-string 1))) | |
781 | '(0 0))) | |
782 | (goto-char (point-min)) | |
783 | (setq res-change | |
784 | (if (re-search-forward | |
785 | "time::changed:\\s-+\\([0-9]+\\)" nil t) | |
786 | (seconds-to-time (string-to-number (match-string 1))) | |
787 | '(0 0))) | |
788 | ;; ... size | |
789 | (goto-char (point-min)) | |
790 | (setq res-size | |
791 | (if (re-search-forward | |
792 | "standard::size:\\s-+\\([0-9]+\\)" nil t) | |
793 | (string-to-number (match-string 1)) 0)) | |
794 | ;; ... file mode flags | |
795 | (goto-char (point-min)) | |
796 | (setq res-filemodes | |
797 | (if (re-search-forward "unix::mode:\\s-+\\([0-9]+\\)" nil t) | |
798 | (tramp-file-mode-from-int (match-string 1)) | |
799 | (if dirp "drwx------" "-rwx------"))) | |
800 | ;; ... inode and device | |
801 | (goto-char (point-min)) | |
802 | (setq res-inode | |
803 | (if (re-search-forward "unix::inode:\\s-+\\([0-9]+\\)" nil t) | |
804 | (string-to-number (match-string 1)) | |
805 | (tramp-get-inode v))) | |
806 | (goto-char (point-min)) | |
807 | (setq res-device | |
808 | (if (re-search-forward "unix::device:\\s-+\\([0-9]+\\)" nil t) | |
809 | (string-to-number (match-string 1)) | |
810 | (tramp-get-device v))) | |
811 | ||
812 | ;; Return data gathered. | |
813 | (list | |
814 | ;; 0. t for directory, string (name linked to) for | |
815 | ;; symbolic link, or nil. | |
816 | (or dirp res-symlink-target) | |
817 | ;; 1. Number of links to file. | |
818 | res-numlinks | |
819 | ;; 2. File uid. | |
820 | res-uid | |
821 | ;; 3. File gid. | |
822 | res-gid | |
823 | ;; 4. Last access time, as a list of integers. | |
824 | ;; 5. Last modification time, likewise. | |
825 | ;; 6. Last status change time, likewise. | |
826 | res-access res-mod res-change | |
827 | ;; 7. Size in bytes (-1, if number is out of range). | |
828 | res-size | |
829 | ;; 8. File modes. | |
830 | res-filemodes | |
831 | ;; 9. t if file's gid would change if file were deleted | |
832 | ;; and recreated. | |
833 | nil | |
834 | ;; 10. Inode number. | |
835 | res-inode | |
836 | ;; 11. Device number. | |
837 | res-device | |
838 | ))))))) | |
eeb44655 | 839 | |
0f34aa77 MA |
840 | (defun tramp-gvfs-handle-file-directory-p (filename) |
841 | "Like `file-directory-p' for Tramp files." | |
3675b169 | 842 | (eq t (car (file-attributes filename)))) |
0f34aa77 | 843 | |
eeb44655 MA |
844 | (defun tramp-gvfs-handle-file-executable-p (filename) |
845 | "Like `file-executable-p' for Tramp files." | |
3675b169 MA |
846 | (with-parsed-tramp-file-name filename nil |
847 | (with-tramp-file-property v localname "file-executable-p" | |
848 | (tramp-check-cached-permissions v ?x)))) | |
eeb44655 MA |
849 | |
850 | (defun tramp-gvfs-handle-file-local-copy (filename) | |
851 | "Like `file-local-copy' for Tramp files." | |
852 | (with-parsed-tramp-file-name filename nil | |
853 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | |
854 | (unless (file-exists-p filename) | |
855 | (tramp-error | |
856 | v 'file-error | |
857 | "Cannot make local copy of non-existing file `%s'" filename)) | |
858 | (copy-file filename tmpfile t t) | |
859 | tmpfile))) | |
860 | ||
861 | (defun tramp-gvfs-handle-file-name-all-completions (filename directory) | |
862 | "Like `file-name-all-completions' for Tramp files." | |
863 | (unless (save-match-data (string-match "/" filename)) | |
3675b169 MA |
864 | (with-parsed-tramp-file-name (expand-file-name directory) nil |
865 | ||
866 | (all-completions | |
867 | filename | |
868 | (mapcar | |
869 | 'list | |
870 | (or | |
871 | ;; Try cache entries for filename, filename with last | |
872 | ;; character removed, filename with last two characters | |
873 | ;; removed, ..., and finally the empty string - all | |
874 | ;; concatenated to the local directory name. | |
875 | (let ((remote-file-name-inhibit-cache | |
876 | (or remote-file-name-inhibit-cache | |
877 | tramp-completion-reread-directory-timeout))) | |
878 | ||
879 | ;; This is inefficient for very long filenames, pity | |
880 | ;; `reduce' is not available... | |
881 | (car | |
882 | (apply | |
883 | 'append | |
884 | (mapcar | |
885 | (lambda (x) | |
886 | (let ((cache-hit | |
887 | (tramp-get-file-property | |
888 | v | |
889 | (concat localname (substring filename 0 x)) | |
890 | "file-name-all-completions" | |
891 | nil))) | |
892 | (when cache-hit (list cache-hit)))) | |
893 | ;; We cannot use a length of 0, because file properties | |
894 | ;; for "foo" and "foo/" are identical. | |
895 | (tramp-compat-number-sequence (length filename) 1 -1))))) | |
896 | ||
897 | ;; Cache expired or no matching cache entry found so we need | |
898 | ;; to perform a remote operation. | |
899 | (let ((result '("." "..")) | |
900 | entry) | |
901 | ;; Get a list of directories and files. | |
902 | (tramp-gvfs-send-command | |
903 | v "gvfs-ls" (tramp-gvfs-url-file-name directory)) | |
904 | ||
905 | ;; Now grab the output. | |
906 | (with-temp-buffer | |
907 | (insert-buffer-substring (tramp-get-connection-buffer v)) | |
908 | (goto-char (point-max)) | |
909 | (while (zerop (forward-line -1)) | |
910 | (setq entry (buffer-substring (point) (point-at-eol))) | |
911 | (when (string-match filename entry) | |
912 | (if (file-directory-p (expand-file-name entry directory)) | |
913 | (push (concat entry "/") result) | |
914 | (push entry result))))) | |
915 | ||
916 | ;; Because the remote op went through OK we know the | |
917 | ;; directory we `cd'-ed to exists. | |
918 | (tramp-set-file-property v localname "file-exists-p" t) | |
919 | ||
920 | ;; Because the remote op went through OK we know every | |
921 | ;; file listed by `ls' exists. | |
922 | (mapc (lambda (entry) | |
923 | (tramp-set-file-property | |
924 | v (concat localname entry) "file-exists-p" t)) | |
925 | result) | |
926 | ||
927 | ;; Store result in the cache. | |
928 | (tramp-set-file-property | |
929 | v (concat localname filename) | |
930 | "file-name-all-completions" result)))))))) | |
eeb44655 | 931 | |
5d89d9d2 | 932 | (defun tramp-gvfs-handle-file-notify-add-watch (file-name _flags _callback) |
a43dc424 MA |
933 | "Like `file-notify-add-watch' for Tramp files." |
934 | (setq file-name (expand-file-name file-name)) | |
935 | (with-parsed-tramp-file-name file-name nil | |
936 | (let ((p (start-process | |
937 | "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*") | |
938 | "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name)))) | |
939 | (if (not (processp p)) | |
940 | (tramp-error | |
941 | v 'file-notify-error "gvfs-monitor-file failed to start") | |
4c1f03ef MA |
942 | (tramp-message |
943 | v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p) | |
944 | (tramp-set-connection-property p "vector" v) | |
a43dc424 MA |
945 | (tramp-compat-set-process-query-on-exit-flag p nil) |
946 | (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter) | |
947 | (with-current-buffer (process-buffer p) | |
948 | (setq default-directory (file-name-directory file-name))) | |
949 | p)))) | |
950 | ||
951 | (defun tramp-gvfs-file-gvfs-monitor-file-process-filter (proc string) | |
952 | "Read output from \"gvfs-monitor-file\" and add corresponding file-notify events." | |
953 | (let* ((rest-string (tramp-compat-process-get proc 'rest-string)) | |
954 | (dd (with-current-buffer (process-buffer proc) default-directory)) | |
955 | (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) | |
956 | (when rest-string | |
957 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) | |
958 | (tramp-message proc 6 "%S\n%s" proc string) | |
959 | (setq string (concat rest-string string) | |
960 | ;; Attribute change is returned in unused wording. | |
af9ff9e8 | 961 | string (tramp-compat-replace-regexp-in-string |
a43dc424 MA |
962 | "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) |
963 | ||
964 | (while (string-match | |
965 | (concat "^[\n\r]*" | |
966 | "File Monitor Event:[\n\r]+" | |
967 | "File = \\([^\n\r]+\\)[\n\r]+" | |
968 | "Event = \\([^[:blank:]]+\\)[\n\r]+") | |
969 | string) | |
970 | (let ((action (intern-soft | |
af9ff9e8 | 971 | (tramp-compat-replace-regexp-in-string |
a43dc424 MA |
972 | "_" "-" (downcase (match-string 2 string))))) |
973 | (file (match-string 1 string))) | |
974 | (setq string (replace-match "" nil nil string)) | |
975 | ;; File names are returned as URL paths. We must convert them. | |
976 | (when (string-match ddu file) | |
977 | (setq file (replace-match dd nil nil file))) | |
978 | (while (string-match "%\\([0-9A-F]\\{2\\}\\)" file) | |
979 | (setq file | |
980 | (replace-match | |
981 | (char-to-string (string-to-number (match-string 1 file) 16)) | |
982 | nil nil file))) | |
983 | ;; Usually, we would add an Emacs event now. Unfortunately, | |
984 | ;; `unread-command-events' does not accept several events at | |
985 | ;; once. Therefore, we apply the callback directly. | |
986 | (tramp-compat-funcall 'file-notify-callback (list proc action file)))) | |
987 | ||
988 | ;; Save rest of the string. | |
989 | (when (zerop (length string)) (setq string nil)) | |
990 | (when string (tramp-message proc 10 "Rest string:\n%s" string)) | |
991 | (tramp-compat-process-put proc 'rest-string string))) | |
992 | ||
eeb44655 MA |
993 | (defun tramp-gvfs-handle-file-readable-p (filename) |
994 | "Like `file-readable-p' for Tramp files." | |
3675b169 MA |
995 | (with-parsed-tramp-file-name filename nil |
996 | (with-tramp-file-property v localname "file-executable-p" | |
997 | (tramp-check-cached-permissions v ?r)))) | |
632c5478 | 998 | |
eeb44655 MA |
999 | (defun tramp-gvfs-handle-file-writable-p (filename) |
1000 | "Like `file-writable-p' for Tramp files." | |
3675b169 MA |
1001 | (with-parsed-tramp-file-name filename nil |
1002 | (with-tramp-file-property v localname "file-writable-p" | |
1003 | (if (file-exists-p filename) | |
1004 | (tramp-check-cached-permissions v ?w) | |
1005 | ;; If file doesn't exist, check if directory is writable. | |
1006 | (and (file-directory-p (file-name-directory filename)) | |
1007 | (file-writable-p (file-name-directory filename))))))) | |
eeb44655 MA |
1008 | |
1009 | (defun tramp-gvfs-handle-insert-directory | |
1010 | (filename switches &optional wildcard full-directory-p) | |
1011 | "Like `insert-directory' for Tramp files." | |
3675b169 | 1012 | ;; gvfs-* output is hard to parse. So we let `ls-lisp' do the job. |
11151a06 | 1013 | (unless switches (setq switches "")) |
3675b169 MA |
1014 | (with-parsed-tramp-file-name (expand-file-name filename) nil |
1015 | (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename) | |
1016 | (require 'ls-lisp) | |
1017 | (let (ls-lisp-use-insert-directory-program) | |
1018 | (tramp-run-real-handler | |
1019 | 'insert-directory | |
1020 | (list filename switches wildcard full-directory-p)))))) | |
eeb44655 | 1021 | |
eeb44655 MA |
1022 | (defun tramp-gvfs-handle-make-directory (dir &optional parents) |
1023 | "Like `make-directory' for Tramp files." | |
1efeec86 | 1024 | (with-parsed-tramp-file-name dir nil |
3675b169 MA |
1025 | (unless |
1026 | (apply | |
1027 | 'tramp-gvfs-send-command v "gvfs-mkdir" | |
1028 | (if parents | |
1029 | (list "-p" (tramp-gvfs-url-file-name dir)) | |
1030 | (list (tramp-gvfs-url-file-name dir)))) | |
1031 | ;; Propagate the error. | |
1032 | (tramp-error v 'file-error "Couldn't make directory %s" dir)))) | |
99278f8a | 1033 | |
eeb44655 MA |
1034 | (defun tramp-gvfs-handle-rename-file |
1035 | (filename newname &optional ok-if-already-exists) | |
1036 | "Like `rename-file' for Tramp files." | |
1efeec86 MA |
1037 | (with-parsed-tramp-file-name |
1038 | (if (tramp-tramp-file-p filename) filename newname) nil | |
1efeec86 | 1039 | |
3675b169 MA |
1040 | (when (and (not ok-if-already-exists) (file-exists-p newname)) |
1041 | (tramp-error | |
1042 | v 'file-already-exists "File %s already exists" newname)) | |
eeb44655 | 1043 | |
3675b169 MA |
1044 | (if (or (and (tramp-tramp-file-p filename) |
1045 | (not (tramp-gvfs-file-name-p filename))) | |
1046 | (and (tramp-tramp-file-p newname) | |
1047 | (not (tramp-gvfs-file-name-p newname)))) | |
53b6a8b1 | 1048 | |
3675b169 MA |
1049 | ;; We cannot move directly. |
1050 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | |
1051 | (rename-file filename tmpfile t) | |
1052 | (rename-file tmpfile newname ok-if-already-exists)) | |
eeb44655 | 1053 | |
3675b169 MA |
1054 | ;; Direct move. |
1055 | (with-tramp-progress-reporter | |
1056 | v 0 (format "Renaming %s to %s" filename newname) | |
1057 | (unless | |
1058 | (tramp-gvfs-send-command | |
1059 | v "gvfs-move" | |
1060 | (tramp-gvfs-url-file-name filename) | |
1061 | (tramp-gvfs-url-file-name newname)) | |
1062 | ;; Propagate the error. | |
1063 | (with-current-buffer (tramp-get-buffer v) | |
1064 | (goto-char (point-min)) | |
1065 | (tramp-error-with-buffer | |
1066 | nil v 'file-error | |
1067 | "Renaming failed, see buffer `%s' for details." (buffer-name))))) | |
1068 | ||
4c1f03ef | 1069 | (when (tramp-tramp-file-p filename) |
3675b169 MA |
1070 | (with-parsed-tramp-file-name filename nil |
1071 | (tramp-flush-file-property v (file-name-directory localname)) | |
1072 | (tramp-flush-file-property v localname))) | |
1073 | ||
4c1f03ef | 1074 | (when (tramp-tramp-file-p newname) |
3675b169 MA |
1075 | (with-parsed-tramp-file-name newname nil |
1076 | (tramp-flush-file-property v (file-name-directory localname)) | |
1077 | (tramp-flush-file-property v localname)))))) | |
632c5478 | 1078 | |
eeb44655 | 1079 | (defun tramp-gvfs-handle-write-region |
11151a06 | 1080 | (start end filename &optional append visit lockname confirm) |
eeb44655 MA |
1081 | "Like `write-region' for Tramp files." |
1082 | (with-parsed-tramp-file-name filename nil | |
3675b169 MA |
1083 | ;; XEmacs takes a coding system as the seventh argument, not `confirm'. |
1084 | (when (and (not (featurep 'xemacs)) confirm (file-exists-p filename)) | |
1085 | (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) | |
1086 | (tramp-error v 'file-error "File not overwritten"))) | |
1087 | ||
1088 | (let ((tmpfile (tramp-compat-make-temp-file filename))) | |
11151a06 MA |
1089 | (when (and append (file-exists-p filename)) |
1090 | (copy-file filename tmpfile 'ok)) | |
1091 | ;; We say `no-message' here because we don't want the visited file | |
1092 | ;; modtime data to be clobbered from the temp file. We call | |
1093 | ;; `set-visited-file-modtime' ourselves later on. | |
1094 | (tramp-run-real-handler | |
1095 | 'write-region | |
1096 | (if confirm ; don't pass this arg unless defined for backward compat. | |
1097 | (list start end tmpfile append 'no-message lockname confirm) | |
1098 | (list start end tmpfile append 'no-message lockname))) | |
3675b169 | 1099 | (condition-case nil |
a43dc424 | 1100 | (rename-file tmpfile filename 'ok-if-already-exists) |
3675b169 MA |
1101 | (error |
1102 | (delete-file tmpfile) | |
1103 | (tramp-error | |
1104 | v 'file-error "Couldn't write region to `%s'" filename)))) | |
1105 | ||
1106 | (tramp-flush-file-property v (file-name-directory localname)) | |
1107 | (tramp-flush-file-property v localname) | |
eeb44655 | 1108 | |
303ffde8 MA |
1109 | ;; Set file modification time. |
1110 | (when (or (eq visit t) (stringp visit)) | |
1111 | (set-visited-file-modtime (nth 5 (file-attributes filename)))) | |
1112 | ||
eeb44655 MA |
1113 | ;; The end. |
1114 | (when (or (eq visit t) (null visit) (stringp visit)) | |
1115 | (tramp-message v 0 "Wrote %s" filename)) | |
1116 | (run-hooks 'tramp-handle-write-region-hook))) | |
1117 | ||
1118 | \f | |
1119 | ;; File name conversions. | |
1120 | ||
1121 | (defun tramp-gvfs-url-file-name (filename) | |
1122 | "Return FILENAME in URL syntax." | |
1efeec86 | 1123 | ;; "/" must NOT be hexlified. |
3675b169 MA |
1124 | (let ((url-unreserved-chars (append '(?/) url-unreserved-chars)) |
1125 | result) | |
1126 | (setq | |
1127 | result | |
1128 | (url-recreate-url | |
1129 | (if (tramp-tramp-file-p filename) | |
1130 | (with-parsed-tramp-file-name filename nil | |
1131 | (when (and user (string-match tramp-user-with-domain-regexp user)) | |
1132 | (setq user | |
1133 | (concat (match-string 2 user) ";" (match-string 1 user)))) | |
1134 | (url-parse-make-urlobj | |
1135 | method (url-hexify-string user) nil | |
1136 | (tramp-file-name-real-host v) (tramp-file-name-port v) | |
1137 | (url-hexify-string localname) nil nil t)) | |
1138 | (url-parse-make-urlobj | |
1139 | "file" nil nil nil nil | |
1140 | (url-hexify-string (file-truename filename)) nil nil t)))) | |
1141 | (when (tramp-tramp-file-p filename) | |
1142 | (with-parsed-tramp-file-name filename nil | |
1143 | (tramp-message v 10 "remote file `%s' is URL `%s'" filename result))) | |
1144 | result)) | |
eeb44655 MA |
1145 | |
1146 | (defun tramp-gvfs-object-path (filename) | |
1147 | "Create a D-Bus object path from FILENAME." | |
1148 | (expand-file-name (dbus-escape-as-identifier filename) tramp-gvfs-path-tramp)) | |
1149 | ||
1150 | (defun tramp-gvfs-file-name (object-path) | |
1151 | "Retrieve file name from D-Bus OBJECT-PATH." | |
1152 | (dbus-unescape-from-identifier | |
af9ff9e8 MA |
1153 | (tramp-compat-replace-regexp-in-string |
1154 | "^.*/\\([^/]+\\)$" "\\1" object-path))) | |
eeb44655 | 1155 | |
eeb44655 MA |
1156 | (defun tramp-bluez-address (device) |
1157 | "Return bluetooth device address from a given bluetooth DEVICE name." | |
1158 | (when (stringp device) | |
1159 | (if (string-match tramp-ipv6-regexp device) | |
1160 | (match-string 0 device) | |
1161 | (cadr (assoc device (tramp-bluez-list-devices)))))) | |
1162 | ||
1163 | (defun tramp-bluez-device (address) | |
1164 | "Return bluetooth device name from a given bluetooth device ADDRESS. | |
1165 | ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." | |
1166 | (when (stringp address) | |
1167 | (while (string-match "[][]" address) | |
1168 | (setq address (replace-match "" t t address))) | |
1169 | (let (result) | |
1170 | (dolist (item (tramp-bluez-list-devices) result) | |
1171 | (when (string-match address (cadr item)) | |
1172 | (setq result (car item))))))) | |
1173 | ||
1174 | \f | |
1175 | ;; D-Bus GVFS functions. | |
1176 | ||
1177 | (defun tramp-gvfs-handler-askpassword (message user domain flags) | |
1178 | "Implementation for the \"org.gtk.vfs.MountOperation.askPassword\" method." | |
1179 | (let* ((filename | |
1180 | (tramp-gvfs-file-name (dbus-event-path-name last-input-event))) | |
1181 | (pw-prompt | |
1182 | (format | |
1183 | "%s for %s " | |
1184 | (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message) | |
1185 | (capitalize (match-string 1 message)) | |
1186 | "Password") | |
1187 | filename)) | |
1188 | password) | |
1189 | ||
1190 | (condition-case nil | |
1191 | (with-parsed-tramp-file-name filename l | |
1192 | (when (and (zerop (length user)) | |
1193 | (not | |
1194 | (zerop (logand flags tramp-gvfs-password-need-username)))) | |
1195 | (setq user (read-string "User name: "))) | |
1196 | (when (and (zerop (length domain)) | |
1197 | (not (zerop (logand flags tramp-gvfs-password-need-domain)))) | |
1198 | (setq domain (read-string "Domain name: "))) | |
1199 | ||
1200 | (tramp-message l 6 "%S %S %S %d" message user domain flags) | |
1201 | (setq tramp-current-method l-method | |
1202 | tramp-current-user user | |
1203 | tramp-current-host l-host | |
1204 | password (tramp-read-passwd | |
1205 | (tramp-get-connection-process l) pw-prompt)) | |
1206 | ||
1207 | ;; Return result. | |
1208 | (if (stringp password) | |
1209 | (list | |
1210 | t ;; password handled. | |
1211 | nil ;; no abort of D-Bus. | |
1212 | password | |
1213 | (tramp-file-name-real-user l) | |
1214 | domain | |
1215 | nil ;; not anonymous. | |
1216 | 0) ;; no password save. | |
1217 | ;; No password provided. | |
1218 | (list nil t "" (tramp-file-name-real-user l) domain nil 0))) | |
1219 | ||
1220 | ;; When QUIT is raised, we shall return this information to D-Bus. | |
1221 | (quit (list nil t "" "" "" nil 0))))) | |
1222 | ||
1223 | (defun tramp-gvfs-handler-askquestion (message choices) | |
1224 | "Implementation for the \"org.gtk.vfs.MountOperation.askQuestion\" method." | |
1225 | (save-window-excursion | |
1226 | (let ((enable-recursive-minibuffers t) | |
1227 | choice) | |
1228 | ||
1229 | (condition-case nil | |
1230 | (with-parsed-tramp-file-name | |
1231 | (tramp-gvfs-file-name (dbus-event-path-name last-input-event)) nil | |
1232 | (tramp-message v 6 "%S %S" message choices) | |
1233 | ||
1234 | ;; In theory, there can be several choices. Until now, | |
1235 | ;; there is only the question whether to accept an unknown | |
1236 | ;; host signature. | |
1237 | (with-temp-buffer | |
9e021389 | 1238 | ;; Preserve message for `progress-reporter'. |
6139f995 | 1239 | (tramp-compat-with-temp-message "" |
9e021389 MA |
1240 | (insert message) |
1241 | (pop-to-buffer (current-buffer)) | |
1242 | (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) | |
1243 | (tramp-message v 6 "%d" choice))) | |
eeb44655 | 1244 | |
1efeec86 MA |
1245 | ;; When the choice is "no", we set a dummy fuse-mountpoint |
1246 | ;; in order to leave the timeout. | |
eeb44655 | 1247 | (unless (zerop choice) |
1efeec86 | 1248 | (tramp-set-file-property v "/" "fuse-mountpoint" "/")) |
eeb44655 MA |
1249 | |
1250 | (list | |
1251 | t ;; handled. | |
1252 | nil ;; no abort of D-Bus. | |
1253 | choice)) | |
1254 | ||
9e021389 MA |
1255 | ;; When QUIT is raised, we shall return this information to D-Bus. |
1256 | (quit (list nil t 0)))))) | |
eeb44655 MA |
1257 | |
1258 | (defun tramp-gvfs-handler-mounted-unmounted (mount-info) | |
1259 | "Signal handler for the \"org.gtk.vfs.MountTracker.mounted\" and | |
1260 | \"org.gtk.vfs.MountTracker.unmounted\" signals." | |
1261 | (ignore-errors | |
4f201088 MA |
1262 | (let ((signal-name (dbus-event-member-name last-input-event)) |
1263 | (elt mount-info)) | |
1264 | ;; Jump over the first elements of the mount info. Since there | |
e4920bc9 | 1265 | ;; were changes in the entries, we cannot access dedicated |
4f201088 MA |
1266 | ;; elements. |
1267 | (while (stringp (car elt)) (setq elt (cdr elt))) | |
3675b169 | 1268 | (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr elt))) |
4f201088 | 1269 | (mount-spec (caddr elt)) |
3675b169 MA |
1270 | (default-location (tramp-gvfs-dbus-byte-array-to-string |
1271 | (cadddr elt))) | |
1272 | (method (tramp-gvfs-dbus-byte-array-to-string | |
4f201088 | 1273 | (cadr (assoc "type" (cadr mount-spec))))) |
3675b169 | 1274 | (user (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1275 | (cadr (assoc "user" (cadr mount-spec))))) |
3675b169 | 1276 | (domain (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1277 | (cadr (assoc "domain" (cadr mount-spec))))) |
3675b169 | 1278 | (host (tramp-gvfs-dbus-byte-array-to-string |
4f201088 MA |
1279 | (cadr (or (assoc "host" (cadr mount-spec)) |
1280 | (assoc "server" (cadr mount-spec)))))) | |
3675b169 | 1281 | (port (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1282 | (cadr (assoc "port" (cadr mount-spec))))) |
3675b169 | 1283 | (ssl (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1284 | (cadr (assoc "ssl" (cadr mount-spec))))) |
3675b169 MA |
1285 | (prefix (concat (tramp-gvfs-dbus-byte-array-to-string |
1286 | (car mount-spec)) | |
1287 | (tramp-gvfs-dbus-byte-array-to-string | |
4f201088 MA |
1288 | (cadr (assoc "share" (cadr mount-spec))))))) |
1289 | (when (string-match "^smb" method) | |
1290 | (setq method "smb")) | |
1291 | (when (string-equal "obex" method) | |
1292 | (setq host (tramp-bluez-device host))) | |
1293 | (when (and (string-equal "dav" method) (string-equal "true" ssl)) | |
1294 | (setq method "davs")) | |
1295 | (unless (zerop (length domain)) | |
1296 | (setq user (concat user tramp-prefix-domain-format domain))) | |
1297 | (unless (zerop (length port)) | |
1298 | (setq host (concat host tramp-prefix-port-format port))) | |
1299 | (with-parsed-tramp-file-name | |
1300 | (tramp-make-tramp-file-name method user host "") nil | |
1301 | (tramp-message | |
1302 | v 6 "%s %s" | |
1303 | signal-name (tramp-gvfs-stringify-dbus-message mount-info)) | |
1304 | (tramp-set-file-property v "/" "list-mounts" 'undef) | |
3675b169 | 1305 | (if (string-equal (downcase signal-name) "unmounted") |
4f201088 MA |
1306 | (tramp-set-file-property v "/" "fuse-mountpoint" nil) |
1307 | ;; Set prefix, mountpoint and location. | |
1308 | (unless (string-equal prefix "/") | |
1309 | (tramp-set-file-property v "/" "prefix" prefix)) | |
1310 | (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint) | |
1311 | (tramp-set-file-property | |
1312 | v "/" "default-location" default-location))))))) | |
eeb44655 | 1313 | |
91aafa16 MA |
1314 | (when tramp-gvfs-enabled |
1315 | (dbus-register-signal | |
1316 | :session nil tramp-gvfs-path-mounttracker | |
1317 | tramp-gvfs-interface-mounttracker "mounted" | |
1318 | 'tramp-gvfs-handler-mounted-unmounted) | |
1319 | (dbus-register-signal | |
1320 | :session nil tramp-gvfs-path-mounttracker | |
1321 | tramp-gvfs-interface-mounttracker "Mounted" | |
1322 | 'tramp-gvfs-handler-mounted-unmounted) | |
1323 | ||
1324 | (dbus-register-signal | |
1325 | :session nil tramp-gvfs-path-mounttracker | |
1326 | tramp-gvfs-interface-mounttracker "unmounted" | |
1327 | 'tramp-gvfs-handler-mounted-unmounted) | |
1328 | (dbus-register-signal | |
1329 | :session nil tramp-gvfs-path-mounttracker | |
1330 | tramp-gvfs-interface-mounttracker "Unmounted" | |
1331 | 'tramp-gvfs-handler-mounted-unmounted)) | |
eeb44655 MA |
1332 | |
1333 | (defun tramp-gvfs-connection-mounted-p (vec) | |
1334 | "Check, whether the location is already mounted." | |
1efeec86 MA |
1335 | (or |
1336 | (tramp-get-file-property vec "/" "fuse-mountpoint" nil) | |
1337 | (catch 'mounted | |
1338 | (dolist | |
1339 | (elt | |
1d51f99c | 1340 | (with-tramp-file-property vec "/" "list-mounts" |
1efeec86 MA |
1341 | (with-tramp-dbus-call-method vec t |
1342 | :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker | |
3675b169 | 1343 | tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts)) |
1efeec86 | 1344 | nil) |
4f201088 | 1345 | ;; Jump over the first elements of the mount info. Since there |
e4920bc9 | 1346 | ;; were changes in the entries, we cannot access dedicated |
4f201088 MA |
1347 | ;; elements. |
1348 | (while (stringp (car elt)) (setq elt (cdr elt))) | |
3675b169 MA |
1349 | (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string |
1350 | (cadr elt))) | |
4f201088 | 1351 | (mount-spec (caddr elt)) |
3675b169 MA |
1352 | (default-location (tramp-gvfs-dbus-byte-array-to-string |
1353 | (cadddr elt))) | |
1354 | (method (tramp-gvfs-dbus-byte-array-to-string | |
4f201088 | 1355 | (cadr (assoc "type" (cadr mount-spec))))) |
3675b169 | 1356 | (user (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1357 | (cadr (assoc "user" (cadr mount-spec))))) |
3675b169 | 1358 | (domain (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1359 | (cadr (assoc "domain" (cadr mount-spec))))) |
3675b169 | 1360 | (host (tramp-gvfs-dbus-byte-array-to-string |
4f201088 MA |
1361 | (cadr (or (assoc "host" (cadr mount-spec)) |
1362 | (assoc "server" (cadr mount-spec)))))) | |
3675b169 | 1363 | (port (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1364 | (cadr (assoc "port" (cadr mount-spec))))) |
3675b169 | 1365 | (ssl (tramp-gvfs-dbus-byte-array-to-string |
4f201088 | 1366 | (cadr (assoc "ssl" (cadr mount-spec))))) |
3675b169 MA |
1367 | (prefix (concat (tramp-gvfs-dbus-byte-array-to-string |
1368 | (car mount-spec)) | |
1369 | (tramp-gvfs-dbus-byte-array-to-string | |
4f201088 | 1370 | (cadr (assoc "share" (cadr mount-spec))))))) |
1efeec86 MA |
1371 | (when (string-match "^smb" method) |
1372 | (setq method "smb")) | |
1373 | (when (string-equal "obex" method) | |
1374 | (setq host (tramp-bluez-device host))) | |
1375 | (when (and (string-equal "dav" method) (string-equal "true" ssl)) | |
1376 | (setq method "davs")) | |
1377 | (when (and (string-equal "synce" method) (zerop (length user))) | |
1378 | (setq user (or (tramp-file-name-user vec) ""))) | |
1379 | (unless (zerop (length domain)) | |
1380 | (setq user (concat user tramp-prefix-domain-format domain))) | |
1381 | (unless (zerop (length port)) | |
1382 | (setq host (concat host tramp-prefix-port-format port))) | |
1383 | (when (and | |
1384 | (string-equal method (tramp-file-name-method vec)) | |
1385 | (string-equal user (or (tramp-file-name-user vec) "")) | |
1386 | (string-equal host (tramp-file-name-host vec)) | |
1387 | (string-match (concat "^" (regexp-quote prefix)) | |
1388 | (tramp-file-name-localname vec))) | |
4f201088 | 1389 | ;; Set prefix, mountpoint and location. |
1efeec86 MA |
1390 | (unless (string-equal prefix "/") |
1391 | (tramp-set-file-property vec "/" "prefix" prefix)) | |
4f201088 MA |
1392 | (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) |
1393 | (tramp-set-file-property vec "/" "default-location" default-location) | |
1efeec86 | 1394 | (throw 'mounted t))))))) |
eeb44655 | 1395 | |
3675b169 MA |
1396 | (defun tramp-gvfs-mount-spec-entry (key value) |
1397 | "Construct a mount-spec entry to be used in a mount_spec. | |
1398 | It was \"a(say)\", but has changed to \"a{sv})\"." | |
1399 | (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature) | |
1400 | (list :dict-entry key | |
1401 | (list :variant (tramp-gvfs-dbus-string-to-byte-array value))) | |
1402 | (list :struct key (tramp-gvfs-dbus-string-to-byte-array value)))) | |
1403 | ||
eeb44655 MA |
1404 | (defun tramp-gvfs-mount-spec (vec) |
1405 | "Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"." | |
1406 | (let* ((method (tramp-file-name-method vec)) | |
1407 | (user (tramp-file-name-real-user vec)) | |
1408 | (domain (tramp-file-name-domain vec)) | |
1409 | (host (tramp-file-name-real-host vec)) | |
1410 | (port (tramp-file-name-port vec)) | |
1411 | (localname (tramp-file-name-localname vec)) | |
1412 | (ssl (if (string-match "^davs" method) "true" "false")) | |
38726039 SM |
1413 | (mount-spec |
1414 | `(:array | |
1415 | ,@(cond | |
1416 | ((string-equal "smb" method) | |
1417 | (string-match "^/?\\([^/]+\\)" localname) | |
1418 | (list (tramp-gvfs-mount-spec-entry "type" "smb-share") | |
1419 | (tramp-gvfs-mount-spec-entry "server" host) | |
352d3bea MA |
1420 | (tramp-gvfs-mount-spec-entry |
1421 | "share" (match-string 1 localname)))) | |
38726039 SM |
1422 | ((string-equal "obex" method) |
1423 | (list (tramp-gvfs-mount-spec-entry "type" method) | |
1424 | (tramp-gvfs-mount-spec-entry | |
1425 | "host" (concat "[" (tramp-bluez-address host) "]")))) | |
1426 | ((string-match "\\`dav" method) | |
1427 | (list (tramp-gvfs-mount-spec-entry "type" "dav") | |
1428 | (tramp-gvfs-mount-spec-entry "host" host) | |
1429 | (tramp-gvfs-mount-spec-entry "ssl" ssl))) | |
1430 | (t | |
1431 | (list (tramp-gvfs-mount-spec-entry "type" method) | |
1432 | (tramp-gvfs-mount-spec-entry "host" host)))) | |
1433 | ,@(when user | |
1434 | (list (tramp-gvfs-mount-spec-entry "user" user))) | |
1435 | ,@(when domain | |
1436 | (list (tramp-gvfs-mount-spec-entry "domain" domain))) | |
1437 | ,@(when port | |
352d3bea MA |
1438 | (list (tramp-gvfs-mount-spec-entry |
1439 | "port" (number-to-string port)))))) | |
38726039 SM |
1440 | (mount-pref |
1441 | (if (and (string-match "\\`dav" method) | |
1442 | (string-match "^/?[^/]+" localname)) | |
1443 | (match-string 0 localname) | |
1444 | "/"))) | |
1efeec86 | 1445 | |
eeb44655 | 1446 | ;; Return. |
3675b169 | 1447 | `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec))) |
eeb44655 MA |
1448 | |
1449 | \f | |
91aafa16 | 1450 | ;; Connection functions. |
eeb44655 MA |
1451 | |
1452 | (defun tramp-gvfs-maybe-open-connection (vec) | |
1453 | "Maybe open a connection VEC. | |
1454 | Does not do anything if a connection is already open, but re-opens the | |
1455 | connection if a previous connection has died for some reason." | |
35c3d36e | 1456 | (tramp-check-proper-method-and-host vec) |
eeb44655 MA |
1457 | |
1458 | ;; We set the file name, in case there are incoming D-Bus signals or | |
1459 | ;; D-Bus errors. | |
1460 | (setq tramp-gvfs-dbus-event-vector vec) | |
1461 | ||
1462 | ;; For password handling, we need a process bound to the connection | |
1463 | ;; buffer. Therefore, we create a dummy process. Maybe there is a | |
1464 | ;; better solution? | |
3675b169 | 1465 | (unless (get-buffer-process (tramp-get-connection-buffer vec)) |
eeb44655 MA |
1466 | (let ((p (make-network-process |
1467 | :name (tramp-buffer-name vec) | |
3675b169 | 1468 | :buffer (tramp-get-connection-buffer vec) |
eeb44655 | 1469 | :server t :host 'local :service t))) |
bd8fadca | 1470 | (tramp-compat-set-process-query-on-exit-flag p nil))) |
eeb44655 MA |
1471 | |
1472 | (unless (tramp-gvfs-connection-mounted-p vec) | |
1473 | (let* ((method (tramp-file-name-method vec)) | |
1474 | (user (tramp-file-name-user vec)) | |
1475 | (host (tramp-file-name-host vec)) | |
3675b169 | 1476 | (localname (tramp-file-name-localname vec)) |
eeb44655 MA |
1477 | (object-path |
1478 | (tramp-gvfs-object-path | |
1479 | (tramp-make-tramp-file-name method user host "")))) | |
1480 | ||
3675b169 MA |
1481 | (when (and (string-equal method "smb") |
1482 | (string-equal localname "/")) | |
1483 | (tramp-error vec 'file-error "Filename must contain a Windows share")) | |
1484 | ||
1d51f99c | 1485 | (with-tramp-progress-reporter |
655bded0 MA |
1486 | vec 3 |
1487 | (if (zerop (length user)) | |
1488 | (format "Opening connection for %s using %s" host method) | |
1489 | (format "Opening connection for %s@%s using %s" user host method)) | |
1490 | ||
22bcf204 | 1491 | ;; Enable auth-source and password-cache. |
655bded0 MA |
1492 | (tramp-set-connection-property vec "first-password-request" t) |
1493 | ||
2c68ca0e | 1494 | ;; There will be a callback of "askPassword" when a password is |
655bded0 MA |
1495 | ;; needed. |
1496 | (dbus-register-method | |
1497 | :session dbus-service-emacs object-path | |
1498 | tramp-gvfs-interface-mountoperation "askPassword" | |
1499 | 'tramp-gvfs-handler-askpassword) | |
3675b169 MA |
1500 | (dbus-register-method |
1501 | :session dbus-service-emacs object-path | |
1502 | tramp-gvfs-interface-mountoperation "AskPassword" | |
1503 | 'tramp-gvfs-handler-askpassword) | |
655bded0 | 1504 | |
2c68ca0e | 1505 | ;; There could be a callback of "askQuestion" when adding fingerprint. |
655bded0 MA |
1506 | (dbus-register-method |
1507 | :session dbus-service-emacs object-path | |
1508 | tramp-gvfs-interface-mountoperation "askQuestion" | |
1509 | 'tramp-gvfs-handler-askquestion) | |
3675b169 MA |
1510 | (dbus-register-method |
1511 | :session dbus-service-emacs object-path | |
1512 | tramp-gvfs-interface-mountoperation "AskQuestion" | |
1513 | 'tramp-gvfs-handler-askquestion) | |
655bded0 MA |
1514 | |
1515 | ;; The call must be asynchronously, because of the "askPassword" | |
1516 | ;; or "askQuestion"callbacks. | |
3675b169 MA |
1517 | (if (string-match "(so)$" tramp-gvfs-mountlocation-signature) |
1518 | (with-tramp-dbus-call-method vec nil | |
1519 | :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker | |
1520 | tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation | |
1521 | (tramp-gvfs-mount-spec vec) | |
1522 | `(:struct :string ,(dbus-get-unique-name :session) | |
1523 | :object-path ,object-path)) | |
1524 | (with-tramp-dbus-call-method vec nil | |
1525 | :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker | |
1526 | tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation | |
1527 | (tramp-gvfs-mount-spec vec) | |
1528 | :string (dbus-get-unique-name :session) :object-path object-path)) | |
655bded0 MA |
1529 | |
1530 | ;; We must wait, until the mount is applied. This will be | |
1531 | ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint" | |
1532 | ;; file property. | |
1533 | (with-timeout | |
88f6a933 MA |
1534 | ((or (tramp-get-method-parameter method 'tramp-connection-timeout) |
1535 | tramp-connection-timeout) | |
655bded0 MA |
1536 | (if (zerop (length (tramp-file-name-user vec))) |
1537 | (tramp-error | |
1538 | vec 'file-error | |
1539 | "Timeout reached mounting %s using %s" host method) | |
eeb44655 MA |
1540 | (tramp-error |
1541 | vec 'file-error | |
655bded0 MA |
1542 | "Timeout reached mounting %s@%s using %s" user host method))) |
1543 | (while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil)) | |
1544 | (read-event nil nil 0.1))) | |
1545 | ||
1efeec86 MA |
1546 | ;; If `tramp-gvfs-handler-askquestion' has returned "No", it |
1547 | ;; is marked with the fuse-mountpoint "/". We shall react. | |
1548 | (when (string-equal | |
1549 | (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/") | |
50bfdd5d MA |
1550 | (tramp-error vec 'file-error "FUSE mount denied"))))) |
1551 | ||
1552 | ;; In `tramp-check-cached-permissions', the connection properties | |
1553 | ;; {uig,gid}-{integer,string} are used. We set them to their local | |
1554 | ;; counterparts. | |
1555 | (with-tramp-connection-property | |
1556 | vec "uid-integer" (tramp-get-local-uid 'integer)) | |
1557 | (with-tramp-connection-property | |
1558 | vec "gid-integer" (tramp-get-local-gid 'integer)) | |
1559 | (with-tramp-connection-property | |
1560 | vec "uid-string" (tramp-get-local-uid 'string)) | |
1561 | (with-tramp-connection-property | |
1562 | vec "gid-string" (tramp-get-local-gid 'string))) | |
eeb44655 | 1563 | |
1efeec86 MA |
1564 | (defun tramp-gvfs-send-command (vec command &rest args) |
1565 | "Send the COMMAND with its ARGS to connection VEC. | |
1566 | COMMAND is usually a command from the gvfs-* utilities. | |
3675b169 | 1567 | `call-process' is applied, and it returns `t' if the return code is zero." |
1efeec86 | 1568 | (let (result) |
3675b169 MA |
1569 | (with-current-buffer (tramp-get-connection-buffer vec) |
1570 | (tramp-gvfs-maybe-open-connection vec) | |
1efeec86 MA |
1571 | (erase-buffer) |
1572 | (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " ")) | |
d0853629 | 1573 | (setq result (apply 'tramp-call-process command nil t nil args)) |
3675b169 MA |
1574 | (tramp-message vec 6 "\n%s" (buffer-string)) |
1575 | (zerop result)))) | |
1efeec86 | 1576 | |
eeb44655 MA |
1577 | \f |
1578 | ;; D-Bus BLUEZ functions. | |
1579 | ||
1580 | (defun tramp-bluez-list-devices () | |
99278f8a | 1581 | "Return all discovered bluetooth devices as list. |
eeb44655 MA |
1582 | Every entry is a list (NAME ADDRESS). |
1583 | ||
1584 | If `tramp-bluez-discover-devices-timeout' is an integer, and the last | |
1585 | discovery happened more time before indicated there, a rescan will be | |
1586 | started, which lasts some ten seconds. Otherwise, cached results will | |
1587 | be used." | |
1588 | ;; Reset the scanned devices list if time has passed. | |
1589 | (and (integerp tramp-bluez-discover-devices-timeout) | |
1590 | (integerp tramp-bluez-discovery) | |
1591 | (> (tramp-time-diff (current-time) tramp-bluez-discovery) | |
1592 | tramp-bluez-discover-devices-timeout) | |
1593 | (setq tramp-bluez-devices nil)) | |
1594 | ||
1595 | ;; Rescan if needed. | |
1596 | (unless tramp-bluez-devices | |
1597 | (let ((object-path | |
1598 | (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t | |
1599 | :system tramp-bluez-service "/" | |
1600 | tramp-bluez-interface-manager "DefaultAdapter"))) | |
1601 | (setq tramp-bluez-devices nil | |
1602 | tramp-bluez-discovery t) | |
1603 | (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector nil | |
1604 | :system tramp-bluez-service object-path | |
1605 | tramp-bluez-interface-adapter "StartDiscovery") | |
1606 | (while tramp-bluez-discovery | |
1607 | (read-event nil nil 0.1)))) | |
1608 | (setq tramp-bluez-discovery (current-time)) | |
1609 | (tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-bluez-devices) | |
1610 | tramp-bluez-devices) | |
1611 | ||
1612 | (defun tramp-bluez-property-changed (property value) | |
1613 | "Signal handler for the \"org.bluez.Adapter.PropertyChanged\" signal." | |
1614 | (tramp-message tramp-gvfs-dbus-event-vector 6 "%s %s" property value) | |
1615 | (cond | |
1616 | ((string-equal property "Discovering") | |
1617 | (unless (car value) | |
1618 | ;; "Discovering" FALSE means discovery run has been completed. | |
1619 | ;; We stop it, because we don't need another run. | |
1620 | (setq tramp-bluez-discovery nil) | |
1621 | (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t | |
1622 | :system tramp-bluez-service (dbus-event-path-name last-input-event) | |
1623 | tramp-bluez-interface-adapter "StopDiscovery"))))) | |
1624 | ||
2f7e72f8 MA |
1625 | (when tramp-gvfs-enabled |
1626 | (dbus-register-signal | |
1627 | :system nil nil tramp-bluez-interface-adapter "PropertyChanged" | |
1628 | 'tramp-bluez-property-changed)) | |
eeb44655 MA |
1629 | |
1630 | (defun tramp-bluez-device-found (device args) | |
1631 | "Signal handler for the \"org.bluez.Adapter.DeviceFound\" signal." | |
1632 | (tramp-message tramp-gvfs-dbus-event-vector 6 "%s %s" device args) | |
1633 | (let ((alias (car (cadr (assoc "Alias" args)))) | |
1634 | (address (car (cadr (assoc "Address" args))))) | |
1635 | ;; Maybe we shall check the device class for being a proper | |
1636 | ;; device, and call also SDP in order to find the obex service. | |
1637 | (add-to-list 'tramp-bluez-devices (list alias address)))) | |
1638 | ||
2f7e72f8 MA |
1639 | (when tramp-gvfs-enabled |
1640 | (dbus-register-signal | |
1641 | :system nil nil tramp-bluez-interface-adapter "DeviceFound" | |
1642 | 'tramp-bluez-device-found)) | |
eeb44655 | 1643 | |
5d89d9d2 | 1644 | (defun tramp-bluez-parse-device-names (_ignore) |
eeb44655 MA |
1645 | "Return a list of (nil host) tuples allowed to access." |
1646 | (mapcar | |
1647 | (lambda (x) (list nil (car x))) | |
1648 | (tramp-bluez-list-devices))) | |
1649 | ||
1650 | ;; Add completion function for OBEX method. | |
2f7e72f8 MA |
1651 | (when (and tramp-gvfs-enabled |
1652 | (member tramp-bluez-service (dbus-list-known-names :system))) | |
eeb44655 MA |
1653 | (tramp-set-completion-function |
1654 | "obex" '((tramp-bluez-parse-device-names "")))) | |
1655 | ||
1656 | \f | |
1657 | ;; D-Bus zeroconf functions. | |
1658 | ||
5d89d9d2 | 1659 | (defun tramp-zeroconf-parse-workstation-device-names (_ignore) |
eeb44655 MA |
1660 | "Return a list of (user host) tuples allowed to access." |
1661 | (mapcar | |
1662 | (lambda (x) | |
1663 | (list nil (zeroconf-service-host x))) | |
1664 | (zeroconf-list-services "_workstation._tcp"))) | |
1665 | ||
5d89d9d2 | 1666 | (defun tramp-zeroconf-parse-webdav-device-names (_ignore) |
eeb44655 MA |
1667 | "Return a list of (user host) tuples allowed to access." |
1668 | (mapcar | |
1669 | (lambda (x) | |
1670 | (let ((host (zeroconf-service-host x)) | |
1671 | (port (zeroconf-service-port x)) | |
1672 | (text (zeroconf-service-txt x)) | |
1673 | user) | |
1674 | (when port | |
1675 | (setq host (format "%s%s%d" host tramp-prefix-port-regexp port))) | |
1676 | ;; A user is marked in a TXT field like "u=guest". | |
1677 | (while text | |
1678 | (when (string-match "u=\\(.+\\)$" (car text)) | |
1679 | (setq user (match-string 1 (car text)))) | |
1680 | (setq text (cdr text))) | |
1681 | (list user host))) | |
1682 | (zeroconf-list-services "_webdav._tcp"))) | |
1683 | ||
1684 | ;; Add completion function for DAV and DAVS methods. | |
2f7e72f8 MA |
1685 | (when (and tramp-gvfs-enabled |
1686 | (member zeroconf-service-avahi (dbus-list-known-names :system))) | |
eeb44655 MA |
1687 | (zeroconf-init tramp-gvfs-zeroconf-domain) |
1688 | (tramp-set-completion-function | |
1689 | "sftp" '((tramp-zeroconf-parse-workstation-device-names ""))) | |
1690 | (tramp-set-completion-function | |
1691 | "dav" '((tramp-zeroconf-parse-webdav-device-names ""))) | |
1692 | (tramp-set-completion-function | |
1693 | "davs" '((tramp-zeroconf-parse-webdav-device-names "")))) | |
1694 | ||
7ae3ea65 MA |
1695 | \f |
1696 | ;; D-Bus SYNCE functions. | |
1697 | ||
1698 | (defun tramp-synce-list-devices () | |
99278f8a | 1699 | "Return all discovered synce devices as list. |
d557e7a6 | 1700 | They are retrieved from the hal daemon." |
7ae3ea65 MA |
1701 | (let (tramp-synce-devices) |
1702 | (dolist (device | |
1703 | (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t | |
d557e7a6 MA |
1704 | :system tramp-hal-service tramp-hal-path-manager |
1705 | tramp-hal-interface-manager "GetAllDevices")) | |
99278f8a MA |
1706 | (when (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t |
1707 | :system tramp-hal-service device tramp-hal-interface-device | |
1708 | "PropertyExists" "sync.plugin") | |
af9ff9e8 MA |
1709 | (let ((prop |
1710 | (with-tramp-dbus-call-method | |
1711 | tramp-gvfs-dbus-event-vector t | |
1712 | :system tramp-hal-service device tramp-hal-interface-device | |
1713 | "GetPropertyString" "pda.pocketpc.name"))) | |
1714 | (unless (member prop tramp-synce-devices) | |
1715 | (push prop tramp-synce-devices))))) | |
7ae3ea65 MA |
1716 | (tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-synce-devices) |
1717 | tramp-synce-devices)) | |
1718 | ||
5d89d9d2 | 1719 | (defun tramp-synce-parse-device-names (_ignore) |
7ae3ea65 MA |
1720 | "Return a list of (nil host) tuples allowed to access." |
1721 | (mapcar | |
1722 | (lambda (x) (list nil x)) | |
1723 | (tramp-synce-list-devices))) | |
1724 | ||
1725 | ;; Add completion function for SYNCE method. | |
2f7e72f8 MA |
1726 | (when tramp-gvfs-enabled |
1727 | (tramp-set-completion-function | |
1728 | "synce" '((tramp-synce-parse-device-names "")))) | |
7ae3ea65 | 1729 | |
0f34aa77 MA |
1730 | (add-hook 'tramp-unload-hook |
1731 | (lambda () | |
1732 | (unload-feature 'tramp-gvfs 'force))) | |
1733 | ||
eeb44655 MA |
1734 | (provide 'tramp-gvfs) |
1735 | ||
1736 | ;;; TODO: | |
1737 | ||
eeb44655 | 1738 | ;; * Host name completion via smb-server or smb-network. |
2c68ca0e | 1739 | ;; * Check how two shares of the same SMB server can be mounted in |
eeb44655 MA |
1740 | ;; parallel. |
1741 | ;; * Apply SDP on bluetooth devices, in order to filter out obex | |
1742 | ;; capability. | |
1743 | ;; * Implement obex for other serial communication but bluetooth. | |
1744 | ||
1745 | ;;; tramp-gvfs.el ends here |