Fix Bug#30262

* lisp/net/tramp-archive.el (tramp-archive-hash): Document (changed)
layout.
(tramp-archive-dissect-file-name): Merge with
`tramp-archive-local-copy', which has been removed by this.
(tramp-archive-cleanup-hash): Adapt to changed
`tramp-archive-hash'.  (Bug#30262)

* lisp/net/tramp-gvfs.el (tramp-gvfs-unmount): Flush
connection properties.

* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test01-file-name-syntax)
(tramp-archive-test02-file-name-dissect)
(tramp-archive-test16-directory-files)
(tramp-archive-test26-file-name-completion): Adapt to changed
test file.
(tramp-archive-test08-file-local-copy): Be more robust in cleanup.

* test/lisp/net/tramp-archive-resources/foo.tar.gz: Adapt to
extended test.

2 files changed, 66 insertions, 62 deletions

diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 45e3bf0a606..ac8b76b9442 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -301,27 +301,42 @@ pass to the OPERATION."
        t))
 
 (defvar tramp-archive-hash (make-hash-table :test 'equal)
-  "Hash table for archive local copies.")
-
-(defun tramp-archive-local-copy (archive)
-  "Return copy of ARCHIVE, usable by GVFS.
-ARCHIVE is the archive component of an archive file name."
-  (setq archive (file-truename archive))
-  (let ((tramp-verbose 0))
-    (with-tramp-connection-property
-        ;; This is just an auxiliary VEC for caching properties.
-        (make-tramp-file-name :method tramp-archive-method :host archive)
-        "archive"
+  "Hash table for archive local copies.
+The hash key is the archive name.  The value is a cons of the
+used `tramp-file-name' structure for tramp-gvfs, and the file
+name of a local copy, if any.")
+
+(defun tramp-archive-dissect-file-name (name)
+  "Return a `tramp-file-name' structure.
+The structure consists of the `tramp-archive-method' method, the
+hexlified archive name as host, and the localname.  The archive
+name is kept in slot `hop'"
+  (save-match-data
+    (unless (tramp-archive-file-name-p name)
+      (tramp-compat-user-error nil "Not an archive file name: \"%s\"" name))
+    ;; The `string-match' happened in `tramp-archive-file-name-p'.
+    (let ((archive (match-string 1 name))
+          (localname (match-string 2 name))
+          (tramp-verbose 0)
+          vec copy)
+
+      (setq archive (file-truename archive))
+
       (cond
+       ;; The value is already in the hash table.
+       ((setq vec (car (gethash archive tramp-archive-hash))))
+
        ;; File archives inside file archives.
        ((tramp-archive-file-name-p archive)
         (let ((archive
                (tramp-make-tramp-file-name
                 (tramp-archive-dissect-file-name archive) nil 'noarchive)))
-          ;; We call `file-attributes' in order to mount the archive.
-          (file-attributes archive)
-          (puthash archive nil tramp-archive-hash)
-          archive))
+          (setq vec
+                (make-tramp-file-name
+                 :method tramp-archive-method :hop archive
+                 :host (url-hexify-string (tramp-gvfs-url-file-name archive)))))
+        (puthash archive (list vec) tramp-archive-hash))
+
        ;; http://...
        ((and url-handler-mode
              tramp-compat-use-url-tramp-p
@@ -332,26 +347,36 @@ ARCHIVE is the archive component of an archive file name."
                  (url-type (url-generic-parse-url archive))
                  url-tramp-protocols))
                (archive (url-tramp-convert-url-to-tramp archive)))
-          (puthash archive nil tramp-archive-hash)
-          archive))
+          (setq vec
+                (make-tramp-file-name
+                 :method tramp-archive-method :hop archive
+                 :host (url-hexify-string (tramp-gvfs-url-file-name archive)))))
+          (puthash archive (list vec) tramp-archive-hash))
+
        ;; GVFS supported schemes.
        ((or (tramp-gvfs-file-name-p archive)
             (not (file-remote-p archive)))
-        (puthash archive nil tramp-archive-hash)
-        archive)
+        (setq vec
+              (make-tramp-file-name
+               :method tramp-archive-method :hop archive
+               :host (url-hexify-string (tramp-gvfs-url-file-name archive))))
+        (puthash archive (list vec) tramp-archive-hash))
+
        ;; Anything else.  Here we call `file-local-copy', which we
        ;; have avoided so far.
        (t (let ((inhibit-file-name-operation 'file-local-copy)
                 (inhibit-file-name-handlers
-                 (cons 'jka-compr-handler inhibit-file-name-handlers))
-                result)
-            (or (and (setq result (gethash archive tramp-archive-hash nil))
-                     (file-readable-p result))
-                (puthash
-                 archive
-                 (setq result (file-local-copy archive))
-                 tramp-archive-hash))
-            result))))))
+                 (cons 'jka-compr-handler inhibit-file-name-handlers)))
+            (setq copy (file-local-copy archive)
+                  vec
+                  (make-tramp-file-name
+                   :method tramp-archive-method :hop archive
+                   :host (url-hexify-string (tramp-gvfs-url-file-name copy)))))
+          (puthash archive (cons vec copy) tramp-archive-hash)))
+
+      ;; So far, `vec' handles just the mount point.  Add `localname'.
+      (setf (tramp-file-name-localname vec) localname)
+      vec)))
 
 ;;;###tramp-autoload
 (defun tramp-archive-cleanup-hash ()
@@ -360,16 +385,10 @@ ARCHIVE is the archive component of an archive file name."
    (lambda (key value)
      ;; Unmount local copy.
      (ignore-errors
-       (let ((tramp-gvfs-methods tramp-archive-all-gvfs-methods)
-             (file-archive (file-name-as-directory key)))
-         (tramp-message
-          (and (tramp-tramp-file-p key) (tramp-dissect-file-name key)) 3
-          "Unmounting %s" file-archive)
-         (tramp-gvfs-unmount
-          (tramp-dissect-file-name
-           (tramp-archive-gvfs-file-name file-archive)))))
+       (tramp-message (car value) 3 "Unmounting %s" (or (cdr value) key))
+       (tramp-gvfs-unmount (car value)))
      ;; Delete local copy.
-     (ignore-errors (when value (delete-file value)))
+     (ignore-errors (delete-file (cdr value)))
      (remhash key tramp-archive-hash))
    tramp-archive-hash)
   (clrhash tramp-archive-hash))
@@ -380,24 +399,6 @@ ARCHIVE is the archive component of an archive file name."
             (remove-hook 'kill-emacs-hook
                          'tramp-archive-cleanup-hash)))
 
-(defun tramp-archive-dissect-file-name (name)
-  "Return a `tramp-file-name' structure.
-The structure consists of the `tramp-archive-method' method, the
-hexlified archive name as host, and the localname.  The archive
-name is kept in slot `hop'"
-  (save-match-data
-    (unless (tramp-archive-file-name-p name)
-      (tramp-compat-user-error nil "Not an archive file name: \"%s\"" name))
-    ;; The `string-match' happened in `tramp-archive-file-name-p'.
-    (let ((archive (match-string 1 name))
-          (localname (match-string 2 name))
-          (tramp-verbose 0))
-      (make-tramp-file-name
-       :method tramp-archive-method :user nil :domain nil :host
-       (url-hexify-string
-        (tramp-gvfs-url-file-name (tramp-archive-local-copy archive)))
-       :port nil :localname localname :hop archive))))
-
 (defsubst tramp-file-name-archive (vec)
   "Extract the archive file name from VEC.
 VEC is expected to be a `tramp-file-name', with the method being
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 6745ae02c7b..70ac077a7c5 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1778,13 +1778,16 @@ file-notify events."
 
 (defun tramp-gvfs-unmount (vec)
   "Unmount the object identified by VEC."
-  (let ((vec (copy-tramp-file-name vec)))
-    (setf (tramp-file-name-localname vec) "/"
-          (tramp-file-name-hop vec) nil)
-    (when (tramp-gvfs-connection-mounted-p vec)
-      (tramp-gvfs-send-command
-       vec "gvfs-mount" "-u"
-       (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))))
+  (setf (tramp-file-name-localname vec) "/"
+        (tramp-file-name-hop vec) nil)
+  (when (tramp-gvfs-connection-mounted-p vec)
+    (tramp-gvfs-send-command
+     vec "gvfs-mount" "-u"
+     (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))
+  (while (tramp-gvfs-connection-mounted-p vec)
+    (read-event nil nil 0.1))
+  (tramp-flush-connection-properties vec)
+  (tramp-flush-connection-properties (tramp-get-connection-process vec)))
 
 (defun tramp-gvfs-mount-spec-entry (key value)
   "Construct a mount-spec entry to be used in a mount_spec.