Commit 3675b169 authored by Michael Albinus's avatar Michael Albinus
Browse files

Major rewrite due to changed D-Bus interface of GVFS 1.14.

* net/tramp-gvfs.el (top): Extend check for gvfs availability.
(tramp-gvfs-methods-mounttracker, tramp-gvfs-listmounts)
(tramp-gvfs-mountlocation, tramp-gvfs-mountlocation-signature):
New defconst.
(tramp-gvfs-file-name-handler-alist) [directory-files]:
[directory-files-and-attributes, file-exists-p, file-modes]: Use
Tramp default handler.
[file-acl, file-selinux-context, process-file, set-file-acl]:
[set-file-modes, set-file-selinux-context, shell-command]:
[start-file-process ]: Remove handler.
[verify-visited-file-modtime]: New handler.
(tramp-gvfs-dbus-string-to-byte-array)
(tramp-gvfs-dbus-byte-array-to-string): New defuns.  Replace all
calls of `dbus-string-to-byte-array' and
`tramp-gvfs-dbus-byte-array-to-string'.
(tramp-gvfs-handle-copy-file)
(tramp-gvfs-handle-delete-directory)
(tramp-gvfs-handle-delete-file, tramp-gvfs-handle-file-attributes)
(tramp-gvfs-handle-file-directory-p)
(tramp-gvfs-handle-file-executable-p)
(tramp-gvfs-handle-file-name-all-completions)
(tramp-gvfs-handle-file-readable-p)
(tramp-gvfs-handle-file-writable-p)
(tramp-gvfs-handle-insert-directory)
(tramp-gvfs-handle-insert-file-contents)
(tramp-gvfs-handle-make-directory, tramp-gvfs-handle-rename-file)
(tramp-gvfs-handle-set-visited-file-modtime)
(tramp-gvfs-handle-write-region): Rewrite.
(tramp-gvfs-handle-file-acl)
(tramp-gvfs-handle-file-selinux-context)
(tramp-gvfs-handle-process-file, tramp-gvfs-handle-set-file-acl)
(tramp-gvfs-handle-set-file-modes)
(tramp-gvfs-handle-set-file-selinux-context)
(tramp-gvfs-handle-shell-command)
(tramp-gvfs-handle-start-file-process)
(tramp-gvfs-handle-verify-visited-file-modtime): Remove defuns.
(tramp-gvfs-url-file-name): Do not use `file-truename', we work
over the symlinks.  Fix user handling.
(top, tramp-gvfs-handler-mounted-unmounted): Handle different names
of the D-Bus signals.
(tramp-gvfs-connection-mounted-p): Handle different names of the
D-Bus methods.
(tramp-gvfs-mount-spec-entry): New defun.
(tramp-gvfs-mount-spec): Use it.
(tramp-gvfs-maybe-open-connection): Check, that in case of "smb"
there is a share name.  Handle different names of the D-Bus
signals and methods.
(tramp-gvfs-maybe-open-connection): Set connection properties
needed for `tramp-check-cached-permissions'.
(tramp-gvfs-send-command): Apply `tramp-gvfs-maybe-open-connection'.
Return t or nil.

* net/tramp.el (tramp-backtrace): Move up.
(tramp-error): Apply a backtrace into the debug buffer when
`tramp-verbose > 9.
(tramp-file-mode-type-map, tramp-file-mode-from-int)
(tramp-file-mode-permissions, tramp-get-local-uid)
(tramp-get-local-gid, tramp-check-cached-permissions): Move from
tramp-sh.el.

