emacs-28 3863919: Fix unmounting in Tramp

[Michael Albinus]

branch: emacs-28
commit 3863919a00e5f6c7cf9d4fe9e1b1a96fd5c18173
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Fix unmounting in Tramp
    
    * doc/misc/tramp.texi (FUSE setup): Add tramp-fuse-unmount-on-cleanup.
    
    * lisp/net/tramp.el (tramp-file-name-unify): New defun.
    (tramp-file-name-equal-p):
    * lisp/net/tramp-cache.el (tramp-get-connection-property)
    (tramp-set-connection-property, tramp-flush-connection-property)
    (tramp-flush-connection-properties): Use it.
    
    * lisp/net/tramp-fuse.el (tramp-fuse-get-fusermount): New defun.
    (tramp-fuse-mount-points): New defvar.
    (tramp-fuse-unmount): Use it.  Delete VEC from
    `tramp-fuse-mount-points'.  Delete mount point.
    (tramp-fuse-unmount-on-cleanup): New user option.
    (tramp-fuse-cleanup, tramp-fuse-cleanup-all): New defuns.
    (top): Adapt `tramp-fuse-unload-hook',
    `tramp-cleanup-connection-hook',
    `tramp-cleanup-all-connections-hook' and `kill-emacs-hook'.
    
    * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection):
    * lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection):
    Add VEC to `tramp-fuse-mount-points'.
    
    * test/lisp/net/tramp-tests.el (tramp-fuse-unmount-on-cleanup): Declare.
    (tramp-test39-make-lock-file-name): Use it.
---
 doc/misc/tramp.texi          |  5 +++++
 lisp/net/tramp-cache.el      | 28 ++++--------------------
 lisp/net/tramp-fuse.el       | 51 +++++++++++++++++++++++++++++++++++++++++---
 lisp/net/tramp-rclone.el     |  1 +
 lisp/net/tramp-sshfs.el      |  1 +
 lisp/net/tramp.el            | 22 +++++++++++++------
 test/lisp/net/tramp-tests.el |  6 ++----
 7 files changed, 76 insertions(+), 38 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index e1bf2f2..95c744e 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2629,6 +2629,11 @@ Example:
 @end group
 @end lisp
 
+@vindex tramp-fuse-unmount-on-cleanup
+The user option @code{tramp-fuse-unmount-on-cleanup}, when set to
+non-@code{nil}, controls, whether a mount point is unmounted on
+connection cleanup or on Emacs exiting.
+
 
 @anchor{Setup of rclone method}
 @subsection @option{rclone} setup
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 5a00915..f1c656e 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -319,12 +319,7 @@ KEY identifies the connection, it is either a process or a
 used to cache connection properties of the local machine.
 If KEY is `tramp-cache-undefined', or if the value is not set for
 the connection, return DEFAULT."
-  ;; Unify key by removing localname and hop from `tramp-file-name'
-  ;; structure.  Work with a copy in order to avoid side effects.
-  (when (tramp-file-name-p key)
-    (setq key (copy-tramp-file-name key))
-    (setf (tramp-file-name-localname key) nil
-         (tramp-file-name-hop key) nil))
+  (setq key (tramp-file-name-unify key))
   (let* ((hash (tramp-get-hash-table key))
         (cached (if (hash-table-p hash)
                     (gethash property hash tramp-cache-undefined)
@@ -350,12 +345,7 @@ used to cache connection properties of the local machine.  
If KEY
 is `tramp-cache-undefined', nothing is set.
 PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
 Return VALUE."
-  ;; Unify key by removing localname and hop from `tramp-file-name'
-  ;; structure.  Work with a copy in order to avoid side effects.
-  (when (tramp-file-name-p key)
-    (setq key (copy-tramp-file-name key))
-    (setf (tramp-file-name-localname key) nil
-         (tramp-file-name-hop key) nil))
+  (setq key (tramp-file-name-unify key))
   (when-let ((hash (tramp-get-hash-table key)))
     (puthash property value hash))
   (setq tramp-cache-data-changed
@@ -379,12 +369,7 @@ KEY identifies the connection, it is either a process or a
 `tramp-file-name' structure.  A special case is nil, which is
 used to cache connection properties of the local machine.
 PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
