X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/17b8d63057af2f1ad930bfe4bcd3aee5dd8996a4..bfc29a5bcef1df4380a4f043f05035b88cd5c482:/lisp/net/tramp-gvfs.el diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 098d40e7cc..2b207f624e 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,10 +49,10 @@ ;; The custom option `tramp-gvfs-methods' contains the list of ;; supported connection methods. Per default, these are "afp", "dav", -;; "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. +;; "davs", "gdrive", "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" and "smb". When one of ;; these methods is added to the list, the remote access for that @@ -110,21 +110,29 @@ (require 'custom)) ;;;###tramp-autoload -(defcustom tramp-gvfs-methods '("afp" "dav" "davs" "obex" "sftp" "synce") +(defcustom tramp-gvfs-methods + '("afp" "dav" "davs" "gdrive" "obex" "sftp" "synce") "List of methods for remote files, accessed with GVFS." :group 'tramp - :version "25.1" + :version "25.2" :type '(repeat (choice (const "afp") (const "dav") (const "davs") (const "ftp") + (const "gdrive") (const "obex") (const "sftp") (const "smb") (const "synce")))) -;; Add a default for `tramp-default-user-alist'. Rule: For the SYNCE -;; method, no user is chosen. +;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'. +;;;###tramp-autoload +(when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)" + user-mail-address) + (add-to-list 'tramp-default-user-alist + `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address))) + (add-to-list 'tramp-default-host-alist + '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))) ;;;###tramp-autoload (add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil)) @@ -407,6 +415,38 @@ Every entry is a list (NAME ADDRESS).") (defconst tramp-hal-interface-device "org.freedesktop.Hal.Device" "The device interface of the HAL daemon.") +(defconst tramp-gvfs-file-attributes + '("name" + "type" + "standard::display-name" + "standard::symlink-target" + "unix::nlink" + "unix::uid" + "owner::user" + "unix::gid" + "owner::group" + "time::access" + "time::modified" + "time::changed" + "standard::size" + "unix::mode" + "access::can-read" + "access::can-write" + "access::can-execute" + "unix::inode" + "unix::device") + "GVFS file attributes.") + +(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp + (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") + "Regexp to parse GVFS file attributes with `gvfs-ls'.") + +(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp + (concat "^[[:blank:]]*" + (regexp-opt tramp-gvfs-file-attributes t) + ":[[:blank:]]+\\(.*\\)$") + "Regexp to parse GVFS file attributes with `gvfs-info'.") + ;; New handlers should be added here. (defconst tramp-gvfs-file-name-handler-alist @@ -644,7 +684,7 @@ file names." 'tramp-gvfs-send-command v gvfs-operation (append (and (eq op 'copy) (or keep-date preserve-uid-gid) - (list "--preserve")) + '("--preserve")) (list (tramp-gvfs-url-file-name filename) (tramp-gvfs-url-file-name newname)))) @@ -706,14 +746,18 @@ file names." (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." - (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 + (if (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 directory-files-no-dot-files-regexp)) + (when (directory-files directory nil directory-files-no-dot-files-regexp) + (tramp-error + v 'file-error "Couldn't delete non-empty %s" directory))) + (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-directory-property v localname) (unless @@ -759,7 +803,7 @@ file names." (tramp-gvfs-maybe-open-connection (vector method user host "/" hop))) (setq localname (replace-match - (tramp-get-file-property v "/" "default-location" "~") + (tramp-get-connection-property v "default-location" "~") nil t localname 1))) ;; Tilde expansion is not possible. (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) @@ -784,127 +828,191 @@ file names." (tramp-run-real-handler 'expand-file-name (list localname)))))) -(defun tramp-gvfs-handle-file-attributes (filename &optional id-format) - "Like `file-attributes' for Tramp files." - (unless id-format (setq id-format 'integer)) +(defun tramp-gvfs-get-directory-attributes (directory) + "Return GVFS attributes association list of all files in DIRECTORY." (ignore-errors ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used) - (process-environment (cons "LC_MESSAGES=C" process-environment)) - dirp res-symlink-target res-numlinks res-uid res-gid res-access - res-mod res-change res-size res-filemodes res-inode res-device) + result) + (with-parsed-tramp-file-name directory nil + (with-tramp-file-property v localname "directory-gvfs-attributes" + (tramp-message v 5 "directory gvfs attributes: %s" localname) + ;; Send command. + (tramp-gvfs-send-command + v "gvfs-ls" "-h" "-n" "-a" + (mapconcat 'identity tramp-gvfs-file-attributes ",") + (tramp-gvfs-url-file-name directory)) + ;; Parse output. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (while (looking-at + (concat "^\\(.+\\)[[:blank:]]" + "\\([[:digit:]]+\\)[[:blank:]]" + "(\\(.+?\\))" + tramp-gvfs-file-attributes-with-gvfs-ls-regexp)) + (let ((item (list (cons "type" (match-string 3)) + (cons "standard::size" (match-string 2)) + (cons "name" (match-string 1))))) + (goto-char (1+ (match-end 3))) + (while (looking-at + (concat + tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp + "\\|" "$" "\\)")) + (push (cons (match-string 1) (match-string 2)) item) + (goto-char (match-end 2))) + ;; Add display name as head. + (push + (cons (cdr (or (assoc "standard::display-name" item) + (assoc "name" item))) + (nreverse item)) + result)) + (forward-line))) + result))))) + +(defun tramp-gvfs-get-root-attributes (filename) + "Return GVFS attributes association list of FILENAME." + (ignore-errors + ;; Don't modify `last-coding-system-used' by accident. + (let ((last-coding-system-used last-coding-system-used) + result) (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) + (with-tramp-file-property v localname "file-gvfs-attributes" + (tramp-message v 5 "file gvfs attributes: %s" localname) + ;; Send command. (tramp-gvfs-send-command v "gvfs-info" (tramp-gvfs-url-file-name filename)) - ;; Parse output ... + ;; 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: directory" nil t) t)) - (goto-char (point-min)) - (setq res-symlink-target - (if (re-search-forward - "standard::symlink-target: \\(.+\\)$" nil t) - (match-string 1))) - ;; ... number links - (goto-char (point-min)) - (setq res-numlinks - (if (re-search-forward "unix::nlink: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) 0)) - ;; ... uid and gid - (goto-char (point-min)) - (setq res-uid - (if (eq id-format 'integer) - (if (re-search-forward "unix::uid: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) - -1) - (if (re-search-forward "owner::user: \\(.+\\)$" nil t) - (match-string 1) - "UNKNOWN"))) - (setq res-gid - (if (eq id-format 'integer) - (if (re-search-forward "unix::gid: \\([0-9]+\\)" nil t) - (string-to-number (match-string 1)) - -1) - (if (re-search-forward "owner::group: \\(.+\\)$" nil t) - (match-string 1) - "UNKNOWN"))) - ;; ... last access, modification and change time - (goto-char (point-min)) - (setq res-access - (if (re-search-forward "time::access: \\([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: \\([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: \\([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: \\([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: \\([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: \\([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: \\([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 - )))))))) + (while (re-search-forward + tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t) + (push (cons (match-string 1) (match-string 2)) result)) + result)))))) + +(defun tramp-gvfs-get-file-attributes (filename) + "Return GVFS attributes association list of FILENAME." + (setq filename (directory-file-name (expand-file-name filename))) + (with-parsed-tramp-file-name filename nil + (if (or + (and (string-match "^\\(afp\\|smb\\)$" method) + (string-match "^/?\\([^/]+\\)$" localname)) + (string-equal localname "/")) + (tramp-gvfs-get-root-attributes filename) + (assoc + (file-name-nondirectory filename) + (tramp-gvfs-get-directory-attributes (file-name-directory filename)))))) + +(defun tramp-gvfs-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp files." + (unless id-format (setq id-format 'integer)) + (ignore-errors + (let ((attributes (tramp-gvfs-get-file-attributes filename)) + dirp res-symlink-target res-numlinks res-uid res-gid res-access + res-mod res-change res-size res-filemodes res-inode res-device) + (when attributes + ;; ... directory or symlink + (setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t)) + (setq res-symlink-target + (cdr (assoc "standard::symlink-target" attributes))) + ;; ... number links + (setq res-numlinks + (string-to-number + (or (cdr (assoc "unix::nlink" attributes)) "0"))) + ;; ... uid and gid + (setq res-uid + (if (eq id-format 'integer) + (string-to-number + (or (cdr (assoc "unix::uid" attributes)) + (format "%s" tramp-unknown-id-integer))) + (or (cdr (assoc "owner::user" attributes)) + (cdr (assoc "unix::uid" attributes)) + tramp-unknown-id-string))) + (setq res-gid + (if (eq id-format 'integer) + (string-to-number + (or (cdr (assoc "unix::gid" attributes)) + (format "%s" tramp-unknown-id-integer))) + (or (cdr (assoc "owner::group" attributes)) + (cdr (assoc "unix::gid" attributes)) + tramp-unknown-id-string))) + ;; ... last access, modification and change time + (setq res-access + (seconds-to-time + (string-to-number + (or (cdr (assoc "time::access" attributes)) "0")))) + (setq res-mod + (seconds-to-time + (string-to-number + (or (cdr (assoc "time::modified" attributes)) "0")))) + (setq res-change + (seconds-to-time + (string-to-number + (or (cdr (assoc "time::changed" attributes)) "0")))) + ;; ... size + (setq res-size + (string-to-number + (or (cdr (assoc "standard::size" attributes)) "0"))) + ;; ... file mode flags + (setq res-filemodes + (let ((n (cdr (assoc "unix::mode" attributes)))) + (if n + (tramp-file-mode-from-int (string-to-number n)) + (format + "%s%s%s%s------" + (if dirp "d" "-") + (if (equal (cdr (assoc "access::can-read" attributes)) + "FALSE") + "-" "r") + (if (equal (cdr (assoc "access::can-write" attributes)) + "FALSE") + "-" "w") + (if (equal (cdr (assoc "access::can-execute" attributes)) + "FALSE") + "-" "x"))))) + ;; ... inode and device + (setq res-inode + (let ((n (cdr (assoc "unix::inode" attributes)))) + (if n + (string-to-number n) + (tramp-get-inode (tramp-dissect-file-name filename))))) + (setq res-device + (let ((n (cdr (assoc "unix::device" attributes)))) + (if n + (string-to-number n) + (tramp-get-device (tramp-dissect-file-name filename))))) + + ;; 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." - (eq t (car (file-attributes filename)))) + (eq t (car (file-attributes (file-truename filename))))) (defun tramp-gvfs-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." @@ -926,73 +1034,16 @@ file names." (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)) - (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. - (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) + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let ((result '("./" "../"))) ;; Get a list of directories and files. - (tramp-gvfs-send-command - v "gvfs-ls" "-h" (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)))))))) + (dolist (item (tramp-gvfs-get-directory-attributes directory) result) + (if (string-equal (cdr (assoc "type" item)) "directory") + (push (file-name-as-directory (car item)) result) + (push (car item) result))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1178,6 +1229,8 @@ file-notify events." (url-recreate-url (if (tramp-tramp-file-p filename) (with-parsed-tramp-file-name filename nil + (when (string-equal "gdrive" method) + (setq method "google-drive")) (when (and user (string-match tramp-user-with-domain-regexp user)) (setq user (concat (match-string 2 user) ";" (match-string 1 user)))) @@ -1347,6 +1400,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (string-equal "google-drive" method) + (setq method "gdrive")) (unless (zerop (length domain)) (setq user (concat user tramp-prefix-domain-format domain))) (unless (zerop (length port)) @@ -1358,13 +1413,13 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." signal-name (tramp-gvfs-stringify-dbus-message mount-info)) (tramp-set-file-property v "/" "list-mounts" 'undef) (if (string-equal (downcase signal-name) "unmounted") - (tramp-set-file-property v "/" "fuse-mountpoint" nil) + (tramp-flush-file-property v "/") ;; Set prefix, mountpoint and location. (unless (string-equal prefix "/") (tramp-set-file-property v "/" "prefix" prefix)) (tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint) - (tramp-set-file-property - v "/" "default-location" default-location))))))) + (tramp-set-connection-property + v "default-location" default-location))))))) (when tramp-gvfs-enabled (dbus-register-signal @@ -1432,6 +1487,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq host (tramp-bluez-device host))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) + (when (string-equal "google-drive" method) + (setq method "gdrive")) (when (and (string-equal "synce" method) (zerop (length user))) (setq user (or (tramp-file-name-user vec) ""))) (unless (zerop (length domain)) @@ -1448,7 +1505,8 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (unless (string-equal prefix "/") (tramp-set-file-property vec "/" "prefix" prefix)) (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) - (tramp-set-file-property vec "/" "default-location" default-location) + (tramp-set-connection-property + vec "default-location" default-location) (throw 'mounted t))))))) (defun tramp-gvfs-mount-spec-entry (key value) @@ -1469,7 +1527,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (localname (tramp-file-name-localname vec)) (share (when (string-match "^/?\\([^/]+\\)" localname) (match-string 1 localname))) - (ssl (when (string-match "^davs" method) "true" "false")) + (ssl (if (string-match "^davs" method) "true" "false")) (mount-spec `(:array ,@(cond @@ -1489,6 +1547,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "afp-volume") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "volume" share))) + ((string-equal "gdrive" method) + (list (tramp-gvfs-mount-spec-entry "type" "google-drive") + (tramp-gvfs-mount-spec-entry "host" host))) (t (list (tramp-gvfs-mount-spec-entry "type" method) (tramp-gvfs-mount-spec-entry "host" host)))) @@ -1511,6 +1572,44 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ;; Connection functions. +(defun tramp-gvfs-get-remote-uid (vec id-format) + "The uid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." + (with-tramp-connection-property vec (format "uid-%s" id-format) + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-host vec)) + (localname + (tramp-get-connection-property vec "default-location" nil))) + (cond + ((and user (equal id-format 'string)) user) + (localname + (nth 2 (file-attributes + (tramp-make-tramp-file-name method user host localname) + id-format))) + ((equal id-format 'integer) tramp-unknown-id-integer) + ((equal id-format 'string) tramp-unknown-id-string))))) + +(defun tramp-gvfs-get-remote-gid (vec id-format) + "The gid of the remote connection VEC, in ID-FORMAT. +ID-FORMAT valid values are `string' and `integer'." + (with-tramp-connection-property vec (format "gid-%s" id-format) + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-host vec)) + (localname + (tramp-get-connection-property vec "default-location" nil))) + (cond + (localname + (nth 3 (file-attributes + (tramp-make-tramp-file-name method user host localname) + id-format))) + ((equal id-format 'integer) tramp-unknown-id-integer) + ((equal id-format 'string) tramp-unknown-id-string))))) + +(defvar tramp-gvfs-get-remote-uid-gid-in-progress nil + "Indication, that remote uid and gid determination is in progress.") + (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 @@ -1528,7 +1627,7 @@ connection if a previous connection has died for some reason." (let ((p (make-network-process :name (tramp-buffer-name vec) :buffer (tramp-get-connection-buffer vec) - :server t :host 'local :service t))) + :server t :host 'local :service t :noquery t))) (set-process-query-on-exit-flag p nil))) (unless (tramp-gvfs-connection-mounted-p vec) @@ -1540,14 +1639,14 @@ connection if a previous connection has died for some reason." (tramp-gvfs-object-path (tramp-make-tramp-file-name method user host "")))) - (when (and (string-equal method "smb") - (string-equal localname "/")) - (tramp-error vec 'file-error "Filename must contain a Windows share")) - (when (and (string-equal method "afp") (string-equal localname "/")) (tramp-error vec 'file-error "Filename must contain an AFP volume")) + (when (and (string-equal method "smb") + (string-equal localname "/")) + (tramp-error vec 'file-error "Filename must contain a Windows share")) + (with-tramp-progress-reporter vec 3 (if (zerop (length user)) @@ -1620,25 +1719,31 @@ connection if a previous connection has died for some reason." (tramp-get-connection-process vec) "connected" t)))) ;; 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))) + ;; {uig,gid}-{integer,string} are used. We set them to proper values. + (unless tramp-gvfs-get-remote-uid-gid-in-progress + (let ((tramp-gvfs-get-remote-uid-gid-in-progress t)) + (tramp-gvfs-get-remote-uid vec 'integer) + (tramp-gvfs-get-remote-gid vec 'integer) + (tramp-gvfs-get-remote-uid vec 'string) + (tramp-gvfs-get-remote-gid vec '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." - (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)))) + (let* ((locale (tramp-get-local-locale vec)) + (process-environment + (append + `(,(format "LANG=%s" locale) + ,(format "LANGUAGE=%s" locale) + ,(format "LC_ALL=%s" locale)) + process-environment))) + (with-current-buffer (tramp-get-connection-buffer vec) + (tramp-gvfs-maybe-open-connection vec) + (erase-buffer) + (or (zerop (apply 'tramp-call-process vec command nil t nil args)) + ;; Remove information about mounted connection. + (and (tramp-flush-file-property vec "/") nil))))) ;; D-Bus BLUEZ functions. @@ -1772,35 +1877,37 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." ;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods. (when tramp-gvfs-enabled - (zeroconf-init tramp-gvfs-zeroconf-domain) - (if (zeroconf-list-service-types) - (progn + ;; Suppress D-Bus error messages. + (let (tramp-gvfs-dbus-event-vector) + (zeroconf-init tramp-gvfs-zeroconf-domain) + (if (zeroconf-list-service-types) + (progn + (tramp-set-completion-function + "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) + (tramp-set-completion-function + "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + (tramp-set-completion-function + "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + (tramp-set-completion-function + "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") + (tramp-zeroconf-parse-device-names "_workstation._tcp"))) + (when (member "smb" tramp-gvfs-methods) + (tramp-set-completion-function + "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) + + (when (executable-find "avahi-browse") (tramp-set-completion-function - "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) + "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp"))) (tramp-set-completion-function - "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) (tramp-set-completion-function - "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) + "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) (tramp-set-completion-function - "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") - (tramp-zeroconf-parse-device-names "_workstation._tcp"))) + "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp") + (tramp-gvfs-parse-device-names "_workstation._tcp"))) (when (member "smb" tramp-gvfs-methods) (tramp-set-completion-function - "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) - - (when (executable-find "avahi-browse") - (tramp-set-completion-function - "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp"))) - (tramp-set-completion-function - "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) - (tramp-set-completion-function - "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) - (tramp-set-completion-function - "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp") - (tramp-gvfs-parse-device-names "_workstation._tcp"))) - (when (member "smb" tramp-gvfs-methods) - (tramp-set-completion-function - "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))) + "smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))) ;; D-Bus SYNCE functions. @@ -1845,8 +1952,9 @@ They are retrieved from the hal daemon." ;;; TODO: -;; * Host name completion via afp-server, smb-server or smb-network. -;; * Check how two shares of the same SMB server can be mounted in +;; * Host name completion for existing mount points (afp-server, +;; smb-server) or via smb-network. +;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. ;; * Apply SDP on bluetooth devices, in order to filter out obex ;; capability.