Remove Tramp temp files if advised during tests

* lisp/net/tramp-fuse.el (tramp-fuse-name-prefix): New defconst.
(tramp-fuse-mount-point): Use it.

* test/lisp/net/tramp-tests.el (tramp-test-name-prefix): New defconst.
(tramp--test-make-temp-name, tramp-test40-make-nearby-temp-file)
(tramp-test47-read-password, tramp-test47-read-otp-password):
Use it.
(tramp--test-enabled-checked): Move down.
(tramp--test-enabled): Delete all Tramp temp files when
environment variable $TRAMP_TEST_CLEANUP_TEMP_FILES is set.
(tramp-test02-file-name-dissect-separate):
Adapt `tramp-crypt-directories' according to syntax.
(tramp-test47-read-password):
Let-bind `tramp-connection-properties' instead of modifying
`tramp-methods'.

(cherry picked from commit 310ce93d02c5317be589803fbde96fd20b96e496)

diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index 7054a7691b22ff17512ffd86bd988da842132f0a..46c5cc731aa47f6e4fc618013c8fa2fc96359bb4 100644 (file)
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -138,13 +138,17 @@
   "Time period to check whether the mount point still exists.
 It has the same meaning as `remote-file-name-inhibit-cache'.")
 
+;;;###tramp-autoload
+(defconst tramp-fuse-name-prefix "tramp-"
+  "Prefix to use for temporary FUSE mount points.")
+
 (defun tramp-fuse-mount-point (vec)
   "Return local mount point of VEC."
   (let ((remote-file-name-inhibit-cache tramp-fuse-mount-timeout))
     (or (tramp-get-file-property vec "/" "mount-point")
        (expand-file-name
         (concat
-         tramp-temp-name-prefix
+         tramp-fuse-name-prefix
          (tramp-file-name-method vec) "."
          (when (tramp-file-name-user vec)
            (concat (tramp-file-name-user-domain vec) "@"))

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index a27756c1cbfb2c80afd010db54ea3f87c91a501b..f93fb0af102d9e3a14cb30c713733b7d3857f48f 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -33,6 +33,14 @@
 ;; remote host, set this environment variable to "/dev/null" or
 ;; whatever is appropriate on your system.
 
+;; All temporary Tramp test files are removed prior test run.
+;; Therefore, two test runs cannot be performed in parallel.
+
+;; The environment variable $TRAMP_TEST_CLEANUP_TEMP_FILES, when set,
+;; forces the removal of all temporary Tramp files prior test run.
+;; This shouldn't be set if the test suite runs in parallel using
+;; Tramp on a production system.
+
 ;; For slow remote connections, `tramp-test45-asynchronous-requests'
 ;; might be too heavy.  Setting $REMOTE_PARALLEL_PROCESSES to a proper
 ;; value less than 10 could help.
@@ -128,7 +136,8 @@
        (tramp-dissect-file-name ert-remote-temporary-file-directory))
   "The used `tramp-file-name' structure.")
 
-(setq auth-source-save-behavior nil
+(setq auth-source-cache-expiry nil
+      auth-source-save-behavior nil
       password-cache-expiry nil
       remote-file-name-inhibit-cache nil
       tramp-allow-unsafe-temporary-files t
@@ -138,39 +147,8 @@
       tramp-persistency-file-name nil
       tramp-verbose 0)
 
-(defvar tramp--test-enabled-checked nil
-  "Cached result of `tramp--test-enabled'.
-If the function did run, the value is a cons cell, the `cdr'
-being the result.")
-
-(defun tramp--test-enabled ()
-  "Whether remote file access is enabled."
-  (unless (consp tramp--test-enabled-checked)
-    (setq
-     tramp--test-enabled-checked
-     (cons
-      t (ignore-errors
-         (and
-          (file-remote-p ert-remote-temporary-file-directory)
-          (file-directory-p ert-remote-temporary-file-directory)
-          (file-writable-p ert-remote-temporary-file-directory))))))
-
-  (when (cdr tramp--test-enabled-checked)
-    ;; Remove old test files.
-    (dolist (dir `(,temporary-file-directory
-                  ,tramp-compat-temporary-file-directory
-                  ,ert-remote-temporary-file-directory))
-      (dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test")))
-       (ignore-errors
-         (if (file-directory-p file)
-             (delete-directory file 'recursive)
-           (delete-file file)))))
-    ;; Cleanup connection.
-    (ignore-errors
-      (tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
-
-  ;; Return result.
-  (cdr tramp--test-enabled-checked))
+(defconst tramp-test-name-prefix "tramp-test"
+  "Prefix to use for temporary test files.")
 
 (defun tramp--test-make-temp-name (&optional local quoted)
   "Return a temporary file name for test.
@@ -180,7 +158,7 @@ The temporary file is not created."
   (funcall
    (if quoted #'file-name-quote #'identity)
    (expand-file-name
-    (make-temp-name "tramp-test")
+    (make-temp-name tramp-test-name-prefix)
     (if local temporary-file-directory ert-remote-temporary-file-directory))))
 
 ;; Method "smb" supports `make-symbolic-link' only if the remote host
@@ -248,6 +226,56 @@ is greater than 10.
        (tramp--test-message
        "%s %f sec" ,message (float-time (time-subtract nil start))))))
 
+(defvar tramp--test-enabled-checked nil
+  "Cached result of `tramp--test-enabled'.
+If the function did run, the value is a cons cell, the `cdr'
+being the result.")
+
+(defun tramp--test-enabled ()
+  "Whether remote file access is enabled."
+  (unless (consp tramp--test-enabled-checked)
+    (setq
+     tramp--test-enabled-checked
+     (cons
+      t (ignore-errors
+         (and
+          (file-remote-p ert-remote-temporary-file-directory)
+          (file-directory-p ert-remote-temporary-file-directory)
+          (file-writable-p ert-remote-temporary-file-directory))))))
+
+  (when (cdr tramp--test-enabled-checked)
+    ;; Remove old test files.
+    (dolist (dir `(,temporary-file-directory
+                  ,tramp-compat-temporary-file-directory
+                  ,ert-remote-temporary-file-directory))
+      (dolist
+         (file
+          (directory-files
+           dir 'full
+           (rx bos (? ".#")
+               (| (literal tramp-test-name-prefix)
+                  (eval (if (getenv "TRAMP_TEST_CLEANUP_TEMP_FILES")
+                            tramp-temp-name-prefix 'unmatchable))))))
+
+       ;; Exclude sockets and FUSE mount points.
+       (ignore-errors
+         (unless
+             (or (string-prefix-p
+                  "srw" (file-attribute-modes (file-attributes file)))
+                 (string-match-p (rx bos (literal tramp-fuse-name-prefix)
+                                     (regexp tramp-method-regexp) ".")
+                                 (file-name-nondirectory file)))
+           (tramp--test-message "Delete %s" file)
+           (if (file-directory-p file)
+               (delete-directory file 'recursive)
+             (delete-file file))))))
+    ;; Cleanup connection.
+    (ignore-errors
+      (tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
+
+  ;; Return result.
+  (cdr tramp--test-enabled-checked))
+
 (ert-deftest tramp-test00-availability ()
   "Test availability of Tramp functions."
   :expected-result (if (tramp--test-enabled) :passed :failed)
@@ -1410,10 +1438,20 @@ is greater than 10.
        ;; Suppress check for multihops.
        (tramp-cache-data (make-hash-table :test #'equal))
        (tramp-connection-properties '((nil "login-program" t)))
-       (syntax tramp-syntax))
+       (syntax tramp-syntax)
+       ;; We must transform `tramp-crypt-directories'.
+       (tramp-crypt-directories
+        (mapcar #'tramp-dissect-file-name tramp-crypt-directories)))
     (unwind-protect
        (progn
          (tramp-change-syntax 'separate)
+         ;; We must transform `tramp-crypt-directories'.
+         (setq tramp-crypt-directories
+               (mapcar
+                (lambda (vec)
+                  (tramp-make-tramp-file-name
+                   vec (tramp-file-name-localname vec)))
+                tramp-crypt-directories))
          ;; An unknown method shall raise an error.
          (let (non-essential)
            (should-error
@@ -2126,7 +2164,7 @@ is greater than 10.
     (when (assoc m tramp-methods)
       (let (tramp-connection-properties tramp-default-proxies-alist)
        (ignore-errors
-         (tramp-cleanup-connection tramp-test-vec nil 'keep-password))
+         (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))
        ;; Single hop.  The host name must match `tramp-local-host-regexp'.
        (should-error
         (find-file (format "/%s:foo:" m))
@@ -6717,7 +6755,7 @@ INPUT, if non-nil, is a string sent to the process."
       (file-remote-p (temporary-file-directory))))
 
     ;; The temporary file shall be located on the remote host.
-    (setq tmp-file (make-nearby-temp-file "tramp-test"))
+    (setq tmp-file (make-nearby-temp-file tramp-test-name-prefix))
     (should (file-exists-p tmp-file))
     (should (file-regular-p tmp-file))
     (should
@@ -6727,7 +6765,7 @@ INPUT, if non-nil, is a string sent to the process."
     (delete-file tmp-file)
     (should-not (file-exists-p tmp-file))
 
-    (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir))
+    (setq tmp-file (make-nearby-temp-file tramp-test-name-prefix 'dir))
     (should (file-exists-p tmp-file))
     (should (file-directory-p tmp-file))
     (delete-directory tmp-file)
@@ -7626,7 +7664,7 @@ process sentinels.  They shall not disturb each other."
 
   (let ((pass "secret")
        (mock-entry (copy-tree (assoc "mock" tramp-methods)))
-       mocked-input tramp-methods)
+       mocked-input tramp-methods auth-sources)
     ;; We must mock `read-string', in order to avoid interactive
     ;; arguments.
     (cl-letf* (((symbol-function #'read-string)
@@ -7665,12 +7703,42 @@ process sentinels.  They shall not disturb each other."
        (setq mocked-input nil)
        (auth-source-forget-all-cached)
        (ert-with-temp-file netrc-file
-         :prefix "tramp-test" :suffix ""
+         :prefix tramp-test-name-prefix :suffix ""
          :text (format
                 "machine %s port mock password %s"
                 (file-remote-p ert-remote-temporary-file-directory 'host) pass)
          (let ((auth-sources `(,netrc-file)))
-           (should (file-exists-p ert-remote-temporary-file-directory)))))))))
+           (should (file-exists-p ert-remote-temporary-file-directory))))))
+
+      ;; Checking session-timeout.
+      (with-no-warnings (when (symbol-plist 'ert-with-temp-file)
+       (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+       (let ((tramp-connection-properties
+              (cons '(nil "session-timeout" 1)
+                    tramp-connection-properties)))
+         (setq mocked-input nil)
+         (auth-source-forget-all-cached)
+         (ert-with-temp-file netrc-file
+           :prefix tramp-test-name-prefix :suffix ""
+           :text (format
+                  "machine %s port mock password %s"
+                  (file-remote-p ert-remote-temporary-file-directory 'host)
+                  pass)
+           (let ((auth-sources `(,netrc-file)))
+             (should (file-exists-p ert-remote-temporary-file-directory))))
+         ;; Session established, password cached.
+         (should
+          (password-in-cache-p
+           (auth-source-format-cache-entry
+            (tramp-get-connection-property tramp-test-vec " pw-spec"))))
+         ;; We want to see the timeout message.
+         (tramp--test-instrument-test-case 3
+           (sleep-for 2))
+         ;; Session cancelled, no password in cache.
+         (should-not
+          (password-in-cache-p
+           (auth-source-format-cache-entry
+            (tramp-get-connection-property tramp-test-vec " pw-spec"))))))))))
 
 (ert-deftest tramp-test47-read-otp-password ()
   "Check Tramp one-time password handling."
@@ -7722,7 +7790,7 @@ process sentinels.  They shall not disturb each other."
        (setq mocked-input nil)
        (auth-source-forget-all-cached)
        (ert-with-temp-file netrc-file
-         :prefix "tramp-test" :suffix ""
+         :prefix tramp-test-name-prefix :suffix ""
          :text (format
                 "machine %s port mock password %s"
                 (file-remote-p ert-remote-temporary-file-directory 'host)