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