From b0cc2bff04bb69a78a4b3843c96a4c06670fcfd4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 15 Nov 2024 14:28:08 +0100 Subject: [PATCH] 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) --- lisp/net/tramp-fuse.el | 6 +- test/lisp/net/tramp-tests.el | 154 +++++++++++++++++++++++++---------- 2 files changed, 116 insertions(+), 44 deletions(-) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 7054a7691b2..46c5cc731aa 100644 --- 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 a27756c1cbf..f93fb0af102 100644 --- 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) -- 2.39.5