-  ;; Unify key by removing localname and hop from `tramp-file-name'
-  ;; structure.  Work with a copy in order to avoid side effects.
-  (when (tramp-file-name-p key)
-    (setq key (copy-tramp-file-name key))
-    (setf (tramp-file-name-localname key) nil
-         (tramp-file-name-hop key) nil))
+  (setq key (tramp-file-name-unify key))
   (when-let ((hash (tramp-get-hash-table key)))
     (remhash property hash))
   (setq tramp-cache-data-changed
@@ -397,12 +382,7 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' 
structure."
 KEY identifies the connection, it is either a process or a
 `tramp-file-name' structure.  A special case is nil, which is
 used to cache connection properties of the local machine."
-  ;; Unify key by removing localname and hop from `tramp-file-name'
-  ;; structure.  Work with a copy in order to avoid side effects.
-  (when (tramp-file-name-p key)
-    (setq key (copy-tramp-file-name key))
-    (setf (tramp-file-name-localname key) nil
-         (tramp-file-name-hop key) nil))
+  (setq key (tramp-file-name-unify key))
   (tramp-message
    key 7 "%s %s" key
    (when-let ((hash (gethash key tramp-cache-data)))
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index 8c5afa7..d2bac2d 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -175,15 +175,30 @@
                  mount)
              (match-string 1 mount)))))))
 
+(defun tramp-fuse-get-fusermount ()
+  "Determine the local `fusermount' command."
+  ;; We use key nil for local connection properties.
+  (with-tramp-connection-property nil "fusermount"
+    (or (executable-find "fusermount3")
+       (executable-find "fusermount"))))
+
+(defvar tramp-fuse-mount-points nil
+  "List of fuse volume determined by a VEC.")
+
 (defun tramp-fuse-unmount (vec)
   "Unmount fuse volume determined by VEC."
-  (let ((default-directory tramp-compat-temporary-file-directory)
-        (command (format "fusermount3 -u %s" (tramp-fuse-mount-point vec))))
+  (let* ((default-directory tramp-compat-temporary-file-directory)
+        (mount-point (tramp-fuse-mount-point vec))
+         (command (format "%s -u %s" (tramp-fuse-get-fusermount) mount-point)))
     (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command))
     (tramp-flush-connection-property
      (tramp-get-connection-process vec) "mounted")
+    (setq tramp-fuse-mount-points
+         (delete (tramp-file-name-unify vec) tramp-fuse-mount-points))
     ;; Give the caches a chance to expire.
-    (sleep-for 1)))
+    (sleep-for 1)
+    (when (tramp-compat-directory-empty-p mount-point)
+      (delete-directory mount-point))))
 
 (defun tramp-fuse-local-file-name (filename)
   "Return local mount name of FILENAME."
@@ -205,6 +220,36 @@
              (substring localname 1) localname)
          (tramp-fuse-mount-point v)))))))
 
