From 984903868bb2fdfadc8f3c08e15434d44c4d08f4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 24 Jan 2020 14:41:22 +0100 Subject: [PATCH] Support (un)mount of Tramp media devices * lisp/net/tramp-gvfs.el (tramp-gvfs-gio-mapping): Add "gvfs-rename". (tramp-gvfs-do-copy-or-rename-file): Use it. (tramp-gvfs-activation-uri): Handle "media" method. (tramp-gvfs-url-host): New defun. (tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p) (tramp-gvfs-handler-volumeadded-volumeremoved) (tramp-get-media-devices): Use it. --- lisp/net/tramp-gvfs.el | 57 ++++++++++++++++++++++++++++-------------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ffcdafcb317..4374dc0a10d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -687,6 +687,7 @@ It has been changed in GVFS 1.14.") ("gvfs-monitor-file" . "monitor") ("gvfs-mount" . "mount") ("gvfs-move" . "move") + ("gvfs-rename" . "rename") ("gvfs-rm" . "remove") ("gvfs-set-attribute" . "set") ("gvfs-trash" . "trash")) @@ -973,11 +974,15 @@ file names." (copy-directory filename newname keep-date t) (when (eq op 'rename) (delete-directory filename 'recursive))) - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - (equal-remote (tramp-equal-remote filename newname)) - (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move")) - (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) + (let* ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (equal-remote (tramp-equal-remote filename newname)) + (gvfs-operation + (cond + ((eq op 'copy) "gvfs-copy") + (equal-remote "gvfs-rename") + (t "gvfs-move"))) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) @@ -1048,8 +1053,8 @@ file names." (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -1545,8 +1550,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `rename-file' for Tramp files." ;; Check if both files are local -- invoke normal rename-file. ;; Otherwise, use Tramp from local system. - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -1613,6 +1618,12 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq method "davs" localname (concat (tramp-gvfs-get-remote-prefix v) localname))) + (when (string-equal "media" method) + (when-let + ((media (tramp-get-connection-property v "media-device" nil))) + (setq method (tramp-media-device-method media) + host (tramp-media-device-host media) + port (tramp-media-device-port media)))) (when (and user domain) (setq user (concat domain ";" user))) (url-recreate-url @@ -1648,6 +1659,14 @@ If FILE-SYSTEM is non-nil, return file system attributes." (dbus-unescape-from-identifier (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) +(defun tramp-gvfs-url-host (url) + "Return the host name part of URL, a string. +We cannot use `url-host', because `url-generic-parse-url' returns +a downcased host name only." + (and (stringp url) + (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url) + (match-string 1 url))) + ;; D-Bus GVFS functions. @@ -1788,17 +1807,17 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "http" method) (stringp uri)) - (setq uri (url-generic-parse-url uri) + (setq host (tramp-gvfs-url-host uri) + uri (url-generic-parse-url uri) method (url-type uri) user (url-user uri) - host (url-host uri) port (url-portspec uri))) (when (member method tramp-media-methods) ;; Ensure that media devices are cached. (tramp-get-media-devices nil) (let ((v (tramp-get-connection-property (make-tramp-media-device - :method method :host (downcase host) :port port) + :method method :host host :port port) "vector" nil))) (when v (setq method (tramp-file-name-method v) @@ -1889,17 +1908,17 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "http" method) (stringp uri)) - (setq uri (url-generic-parse-url uri) + (setq host (tramp-gvfs-url-host uri) + uri (url-generic-parse-url uri) method (url-type uri) user (url-user uri) - host (url-host uri) port (url-portspec uri))) (when (member method tramp-media-methods) ;; Ensure that media devices are cached. (tramp-get-media-devices vec) (let ((v (tramp-get-connection-property (make-tramp-media-device - :method method :host (downcase host) :port port) + :method method :host host :port port) "vector" nil))) (when v (setq method (tramp-file-name-method v) @@ -2015,7 +2034,7 @@ and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals." :host (replace-regexp-in-string " " "_" (nth 1 volume)))) (media (make-tramp-media-device :method method - :host (url-host uri) + :host (tramp-gvfs-url-host (nth 5 volume)) :port (and (url-portspec uri))))) (when (member method tramp-media-methods) (tramp-message @@ -2342,8 +2361,8 @@ It checks for registered GNOME Online Accounts." (defun tramp-get-media-device (vec) "Transform VEC into a `tramp-media-device' structure. Check, that respective cache values do exist." - (if-let* ((media (tramp-get-connection-property vec "media-device" nil)) - (prop (tramp-get-connection-property media "vector" nil))) + (if-let ((media (tramp-get-connection-property vec "media-device" nil)) + (prop (tramp-get-connection-property media "vector" nil))) media (tramp-get-media-devices vec) (tramp-get-connection-property vec "media-device" nil))) @@ -2365,7 +2384,7 @@ VEC is used only for traces." :host (replace-regexp-in-string " " "_" (nth 1 volume)))) (media (make-tramp-media-device :method method - :host (url-host uri) + :host (tramp-gvfs-url-host (nth 5 volume)) :port (and (url-portspec uri) (number-to-string (url-portspec uri)))))) (push (tramp-file-name-host vec) devices) -- 2.39.2