;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon
-;; Copyright (C) 2009-2014 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
(eval-when-compile
(require 'cl)
(require 'custom))
-(defvar ls-lisp-use-insert-directory-program)
;;;###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"
;; 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.")
(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-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)
"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
(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.
- (unless switches (setq switches ""))
- (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-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name dir nil
(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))))
(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
(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
"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-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.
(list user host)))
(zeroconf-list-services "_webdav._tcp")))
-;; Add completion function for DAV and DAVS methods.
+;; 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)