From 3675b1698d0a3a5a8ee09354f2d15e233de8cece Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 9 Mar 2013 12:06:23 +0100 Subject: [PATCH] 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. --- lisp/ChangeLog | 69 ++++ lisp/net/tramp-gvfs.el | 858 +++++++++++++++++++++++++++-------------- lisp/net/tramp-sh.el | 97 ----- lisp/net/tramp.el | 112 +++++- 4 files changed, 751 insertions(+), 385 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5e625aed387..41d5a4ed0d0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,72 @@ +2013-03-09 Michael Albinus + + 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 Separate mouse-1-click-follows-link from mouse-drag-region. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 7473871e564..e3850653263 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -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 ;; . +;; 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.") + ;; ;; ;; (logand (lsh mode -9) 4) 0)) - (sgid (> (logand (lsh mode -9) 2) 0)) - (sticky (> (logand (lsh mode -9) 1) 0))) - (setq user (tramp-file-mode-permissions user suid "s")) - (setq group (tramp-file-mode-permissions group sgid "s")) - (setq other (tramp-file-mode-permissions other sticky "t")) - (concat type user group other))) - -(defun tramp-file-mode-permissions (perm suid suid-text) - "Convert a permission bitset into a string. -This is used internally by `tramp-file-mode-from-int'." - (let ((r (> (logand perm 4) 0)) - (w (> (logand perm 2) 0)) - (x (> (logand perm 1) 0))) - (concat (or (and r "r") "-") - (or (and w "w") "-") - (or (and suid x suid-text) ; suid, execute - (and suid (upcase suid-text)) ; suid, !execute - (and x "x") "-")))) ; !suid - (defun tramp-shell-case-fold (string) "Converts STRING to shell glob pattern which ignores case." (mapconcat @@ -4992,14 +4903,6 @@ This is used internally by `tramp-file-mode-from-int'." ;; The command might not always return a number. (if (and (equal id-format 'integer) (not (integerp res))) -1 res)))) -(defun tramp-get-local-uid (id-format) - (if (equal id-format 'integer) (user-uid) (user-login-name))) - -(defun tramp-get-local-gid (id-format) - (if (and (fboundp 'group-gid) (equal id-format 'integer)) - (tramp-compat-funcall 'group-gid) - (nth 3 (tramp-compat-file-attributes "~/" id-format)))) - ;; Some predefined connection properties. (defun tramp-get-inline-compress (vec prop size) "Return the compress command related to PROP. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d959cfc854a..dc3dffd857b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1505,12 +1505,18 @@ applicable)." (concat (format "(%d) # " level) fmt-string) args))))))) +(defsubst tramp-backtrace (vec-or-proc) + "Dump a backtrace into the debug buffer. +This function is meant for debugging purposes." + (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))) + (defsubst tramp-error (vec-or-proc signal fmt-string &rest args) "Emit an error. VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining args passed to `tramp-message'. Finally, signal SIGNAL is raised." (let (tramp-message-show-message) + (tramp-backtrace vec-or-proc) (tramp-message vec-or-proc 1 "%s" (error-message-string @@ -1543,11 +1549,6 @@ an input event arrives. The other arguments are passed to `tramp-error'." "`M-x tramp-cleanup-this-connection'")) (sit-for 30)))))) -(defsubst tramp-backtrace (vec-or-proc) - "Dump a backtrace into the debug buffer. -This function is meant for debugging purposes." - (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))) - (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. @@ -3660,6 +3661,107 @@ would yield `t'. On the other hand, the following check results in nil: (t (error "Tenth char `%c' must be one of `xtT-'" other-execute-or-sticky))))))) +(defconst tramp-file-mode-type-map + '((0 . "-") ; Normal file (SVID-v2 and XPG2) + (1 . "p") ; fifo + (2 . "c") ; character device + (3 . "m") ; multiplexed character device (v7) + (4 . "d") ; directory + (5 . "?") ; Named special file (XENIX) + (6 . "b") ; block device + (7 . "?") ; multiplexed block device (v7) + (8 . "-") ; regular file + (9 . "n") ; network special file (HP-UX) + (10 . "l") ; symlink + (11 . "?") ; ACL shadow inode (Solaris, not userspace) + (12 . "s") ; socket + (13 . "D") ; door special (Solaris) + (14 . "w")) ; whiteout (BSD) + "A list of file types returned from the `stat' system call. +This is used to map a mode number to a permission string.") + +;;;###tramp-autoload +(defun tramp-file-mode-from-int (mode) + "Turn an integer representing a file mode into an ls(1)-like string." + (let ((type (cdr + (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map))) + (user (logand (lsh mode -6) 7)) + (group (logand (lsh mode -3) 7)) + (other (logand (lsh mode -0) 7)) + (suid (> (logand (lsh mode -9) 4) 0)) + (sgid (> (logand (lsh mode -9) 2) 0)) + (sticky (> (logand (lsh mode -9) 1) 0))) + (setq user (tramp-file-mode-permissions user suid "s")) + (setq group (tramp-file-mode-permissions group sgid "s")) + (setq other (tramp-file-mode-permissions other sticky "t")) + (concat type user group other))) + +(defun tramp-file-mode-permissions (perm suid suid-text) + "Convert a permission bitset into a string. +This is used internally by `tramp-file-mode-from-int'." + (let ((r (> (logand perm 4) 0)) + (w (> (logand perm 2) 0)) + (x (> (logand perm 1) 0))) + (concat (or (and r "r") "-") + (or (and w "w") "-") + (or (and suid x suid-text) ; suid, execute + (and suid (upcase suid-text)) ; suid, !execute + (and x "x") "-")))) ; !suid + +;;;###tramp-autoload +(defun tramp-get-local-uid (id-format) + (if (equal id-format 'integer) (user-uid) (user-login-name))) + +;;;###tramp-autoload +(defun tramp-get-local-gid (id-format) + (if (and (fboundp 'group-gid) (equal id-format 'integer)) + (tramp-compat-funcall 'group-gid) + (nth 3 (tramp-compat-file-attributes "~/" id-format)))) + +;;;###tramp-autoload +(defun tramp-check-cached-permissions (vec access) + "Check `file-attributes' caches for VEC. +Return t if according to the cache access type ACCESS is known to +be granted." + (let ((result nil) + (offset (cond + ((eq ?r access) 1) + ((eq ?w access) 2) + ((eq ?x access) 3)))) + (dolist (suffix '("string" "integer") result) + (setq + result + (or + result + (let ((file-attr + (tramp-get-file-property + vec (tramp-file-name-localname vec) + (concat "file-attributes-" suffix) nil)) + (remote-uid + (tramp-get-connection-property + vec (concat "uid-" suffix) nil)) + (remote-gid + (tramp-get-connection-property + vec (concat "gid-" suffix) nil))) + (and + file-attr + (or + ;; Not a symlink + (eq t (car file-attr)) + (null (car file-attr))) + (or + ;; World accessible. + (eq access (aref (nth 8 file-attr) (+ offset 6))) + ;; User accessible and owned by user. + (and + (eq access (aref (nth 8 file-attr) offset)) + (equal remote-uid (nth 2 file-attr))) + ;; Group accessible and owned by user's + ;; principal group. + (and + (eq access (aref (nth 8 file-attr) (+ offset 3))) + (equal remote-gid (nth 3 file-attr))))))))))) + ;;;###tramp-autoload (defun tramp-local-host-p (vec) "Return t if this points to the local host, nil otherwise." -- 2.39.2