* net/tramp-sh.el (tramp-file-mode-type-map)
(tramp-check-cached-permissions, tramp-file-mode-from-int)
(tramp-file-mode-permissions, tramp-get-local-uid)
(tramp-get-local-gid): Move to tramp.el.
parent 27a98a62
2013-03-09 Michael Albinus <michael.albinus@gmx.de>
Major rewrite due to changed D-Bus interface of GVFS 1.14.
* net/tramp-gvfs.el (top): Extend check for gvfs availability.
(tramp-gvfs-methods-mounttracker, tramp-gvfs-listmounts)
(tramp-gvfs-mountlocation, tramp-gvfs-mountlocation-signature):
New defconst.
(tramp-gvfs-file-name-handler-alist) [directory-files]:
[directory-files-and-attributes, file-exists-p, file-modes]: Use
Tramp default handler.
[file-acl, file-selinux-context, process-file, set-file-acl]:
[set-file-modes, set-file-selinux-context, shell-command]:
[start-file-process ]: Remove handler.
[verify-visited-file-modtime]: New handler.
(tramp-gvfs-dbus-string-to-byte-array)
(tramp-gvfs-dbus-byte-array-to-string): New defuns. Replace all
calls of `dbus-string-to-byte-array' and
`tramp-gvfs-dbus-byte-array-to-string'.
(tramp-gvfs-handle-copy-file)
(tramp-gvfs-handle-delete-directory)
(tramp-gvfs-handle-delete-file, tramp-gvfs-handle-file-attributes)
(tramp-gvfs-handle-file-directory-p)
(tramp-gvfs-handle-file-executable-p)
(tramp-gvfs-handle-file-name-all-completions)
(tramp-gvfs-handle-file-readable-p)
(tramp-gvfs-handle-file-writable-p)
(tramp-gvfs-handle-insert-directory)
(tramp-gvfs-handle-insert-file-contents)
(tramp-gvfs-handle-make-directory, tramp-gvfs-handle-rename-file)
(tramp-gvfs-handle-set-visited-file-modtime)
(tramp-gvfs-handle-write-region): Rewrite.
(tramp-gvfs-handle-file-acl)
(tramp-gvfs-handle-file-selinux-context)
(tramp-gvfs-handle-process-file, tramp-gvfs-handle-set-file-acl)
(tramp-gvfs-handle-set-file-modes)
(tramp-gvfs-handle-set-file-selinux-context)
(tramp-gvfs-handle-shell-command)
(tramp-gvfs-handle-start-file-process)
(tramp-gvfs-handle-verify-visited-file-modtime): Remove defuns.
(tramp-gvfs-url-file-name): Do not use `file-truename', we work
over the symlinks. Fix user handling.
(top, tramp-gvfs-handler-mounted-unmounted): Handle different names
of the D-Bus signals.
(tramp-gvfs-connection-mounted-p): Handle different names of the
D-Bus methods.
(tramp-gvfs-mount-spec-entry): New defun.
(tramp-gvfs-mount-spec): Use it.
(tramp-gvfs-maybe-open-connection): Check, that in case of "smb"
there is a share name. Handle different names of the D-Bus
signals and methods.
(tramp-gvfs-maybe-open-connection): Set connection properties
needed for `tramp-check-cached-permissions'.
(tramp-gvfs-send-command): Apply `tramp-gvfs-maybe-open-connection'.
Return t or nil.
* net/tramp.el (tramp-backtrace): Move up.
(tramp-error): Apply a backtrace into the debug buffer when
`tramp-verbose > 9.
(tramp-file-mode-type-map, tramp-file-mode-from-int)
(tramp-file-mode-permissions, tramp-get-local-uid)
(tramp-get-local-gid, tramp-check-cached-permissions): Move from
tramp-sh.el.
* net/tramp-sh.el (tramp-file-mode-type-map)
(tramp-check-cached-permissions, tramp-file-mode-from-int)
(tramp-file-mode-permissions, tramp-get-local-uid)
(tramp-get-local-gid): Move to tramp.el.
2013-03-09 Stefan Monnier <monnier@iro.umontreal.ca>
 