+(defcustom tramp-fuse-unmount-on-cleanup nil
+  "Whether fuse volumes shall be unmounted on cleanup."
+  :group 'tramp
+  :version "28.1"
+  :type 'boolean)
+
+(defun tramp-fuse-cleanup (vec)
+  "Cleanup fuse volume determined by VEC."
+  (and tramp-fuse-unmount-on-cleanup
+       (member (tramp-file-name-unify vec) tramp-fuse-mount-points)
+       (tramp-fuse-unmount vec)))
+
+(defun tramp-fuse-cleanup-all ()
+  "Unmount all fuse volumes used by Tramp."
+  (and tramp-fuse-unmount-on-cleanup
+       (mapc #'tramp-fuse-unmount tramp-fuse-mount-points)))
+
+;; Add cleanup hooks.
+(add-hook 'tramp-cleanup-connection-hook #'tramp-fuse-cleanup)
+(add-hook 'tramp-cleanup-all-connections-hook #'tramp-fuse-cleanup-all)
+(add-hook 'kill-emacs-hook #'tramp-fuse-cleanup-all)
+(add-hook 'tramp-fuse-unload-hook
+         (lambda ()
+           (remove-hook 'tramp-cleanup-connection-hook
+                        #'tramp-fuse-cleanup)
+           (remove-hook 'tramp-cleanup-all-connections-hook
+                        #'tramp-fuse-cleanup-all)
+           (remove-hook 'kill-emacs-hook
+                        #'tramp-fuse-cleanup-all)))
+
 (add-hook 'tramp-unload-hook
          (lambda ()
            (unload-feature 'tramp-fuse 'force)))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 49e366c..812e06f 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -386,6 +386,7 @@ connection if a previous connection has died for some 
reason."
          (tramp-cleanup-connection vec 'keep-debug 'keep-password))
 
        ;; Mark it as connected.
+       (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))
        (tramp-set-connection-property
         (tramp-get-connection-process vec) "connected" t))))
 
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 68230ee..2be0485 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -371,6 +371,7 @@ connection if a previous connection has died for some 
reason."
           vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))))
 
       ;; Mark it as connected.
+      (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))
       (tramp-set-connection-property
        (tramp-get-connection-process vec) "connected" t)))
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b69e143..c0f1cb1 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1450,16 +1450,24 @@ If nil, return `tramp-default-port'."
 
 (put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
 
+(defun tramp-file-name-unify (vec)
+  "Unify VEC by removing localname and hop from `tramp-file-name' structure.
+Objects returned by this function compare `equal' if they refer to the
+same connection.  Make a copy in order to avoid side effects."
+  (when (tramp-file-name-p vec)
+    (setq vec (copy-tramp-file-name vec))
+    (setf (tramp-file-name-localname vec) nil
+         (tramp-file-name-hop vec) nil))
+  vec)
+
+(put #'tramp-file-name-unify 'tramp-suppress-trace t)
+
 ;; Comparison of file names is performed by `tramp-equal-remote'.
 (defun tramp-file-name-equal-p (vec1 vec2)
   "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
   (and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
-       (string-equal (tramp-file-name-method vec1)
-                    (tramp-file-name-method vec2))
-       (string-equal (tramp-file-name-user-domain vec1)
-                    (tramp-file-name-user-domain vec2))
-       (string-equal (tramp-file-name-host-port vec1)
-                    (tramp-file-name-host-port vec2))))
+       (equal (tramp-file-name-unify vec1)
+             (tramp-file-name-unify vec2))))
 
 (defun tramp-get-method-parameter (vec param)
   "Return the method parameter PARAM.
@@ -3846,7 +3854,7 @@ User is always nil."
          (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop))))
 
       ;; Result.
-      (cons (expand-file-name filename) (cdr result)))))
+      (cons filename (cdr result)))))
 
 (defun tramp-get-lock-file (file)
   "Read lockfile info of FILE.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 9a1c9d6..ebedbaf 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -69,6 +69,7 @@
 (defvar tramp-connection-properties)
 (defvar tramp-copy-size-limit)
 (defvar tramp-display-escape-sequence-regexp)
+(defvar tramp-fuse-unmount-on-cleanup)
 (defvar tramp-inline-compress-start-size)
 (defvar tramp-persistency-file-name)
 (defvar tramp-remote-path)
@@ -5884,10 +5885,7 @@ Use direct async.")
          tramp-allow-unsafe-temporary-files
           (inhibit-message t)
          ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files.
-         (tramp-cleanup-connection-hook
-          (append
-           (and (tramp--test-fuse-p) '(tramp-fuse-unmount))
-           tramp-cleanup-connection-hook))
+         (tramp-fuse-unmount-on-cleanup t)
           auto-save-default
          noninteractive)