LCOV - code coverage report
Current view: top level - lisp/net - tramp-gvfs.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 10 895 1.1 %
Date: 2017-08-27 09:44:50 Functions: 2 55 3.6 %

          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

Generated by: LCOV version 1.12