Separate mouse-1-click-follows-link from mouse-drag-region.
......
......@@ -24,24 +24,28 @@
;;; Commentary:
;; Access functions for the GVFS daemon from Tramp. Tested with GVFS
;; 1.0.2 (Ubuntu 8.10, Gnome 2.24). It has been reported also to run
;; 1.0 (Ubuntu 8.10, Gnome 2.24). It has been reported also to run
;; with GVFS 0.2.5 (Ubuntu 8.04, Gnome 2.22), but there is an
;; incompatibility with the mount_info structure, which has been
;; worked around.
;; It has also been tested with GVFS 1.6.2 (Ubuntu 10.04, Gnome 2.30),
;; It has also been tested with GVFS 1.6 (Ubuntu 10.04, Gnome 2.30),
;; where the default_location has been added to mount_info (see
;; <https://bugzilla.gnome.org/show_bug.cgi?id=561998>.
;; With GVFS 1.14 (Ubuntu 12.10, Gnome 3.6) the interfaces have been
;; changed, again. So we must introspect the D-Bus interfaces.
;; All actions to mount a remote location, and to retrieve mount
;; information, are performed by D-Bus messages. File operations
;; themselves are performed via the mounted filesystem in ~/.gvfs.
;; Consequently, GNU Emacs 23.1 with enabled D-Bus bindings is a
;; precondition.
;; The GVFS D-Bus interface is said to be unstable. There are even no
;; introspection data. The interface, as discovered during
;; development time, is given in respective comments.
;; The GVFS D-Bus interface is said to be unstable. There were even
;; no introspection data before GVFS 1.14. The interface, as
;; discovered during development time, is given in respective
;; comments.
;; The customer option `tramp-gvfs-methods' contains the list of
;; supported connection methods. Per default, these are "dav",
......@@ -147,7 +151,8 @@
;; Emacs 23 on some system types. We don't call `dbus-ping', because
;; this would load dbus.el.
(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session)
(tramp-compat-process-running-p "gvfs-fuse-daemon"))
(or (tramp-compat-process-running-p "gvfs-fuse-daemon")
(tramp-compat-process-running-p "gvfsd-fuse")))
(error "Package `tramp-gvfs' not supported"))
(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
......@@ -156,6 +161,35 @@
(defconst tramp-gvfs-interface-mounttracker "org.gtk.vfs.MountTracker"
"The mount tracking interface in the GVFS daemon.")
;; Introspection data exist since GVFS 1.14. If there are no such
;; data, we expect an earlier interface.
(defconst tramp-gvfs-methods-mounttracker
(dbus-introspect-get-method-names
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker)
"The list of supported methods of the mount tracking interface.")
(defconst tramp-gvfs-listmounts
(if (member "ListMounts" tramp-gvfs-methods-mounttracker)
"ListMounts"
"listMounts")
"The name of the \"listMounts\" method.
It has been changed in GVFS 1.14.")
(defconst tramp-gvfs-mountlocation
(if (member "MountLocation" tramp-gvfs-methods-mounttracker)
"MountLocation"
"mountLocation")
"The name of the \"mountLocation\" method.
It has been changed in GVFS 1.14.")
(defconst tramp-gvfs-mountlocation-signature
(dbus-introspect-get-signature
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation)
"The D-Bus signature of the \"mountLocation\" method.
It has been changed in GVFS 1.14.")
;; <interface name='org.gtk.vfs.MountTracker'>
;; <method name='listMounts'>
;; <arg name='mount_info_list'
......@@ -376,22 +410,22 @@ Every entry is a list (NAME ADDRESS).")
(delete-file . tramp-gvfs-handle-delete-file)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-handle-directory-file-name)
(directory-files . tramp-gvfs-handle-directory-files)
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-gvfs-handle-directory-files-and-attributes)
. tramp-handle-directory-files-and-attributes)
(dired-call-process . ignore)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
;; `executable-find' is not official yet. performed by default handler.
(expand-file-name . tramp-gvfs-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-acl . tramp-gvfs-handle-file-acl)
(file-acl . ignore)
(file-attributes . tramp-gvfs-handle-file-attributes)
(file-directory-p . tramp-gvfs-handle-file-directory-p)
(file-executable-p . tramp-gvfs-handle-file-executable-p)
(file-exists-p . tramp-gvfs-handle-file-exists-p)
(file-exists-p . tramp-handle-file-exists-p)
(file-local-copy . tramp-gvfs-handle-file-local-copy)
;; `file-modes' performed by default handler.
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
(file-name-completion . tramp-handle-file-name-completion)
......@@ -403,7 +437,7 @@ Every entry is a list (NAME ADDRESS).")
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-gvfs-handle-file-selinux-context)
(file-selinux-context . ignore)
(file-symlink-p . tramp-handle-file-symlink-p)
;; `file-truename' performed by default handler.
(file-writable-p . tramp-gvfs-handle-file-writable-p)
......@@ -416,19 +450,18 @@ Every entry is a list (NAME ADDRESS).")
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
(make-symbolic-link . ignore)
(process-file . tramp-gvfs-handle-process-file)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
(set-file-acl . tramp-gvfs-handle-set-file-acl)
(set-file-modes . tramp-gvfs-handle-set-file-modes)
(set-file-selinux-context . tramp-gvfs-handle-set-file-selinux-context)
(set-file-acl . ignore)
(set-file-modes . ignore)
(set-file-selinux-context . ignore)
(set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)
(shell-command . tramp-gvfs-handle-shell-command)
(start-file-process . tramp-gvfs-handle-start-file-process)
(shell-command . ignore)
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(vc-registered . ignore)
(verify-visited-file-modtime
. tramp-gvfs-handle-verify-visited-file-modtime)
;; `verify-visited-file-modtime' performed by default handler.
(write-region . tramp-gvfs-handle-write-region)
)
"Alist of handler functions for Tramp GVFS method.
......@@ -461,11 +494,30 @@ pass to the OPERATION."
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)))
;; D-Bus helper function.
(defun tramp-gvfs-dbus-string-to-byte-array (string)
"Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
(dbus-string-to-byte-array
(if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature)
(concat string (string 0)) string)))
(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
"Like `dbus-byte-array-to-string' but remove trailing \\0 if exists."
;; The byte array could be a variant. Take care.
(let ((byte-array
(if (and (consp byte-array) (atom (car byte-array)))
byte-array (car byte-array))))
(dbus-byte-array-to-string
(if (and (consp byte-array) (zerop (car (last byte-array))))
(butlast byte-array) byte-array))))
(defun tramp-gvfs-stringify-dbus-message (message)
"Convert a D-Bus message into readable UTF8 strings, used for traces."
(cond
((and (consp message) (characterp (car message)))
(format "%S" (dbus-byte-array-to-string message)))
(format "%S" (tramp-gvfs-dbus-byte-array-to-string message)))
((consp message)
(mapcar 'tramp-gvfs-stringify-dbus-message message))
((stringp message)
......@@ -545,74 +597,89 @@ is no information where to trace the message.")
"Like `copy-file' for Tramp files."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(condition-case err
(let ((args
(list
(if (tramp-gvfs-file-name-p filename)
(tramp-gvfs-fuse-file-name filename)
filename)
(if (tramp-gvfs-file-name-p newname)
(tramp-gvfs-fuse-file-name newname)
newname)
ok-if-already-exists keep-date preserve-uid-gid)))
(when preserve-extended-attributes
(setq args (append args (list preserve-extended-attributes))))
(apply 'copy-file args))
;; Error case. Let's try it with the GVFS utilities.
(error
(tramp-message v 4 "`copy-file' failed, trying `gvfs-copy'")
(unless
(zerop
(let ((args
(append (if (or keep-date preserve-uid-gid)
(list "--preserve")
nil)
(list
(tramp-gvfs-url-file-name filename)
(tramp-gvfs-url-file-name newname)))))
(apply 'tramp-gvfs-send-command v "gvfs-copy" args)))
;; Propagate the error.
(tramp-error v (car err) "%s" (cdr err)))))))
(when (file-remote-p newname)
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname))))
(defun tramp-gvfs-handle-delete-directory (directory &optional recursive)
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error
v 'file-already-exists "File %s already exists" newname))
(if (or (and (tramp-tramp-file-p filename)
(not (tramp-gvfs-file-name-p filename)))
(and (tramp-tramp-file-p newname)
(not (tramp-gvfs-file-name-p newname))))
;; We cannot copy directly.
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(cond
(preserve-extended-attributes
(copy-file
filename tmpfile t keep-date preserve-uid-gid
preserve-extended-attributes))
(preserve-uid-gid
(copy-file filename tmpfile t keep-date preserve-uid-gid))
(t
(copy-file filename tmpfile t keep-date)))
(rename-file tmpfile newname ok-if-already-exists))
;; Direct copy.
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(unless
(let ((args
(append (if (or keep-date preserve-uid-gid)
(list "--preserve")
nil)
(list
(tramp-gvfs-url-file-name filename)
(tramp-gvfs-url-file-name newname)))))
(apply 'tramp-gvfs-send-command v "gvfs-copy" args))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(tramp-error-with-buffer
nil v 'file-error
"Copying failed, see buffer `%s' for details." (buffer-name)))))
(when (file-remote-p newname)
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname))))))
(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
(tramp-compat-delete-directory
(tramp-gvfs-fuse-file-name directory) recursive))
(when (and recursive (not (file-symlink-p directory)))
(mapc (lambda (file)
(if (eq t (car (file-attributes file)))
(tramp-compat-delete-directory file recursive trash)
(tramp-compat-delete-file file trash)))
(directory-files
directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
(with-parsed-tramp-file-name directory nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-directory-property v localname)
(unless
(tramp-gvfs-send-command
v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
(tramp-gvfs-url-file-name directory))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(tramp-error-with-buffer
nil v 'file-error "Couldn't delete %s" directory)))))
(defun tramp-gvfs-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(tramp-compat-delete-file (tramp-gvfs-fuse-file-name filename) trash))
(defun tramp-gvfs-handle-directory-files
(directory &optional full match nosort)
"Like `directory-files' for Tramp files."
(let ((fuse-file-name (tramp-gvfs-fuse-file-name directory)))
(mapcar
(lambda (x)
(if (string-match fuse-file-name x)
(replace-match directory t t x)
x))
(directory-files fuse-file-name full match nosort))))
(defun tramp-gvfs-handle-directory-files-and-attributes
(directory &optional full match nosort id-format)
"Like `directory-files-and-attributes' for Tramp files."
(let ((fuse-file-name (tramp-gvfs-fuse-file-name directory)))
(mapcar
(lambda (x)
(when (string-match fuse-file-name (car x))
(setcar x (replace-match directory t t (car x))))
x)
(directory-files-and-attributes
fuse-file-name full match nosort id-format))))
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-directory-property v localname)
(unless
(tramp-gvfs-send-command
v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
(tramp-gvfs-url-file-name filename))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(tramp-error-with-buffer
nil v 'file-error "Couldn't delete %s" filename)))))
(defun tramp-gvfs-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
......@@ -657,25 +724,136 @@ is no information where to trace the message.")
(tramp-run-real-handler
'expand-file-name (list localname))))))
(defun tramp-gvfs-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
(tramp-compat-funcall 'file-acl (tramp-gvfs-fuse-file-name filename)))
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
(unless id-format (setq id-format 'integer))
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
dirp res-symlink-target res-numlinks res-uid res-gid res-access
res-mod res-change res-size res-filemodes res-inode res-device)
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property
v localname (format "file-attributes-%s" id-format)
(tramp-message v 5 "file attributes: %s" localname)
(tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name filename))
;; Parse output ...
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(when (re-search-forward "attributes:" nil t)
;; ... directory or symlink
(goto-char (point-min))
(setq dirp (if (re-search-forward "type:\\s-+directory" nil t) t))
(goto-char (point-min))
(setq res-symlink-target
(if (re-search-forward
"standard::symlink-target:\\s-+\\(\\S-+\\)" nil t)
(match-string 1)))
;; ... number links
(goto-char (point-min))
(setq res-numlinks
(if (re-search-forward "unix::nlink:\\s-+\\([0-9]+\\)" nil t)
(string-to-number (match-string 1)) 0))
;; ... uid and gid
(goto-char (point-min))
(setq res-uid
(or (if (eq id-format 'integer)
(if (re-search-forward
"unix::uid:\\s-+\\([0-9]+\\)" nil t)
(string-to-number (match-string 1)))
(if (re-search-forward
"owner::user:\\s-+\\(\\S-+\\)" nil t)
(match-string 1)))
(tramp-get-local-uid id-format)))
(setq res-gid
(or (if (eq id-format 'integer)
(if (re-search-forward
"unix::gid:\\s-+\\([0-9]+\\)" nil t)
(string-to-number (match-string 1)))
(if (re-search-forward
"owner::group:\\s-+\\(\\S-+\\)" nil t)
(match-string 1)))
(tramp-get-local-gid id-format)))
;; ... last access, modification and change time
(goto-char (point-min))
(setq res-access
(if (re-search-forward
"time::access:\\s-+\\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
(goto-char (point-min))
(setq res-mod
(if (re-search-forward
"time::modified:\\s-+\\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
(goto-char (point-min))
(setq res-change
(if (re-search-forward
"time::changed:\\s-+\\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
;; ... size
(goto-char (point-min))
(setq res-size
(if (re-search-forward
"standard::size:\\s-+\\([0-9]+\\)" nil t)
(string-to-number (match-string 1)) 0))
;; ... file mode flags
(goto-char (point-min))
(setq res-filemodes
(if (re-search-forward "unix::mode:\\s-+\\([0-9]+\\)" nil t)
(tramp-file-mode-from-int (match-string 1))
(if dirp "drwx------" "-rwx------")))
;; ... inode and device
(goto-char (point-min))
(setq res-inode
(if (re-search-forward "unix::inode:\\s-+\\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
(tramp-get-inode v)))
(goto-char (point-min))
(setq res-device
(if (re-search-forward "unix::device:\\s-+\\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
(tramp-get-device v)))
;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for
;; symbolic link, or nil.
(or dirp res-symlink-target)
;; 1. Number of links to file.
res-numlinks
;; 2. File uid.
res-uid
;; 3. File gid.
res-gid
;; 4. Last access time, as a list of integers.
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise.
res-access res-mod res-change
;; 7. Size in bytes (-1, if number is out of range).
res-size
;; 8. File modes.
res-filemodes
;; 9. t if file's gid would change if file were deleted
;; and recreated.
nil
;; 10. Inode number.
res-inode
;; 11. Device number.
res-device
)))))))
(defun tramp-gvfs-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
(file-directory-p (tramp-gvfs-fuse-file-name filename)))
(eq t (car (file-attributes filename))))
(defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
(file-executable-p (tramp-gvfs-fuse-file-name filename)))
(defun tramp-gvfs-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
(file-exists-p (tramp-gvfs-fuse-file-name filename)))
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-executable-p"
(tramp-check-cached-permissions v ?x))))
(defun tramp-gvfs-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
......@@ -691,158 +869,221 @@ is no information where to trace the message.")
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename))
(file-name-all-completions filename (tramp-gvfs-fuse-file-name directory))))
(with-parsed-tramp-file-name (expand-file-name directory) nil
(all-completions
filename
(mapcar
'list
(or
;; Try cache entries for filename, filename with last
;; character removed, filename with last two characters
;; removed, ..., and finally the empty string - all
;; concatenated to the local directory name.
(let ((remote-file-name-inhibit-cache
(or remote-file-name-inhibit-cache
tramp-completion-reread-directory-timeout)))
;; This is inefficient for very long filenames, pity
;; `reduce' is not available...
(car
(apply
'append
(mapcar
(lambda (x)
(let ((cache-hit
(tramp-get-file-property
v
(concat localname (substring filename 0 x))
"file-name-all-completions"
nil)))
(when cache-hit (list cache-hit))))
;; We cannot use a length of 0, because file properties
;; for "foo" and "foo/" are identical.
(tramp-compat-number-sequence (length filename) 1 -1)))))
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
(let ((result '("." ".."))
entry)
;; Get a list of directories and files.
(tramp-gvfs-send-command
v "gvfs-ls" (tramp-gvfs-url-file-name directory))
;; Now grab the output.
(with-temp-buffer
(insert-buffer-substring (tramp-get-connection-buffer v))
(goto-char (point-max))
(while (zerop (forward-line -1))
(setq entry (buffer-substring (point) (point-at-eol)))
(when (string-match filename entry)
(if (file-directory-p (expand-file-name entry directory))
(push (concat entry "/") result)
(push entry result)))))
;; Because the remote op went through OK we know the
;; directory we `cd'-ed to exists.
(tramp-set-file-property v localname "file-exists-p" t)
;; Because the remote op went through OK we know every
;; file listed by `ls' exists.
(mapc (lambda (entry)
(tramp-set-file-property
v (concat localname entry) "file-exists-p" t))
result)
;; Store result in the cache.
(tramp-set-file-property
v (concat localname filename)
"file-name-all-completions" result))))))))
(defun tramp-gvfs-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(file-readable-p (tramp-gvfs-fuse-file-name filename)))