;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; The customer option `tramp-gvfs-methods' contains the list of
;; supported connection methods. Per default, these are "dav",
-;; "davs", "obex" and "synce". Note that with "obex" it might be
-;; necessary to pair with the other bluetooth device, if it hasn't
+;; "davs", "obex", "sftp" and "synce". Note that with "obex" it might
+;; be necessary to pair with the other bluetooth device, if it hasn't
;; been done already. There might be also some few seconds delay in
;; discovering available bluetooth devices.
-;; Other possible connection methods are "ftp", "sftp" and "smb".
-;; When one of these methods is added to the list, the remote access
-;; for that method is performed via GVFS instead of the native Tramp
+;; Other possible connection methods are "ftp" and "smb". When one of
+;; these methods is added to the list, the remote access for that
+;; method is performed via GVFS instead of the native Tramp
;; implementation.
;; GVFS offers even more connection methods. The complete list of
;; option "--without-dbus". Declare used subroutines and variables.
(declare-function dbus-get-unique-name "dbusbind.c")
-;; Pacify byte-compiler
-(eval-when-compile
- (require 'cl)
- (require 'custom))
-
(require 'tramp)
(require 'dbus)
(require 'url-util)
(require 'zeroconf)
+;; Pacify byte-compiler.
+(eval-when-compile
+ (require 'cl)
+ (require 'custom))
+
;;;###tramp-autoload
-(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
+(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "sftp" "synce")
"List of methods for remote files, accessed with GVFS."
:group 'tramp
:version "23.2"
(defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
"The well known name of the GVFS daemon.")
-;; Check that GVFS is available. D-Bus integration is available since
-;; 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)
- (or (tramp-compat-process-running-p "gvfs-fuse-daemon")
- (tramp-compat-process-running-p "gvfsd-fuse")))
- (tramp-compat-user-error "Package `tramp-gvfs' not supported"))
+;; D-Bus integration is available since Emacs 23 on some system types.
+;; We don't call `dbus-ping', because this would load dbus.el.
+(defconst tramp-gvfs-enabled
+ (ignore-errors
+ (and (featurep 'dbusbind)
+ (tramp-compat-funcall 'dbus-get-unique-name :system)
+ (tramp-compat-funcall 'dbus-get-unique-name :session)
+ (or (tramp-compat-process-running-p "gvfs-fuse-daemon")
+ (tramp-compat-process-running-p "gvfsd-fuse"))))
+ "Non-nil when GVFS is available.")
(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
"The object path of 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)
+ (and tramp-gvfs-enabled
+ (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
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)
+ (and tramp-gvfs-enabled
+ (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.")
\f
;; New handlers should be added here.
(defconst tramp-gvfs-file-name-handler-alist
- '(
- (access-file . ignore)
+ '((access-file . ignore)
(add-name-to-file . tramp-gvfs-handle-copy-file)
;; `byte-compiler-base-file-name' performed by default handler.
+ ;; `copy-directory' performed by default handler.
(copy-file . tramp-gvfs-handle-copy-file)
(delete-directory . tramp-gvfs-handle-delete-directory)
(delete-file . tramp-gvfs-handle-delete-file)
(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 . ignore)
(file-attributes . tramp-gvfs-handle-file-attributes)
(file-directory-p . tramp-gvfs-handle-file-directory-p)
+ ;; `file-equal-p' performed by default handler.
(file-executable-p . tramp-gvfs-handle-file-executable-p)
(file-exists-p . tramp-handle-file-exists-p)
+ ;; `file-in-directory-p' performed by default handler.
(file-local-copy . tramp-gvfs-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-gvfs-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler.
;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-gvfs-handle-insert-directory)
- (insert-file-contents . tramp-gvfs-handle-insert-file-contents)
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
- (make-symbolic-link . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
(set-file-acl . ignore)
(set-file-modes . ignore)
(set-file-selinux-context . ignore)
- (set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime)
+ (set-file-times . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
(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' performed by default handler.
- (write-region . tramp-gvfs-handle-write-region)
-)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-gvfs-handle-write-region))
"Alist of handler functions for Tramp GVFS method.
Operations not mentioned here will be handled by the default Emacs primitives.")
"Invoke the GVFS related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
+ (unless tramp-gvfs-enabled
+ (tramp-user-error nil "Package `tramp-gvfs' not supported"))
(let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
(if fn
(save-match-data (apply (cdr fn) args))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
-(defmacro with-tramp-gvfs-error-message (filename handler &rest args)
- "Apply a Tramp GVFS `handler'.
-In case of an error, modify the error message by replacing
-`filename' with its GVFS mounted name."
- `(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename)))
- elt)
- (condition-case err
- (tramp-compat-funcall ,handler ,@args)
- (error
- (setq elt (cdr err))
- (while elt
- (when (and (stringp (car elt))
- (string-match fuse-file-name (car elt)))
- (setcar elt (replace-match ,filename t t (car elt))))
- (setq elt (cdr elt)))
- (signal (car err) (cdr err))))))
-
-(put 'with-tramp-gvfs-error-message 'lisp-indent-function 2)
-(put 'with-tramp-gvfs-error-message 'edebug-form-spec '(form symbolp body))
-(tramp-compat-font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-gvfs-error-message\\>"))
-
(defvar tramp-gvfs-dbus-event-vector nil
"Current Tramp file name to be used, as vector.
It is needed when D-Bus signals or errors arrive, because there
(and (tramp-tramp-file-p newname)
(not (tramp-gvfs-file-name-p newname))))
- ;; We cannot copy directly.
+ ;; We cannot call `copy-file' directly. Use
+ ;; `tramp-compat-funcall' for backward compatibility (number
+ ;; of arguments).
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(cond
(preserve-extended-attributes
- (copy-file
+ (tramp-compat-funcall
+ '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))
+ (tramp-compat-funcall
+ '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))
nil v 'file-error
"Copying failed, see buffer `%s' for details." (buffer-name)))))
- (when (file-remote-p newname)
+ (when (tramp-tramp-file-p newname)
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname))))))
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-directory-property v localname)
+ (tramp-flush-file-property v localname)
(unless
(tramp-gvfs-send-command
v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(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
+ (ignore-errors
+ ;; 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))
- (setq res-uid
- (or (if (eq id-format 'integer)
+ (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
- "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)
+ "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
- "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
- )))))))
+ "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
+ (string-to-number (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."
entry)
;; Get a list of directories and files.
(tramp-gvfs-send-command
- v "gvfs-ls" (tramp-gvfs-url-file-name directory))
+ v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory))
;; Now grab the output.
(with-temp-buffer
v (concat localname filename)
"file-name-all-completions" result))))))))
+(defun tramp-gvfs-handle-file-notify-add-watch (file-name _flags _callback)
+ "Like `file-notify-add-watch' for Tramp files."
+ (setq file-name (expand-file-name file-name))
+ (with-parsed-tramp-file-name file-name nil
+ (let ((p (start-process
+ "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*")
+ "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name))))
+ (if (not (processp p))
+ (tramp-error
+ v 'file-notify-error "gvfs-monitor-file failed to start")
+ (tramp-message
+ v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p)
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter)
+ (with-current-buffer (process-buffer p)
+ (setq default-directory (file-name-directory file-name)))
+ p))))
+
+(defun tramp-gvfs-file-gvfs-monitor-file-process-filter (proc string)
+ "Read output from \"gvfs-monitor-file\" and add corresponding file-notify events."
+ (let* ((rest-string (tramp-compat-process-get proc 'rest-string))
+ (dd (with-current-buffer (process-buffer proc) default-directory))
+ (ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
+ (when rest-string
+ (tramp-message proc 10 "Previous string:\n%s" rest-string))
+ (tramp-message proc 6 "%S\n%s" proc string)
+ (setq string (concat rest-string string)
+ ;; Attribute change is returned in unused wording.
+ string (tramp-compat-replace-regexp-in-string
+ "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
+
+ (while (string-match
+ (concat "^[\n\r]*"
+ "File Monitor Event:[\n\r]+"
+ "File = \\([^\n\r]+\\)[\n\r]+"
+ "Event = \\([^[:blank:]]+\\)[\n\r]+")
+ string)
+ (let ((action (intern-soft
+ (tramp-compat-replace-regexp-in-string
+ "_" "-" (downcase (match-string 2 string)))))
+ (file (match-string 1 string)))
+ (setq string (replace-match "" nil nil string))
+ ;; File names are returned as URL paths. We must convert them.
+ (when (string-match ddu file)
+ (setq file (replace-match dd nil nil file)))
+ (while (string-match "%\\([0-9A-F]\\{2\\}\\)" file)
+ (setq file
+ (replace-match
+ (char-to-string (string-to-number (match-string 1 file) 16))
+ nil nil file)))
+ ;; Usually, we would add an Emacs event now. Unfortunately,
+ ;; `unread-command-events' does not accept several events at
+ ;; once. Therefore, we apply the callback directly.
+ (tramp-compat-funcall 'file-notify-callback (list proc action file))))
+
+ ;; Save rest of the string.
+ (when (zerop (length string)) (setq string nil))
+ (when string (tramp-message proc 10 "Rest string:\n%s" string))
+ (tramp-compat-process-put proc 'rest-string string)))
+
(defun tramp-gvfs-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(and (file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename)))))))
-(defun tramp-gvfs-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- ;; gvfs-* output is hard to parse. So we let `ls-lisp' do the job.
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
- (require 'ls-lisp)
- (let (ls-lisp-use-insert-directory-program)
- (tramp-run-real-handler
- 'insert-directory
- (list filename switches wildcard full-directory-p))))))
-
-(defun tramp-gvfs-handle-insert-file-contents
- (filename &optional visit beg end replace)
- "Like `insert-file-contents' for Tramp files."
- (barf-if-buffer-read-only)
- (setq filename (expand-file-name filename))
- (let (tmpfile result)
- (unwind-protect
- (if (not (file-exists-p filename))
- ;; We don't raise a Tramp error, because it might be
- ;; suppressed, like in `find-file-noselect-1'.
- (signal 'file-error (list "File not found on remote host" filename))
-
- (setq tmpfile (file-local-copy filename)
- result (insert-file-contents tmpfile visit beg end replace)))
- ;; Save exit.
- (when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (stringp tmpfile)
- (delete-file tmpfile)))
-
- ;; Result.
- (list filename (cadr result))))
-
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name dir nil
nil v 'file-error
"Renaming failed, see buffer `%s' for details." (buffer-name)))))
- (when (file-remote-p filename)
+ (when (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)))
- (when (file-remote-p newname)
+ (when (tramp-tramp-file-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-set-visited-file-modtime (&optional time-list)
- "Like `set-visited-file-modtime' for Tramp files."
- (unless (buffer-file-name)
- (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
- (buffer-name)))
- (unless time-list
- (let ((f (buffer-file-name)))
- (with-parsed-tramp-file-name f nil
- (let ((remote-file-name-inhibit-cache t)
- (attr (file-attributes f)))
- ;; '(-1 65535) means file doesn't exists yet.
- (setq time-list (or (nth 5 attr) '(-1 65535)))))))
- ;; We use '(0 0) as a don't-know value.
- (unless (not (equal time-list '(0 0)))
- (tramp-run-real-handler 'set-visited-file-modtime (list time-list))))
-
(defun tramp-gvfs-handle-write-region
(start end filename &optional append visit lockname confirm)
"Like `write-region' for Tramp files."
(tramp-error v 'file-error "File not overwritten")))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
- (write-region start end tmpfile)
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
+ ;; We say `no-message' here because we don't want the visited file
+ ;; modtime data to be clobbered from the temp file. We call
+ ;; `set-visited-file-modtime' ourselves later on.
+ (tramp-run-real-handler
+ 'write-region
+ (if confirm ; don't pass this arg unless defined for backward compat.
+ (list start end tmpfile append 'no-message lockname confirm)
+ (list start end tmpfile append 'no-message lockname)))
(condition-case nil
- (rename-file tmpfile filename)
+ (rename-file tmpfile filename 'ok-if-already-exists)
(error
(delete-file tmpfile)
(tramp-error
(defun tramp-gvfs-url-file-name (filename)
"Return FILENAME in URL syntax."
;; "/" must NOT be hexlified.
- (let ((url-unreserved-chars (append '(?/) url-unreserved-chars))
+ (let ((url-unreserved-chars (cons ?/ url-unreserved-chars))
result)
(setq
result
(setq user
(concat (match-string 2 user) ";" (match-string 1 user))))
(url-parse-make-urlobj
- method (url-hexify-string user) nil
+ method (and user (url-hexify-string user)) nil
(tramp-file-name-real-host v) (tramp-file-name-port v)
- (url-hexify-string localname) nil nil t))
+ (and localname (url-hexify-string localname)) nil nil t))
(url-parse-make-urlobj
"file" nil nil nil nil
(url-hexify-string (file-truename filename)) nil nil t))))
(defun tramp-gvfs-file-name (object-path)
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
- (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
-
-(defun tramp-gvfs-fuse-file-name (filename)
- "Return FUSE file name, which is directly accessible."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-gvfs-maybe-open-connection v)
- (let ((prefix (tramp-get-file-property v "/" "prefix" ""))
- (fuse-mountpoint
- (tramp-get-file-property v "/" "fuse-mountpoint" nil)))
- (unless fuse-mountpoint
- (tramp-error
- v 'file-error "There is no FUSE mount point for `%s'" filename))
- ;; We must hide the prefix, if any.
- (when (string-match (concat "^" (regexp-quote prefix)) localname)
- (setq localname (replace-match "" t t localname)))
- (tramp-message
- v 10 "remote file `%s' is local file `%s'"
- filename (concat fuse-mountpoint localname))
- (concat fuse-mountpoint localname))))
+ (tramp-compat-replace-regexp-in-string
+ "^.*/\\([^/]+\\)$" "\\1" object-path)))
(defun tramp-bluez-address (device)
"Return bluetooth device address from a given bluetooth DEVICE name."
(zerop (logand flags tramp-gvfs-password-need-username))))
(setq user (read-string "User name: ")))
(when (and (zerop (length domain))
- (not (zerop (logand flags tramp-gvfs-password-need-domain))))
+ (not
+ (zerop (logand flags tramp-gvfs-password-need-domain))))
(setq domain (read-string "Domain name: ")))
(tramp-message l 6 "%S %S %S %d" message user domain flags)
+ (unless (tramp-get-connection-property l "first-password-request" nil)
+ (tramp-clear-passwd l))
+
(setq tramp-current-method l-method
tramp-current-user user
tramp-current-host l-host
(tramp-set-file-property
v "/" "default-location" default-location)))))))
-(dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "mounted"
- 'tramp-gvfs-handler-mounted-unmounted)
-(dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "Mounted"
- 'tramp-gvfs-handler-mounted-unmounted)
-
-(dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "unmounted"
- 'tramp-gvfs-handler-mounted-unmounted)
-(dbus-register-signal
- :session nil tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker "Unmounted"
- 'tramp-gvfs-handler-mounted-unmounted)
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "mounted"
+ 'tramp-gvfs-handler-mounted-unmounted)
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "Mounted"
+ 'tramp-gvfs-handler-mounted-unmounted)
+
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "unmounted"
+ 'tramp-gvfs-handler-mounted-unmounted)
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker "Unmounted"
+ 'tramp-gvfs-handler-mounted-unmounted))
(defun tramp-gvfs-connection-mounted-p (vec)
"Check, whether the location is already mounted."
(port (tramp-file-name-port vec))
(localname (tramp-file-name-localname vec))
(ssl (if (string-match "^davs" method) "true" "false"))
- (mount-spec '(:array))
- (mount-pref "/"))
-
- (setq
- mount-spec
- (append
- mount-spec
- (cond
- ((string-equal "smb" method)
- (string-match "^/?\\([^/]+\\)" localname)
- (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
- (tramp-gvfs-mount-spec-entry "server" host)
- (tramp-gvfs-mount-spec-entry "share" (match-string 1 localname))))
- ((string-equal "obex" method)
- (list (tramp-gvfs-mount-spec-entry "type" method)
- (tramp-gvfs-mount-spec-entry
- "host" (concat "[" (tramp-bluez-address host) "]"))))
- ((string-match "^dav" method)
- (list (tramp-gvfs-mount-spec-entry "type" "dav")
- (tramp-gvfs-mount-spec-entry "host" host)
- (tramp-gvfs-mount-spec-entry "ssl" ssl)))
- (t
- (list (tramp-gvfs-mount-spec-entry "type" method)
- (tramp-gvfs-mount-spec-entry "host" host))))))
-
- (when user
- (add-to-list
- 'mount-spec (tramp-gvfs-mount-spec-entry "user" user) 'append))
-
- (when domain
- (add-to-list
- 'mount-spec (tramp-gvfs-mount-spec-entry "domain" domain) 'append))
-
- (when port
- (add-to-list
- 'mount-spec (tramp-gvfs-mount-spec-entry "port" (number-to-string port))
- 'append))
-
- (when (and (string-match "^dav" method)
- (string-match "^/?[^/]+" localname))
- (setq mount-pref (match-string 0 localname)))
+ (mount-spec
+ `(:array
+ ,@(cond
+ ((string-equal "smb" method)
+ (string-match "^/?\\([^/]+\\)" localname)
+ (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
+ (tramp-gvfs-mount-spec-entry "server" host)
+ (tramp-gvfs-mount-spec-entry
+ "share" (match-string 1 localname))))
+ ((string-equal "obex" method)
+ (list (tramp-gvfs-mount-spec-entry "type" method)
+ (tramp-gvfs-mount-spec-entry
+ "host" (concat "[" (tramp-bluez-address host) "]"))))
+ ((string-match "\\`dav" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "dav")
+ (tramp-gvfs-mount-spec-entry "host" host)
+ (tramp-gvfs-mount-spec-entry "ssl" ssl)))
+ (t
+ (list (tramp-gvfs-mount-spec-entry "type" method)
+ (tramp-gvfs-mount-spec-entry "host" host))))
+ ,@(when user
+ (list (tramp-gvfs-mount-spec-entry "user" user)))
+ ,@(when domain
+ (list (tramp-gvfs-mount-spec-entry "domain" domain)))
+ ,@(when port
+ (list (tramp-gvfs-mount-spec-entry
+ "port" (number-to-string port))))))
+ (mount-pref
+ (if (and (string-match "\\`dav" method)
+ (string-match "^/?[^/]+" localname))
+ (match-string 0 localname)
+ "/")))
;; Return.
`(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
\f
-;; Connection functions
+;; Connection functions.
(defun tramp-gvfs-maybe-open-connection (vec)
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
+ (tramp-check-proper-method-and-host vec)
;; We set the file name, in case there are incoming D-Bus signals or
;; D-Bus errors.
(format "Opening connection for %s using %s" host method)
(format "Opening connection for %s@%s using %s" user host method))
- ;; Enable auth-source and password-cache.
+ ;; Enable `auth-source'.
(tramp-set-connection-property vec "first-password-request" t)
;; There will be a callback of "askPassword" when a password is
;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
;; file property.
(with-timeout
- (60
+ ((or (tramp-get-method-parameter method 'tramp-connection-timeout)
+ tramp-connection-timeout)
(if (zerop (length (tramp-file-name-user vec)))
(tramp-error
vec 'file-error
;; is marked with the fuse-mountpoint "/". We shall react.
(when (string-equal
(tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
- (tramp-error vec 'file-error "FUSE mount denied"))
-
- ;; In `tramp-check-cached-permissions', the connection
- ;; properties {uig,gid}-{integer,string} are used. We set
- ;; them to their local counterparts.
- (tramp-set-connection-property
- vec "uid-integer" (tramp-get-local-uid 'integer))
- (tramp-set-connection-property
- vec "gid-integer" (tramp-get-local-gid 'integer))
- (tramp-set-connection-property
- vec "uid-string" (tramp-get-local-uid 'string))
- (tramp-set-connection-property
- vec "gid-string" (tramp-get-local-gid 'string))))))
+ (tramp-error vec 'file-error "FUSE mount denied")))))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; {uig,gid}-{integer,string} are used. We set them to their local
+ ;; counterparts.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string)))
(defun tramp-gvfs-send-command (vec command &rest args)
"Send the COMMAND with its ARGS to connection VEC.
COMMAND is usually a command from the gvfs-* utilities.
`call-process' is applied, and it returns `t' if the return code is zero."
- (let (result)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-gvfs-maybe-open-connection vec)
- (erase-buffer)
- (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))
- (setq result (apply 'tramp-compat-call-process command nil t nil args))
- (tramp-message vec 6 "\n%s" (buffer-string))
- (zerop result))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-gvfs-maybe-open-connection vec)
+ (erase-buffer)
+ (zerop (apply 'tramp-call-process vec command nil t nil args))))
\f
;; D-Bus BLUEZ functions.
:system tramp-bluez-service (dbus-event-path-name last-input-event)
tramp-bluez-interface-adapter "StopDiscovery")))))
-(dbus-register-signal
- :system nil nil tramp-bluez-interface-adapter "PropertyChanged"
- 'tramp-bluez-property-changed)
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :system nil nil tramp-bluez-interface-adapter "PropertyChanged"
+ 'tramp-bluez-property-changed))
(defun tramp-bluez-device-found (device args)
"Signal handler for the \"org.bluez.Adapter.DeviceFound\" signal."
;; device, and call also SDP in order to find the obex service.
(add-to-list 'tramp-bluez-devices (list alias address))))
-(dbus-register-signal
- :system nil nil tramp-bluez-interface-adapter "DeviceFound"
- 'tramp-bluez-device-found)
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :system nil nil tramp-bluez-interface-adapter "DeviceFound"
+ 'tramp-bluez-device-found))
-(defun tramp-bluez-parse-device-names (ignore)
+(defun tramp-bluez-parse-device-names (_ignore)
"Return a list of (nil host) tuples allowed to access."
(mapcar
(lambda (x) (list nil (car x)))
(tramp-bluez-list-devices)))
;; Add completion function for OBEX method.
-(when (member tramp-bluez-service (dbus-list-known-names :system))
+(when (and tramp-gvfs-enabled
+ (member tramp-bluez-service (dbus-list-known-names :system)))
(tramp-set-completion-function
"obex" '((tramp-bluez-parse-device-names ""))))
\f
;; D-Bus zeroconf functions.
-(defun tramp-zeroconf-parse-workstation-device-names (ignore)
+(defun tramp-zeroconf-parse-workstation-device-names (_ignore)
"Return a list of (user host) tuples allowed to access."
(mapcar
(lambda (x)
(list nil (zeroconf-service-host x)))
(zeroconf-list-services "_workstation._tcp")))
-(defun tramp-zeroconf-parse-webdav-device-names (ignore)
+(defun tramp-zeroconf-parse-webdav-device-names (_ignore)
"Return a list of (user host) tuples allowed to access."
(mapcar
(lambda (x)
(list user host)))
(zeroconf-list-services "_webdav._tcp")))
-;; Add completion function for DAV and DAVS methods.
-(when (member zeroconf-service-avahi (dbus-list-known-names :system))
+;; Add completion function for SFTP, DAV and DAVS methods.
+(when (and tramp-gvfs-enabled
+ (member zeroconf-service-avahi (dbus-list-known-names :system)))
(zeroconf-init tramp-gvfs-zeroconf-domain)
(tramp-set-completion-function
"sftp" '((tramp-zeroconf-parse-workstation-device-names "")))
(when (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
:system tramp-hal-service device tramp-hal-interface-device
"PropertyExists" "sync.plugin")
- (add-to-list
- 'tramp-synce-devices
- (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
- :system tramp-hal-service device tramp-hal-interface-device
- "GetPropertyString" "pda.pocketpc.name"))))
+ (let ((prop
+ (with-tramp-dbus-call-method
+ tramp-gvfs-dbus-event-vector t
+ :system tramp-hal-service device tramp-hal-interface-device
+ "GetPropertyString" "pda.pocketpc.name")))
+ (unless (member prop tramp-synce-devices)
+ (push prop tramp-synce-devices)))))
(tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-synce-devices)
tramp-synce-devices))
-(defun tramp-synce-parse-device-names (ignore)
+(defun tramp-synce-parse-device-names (_ignore)
"Return a list of (nil host) tuples allowed to access."
(mapcar
(lambda (x) (list nil x))
(tramp-synce-list-devices)))
;; Add completion function for SYNCE method.
-(tramp-set-completion-function
- "synce" '((tramp-synce-parse-device-names "")))
+(when tramp-gvfs-enabled
+ (tramp-set-completion-function
+ "synce" '((tramp-synce-parse-device-names ""))))
(add-hook 'tramp-unload-hook
(lambda ()