From d932c402aa44c50af60085193b489bc1979cfbc3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 25 Apr 2022 12:57:01 +0200 Subject: [PATCH] Add test for Tramp password handling * lisp/net/tramp.el (tramp-error-show-message-timeout): New defvar. (tramp-error-with-buffer, tramp-user-error): Use it. * test/lisp/net/tramp-tests.el (tramp-error-show-message-timeout): Set it to nil. (tramp-test46-read-password): New test. (tramp-test47-auto-load, tramp-test47-delay-load) (tramp-test47-recursive-load, tramp-test47-remote-load-path) (tramp-test48-unload): * test/lisp/net/tramp-archive-tests.el (tramp-archive-test47-auto-load) (tramp-archive-test47-delay-load): Rename. --- lisp/net/tramp.el | 13 ++++-- test/lisp/net/tramp-archive-tests.el | 4 +- test/lisp/net/tramp-tests.el | 65 +++++++++++++++++++++++++--- 3 files changed, 72 insertions(+), 10 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9aac5b27e69..3d288611792 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2183,6 +2183,11 @@ FMT-STRING and ARGUMENTS." (put #'tramp-error 'tramp-suppress-trace t) +(defvar tramp-error-show-message-timeout 30 + "Time to show the Tramp buffer in case of an error. +If it is bound to nil, the buffer is not shown. This is used in +tramp-tests.el.") + (defsubst tramp-error-with-buffer (buf vec-or-proc signal fmt-string &rest arguments) "Emit an error, and show BUF. @@ -2200,6 +2205,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." (apply #'tramp-error vec-or-proc signal fmt-string arguments) ;; Save exit. (when (and buf + (natnump tramp-error-show-message-timeout) (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) @@ -2213,7 +2219,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; Show buffer. (pop-to-buffer buf) (discard-input) - (sit-for 30))) + (sit-for tramp-error-show-message-timeout))) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) @@ -2226,7 +2232,8 @@ an input event arrives. The other arguments are passed to `tramp-error'." (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. - (when (and (not (zerop tramp-verbose)) + (when (and (natnump tramp-error-show-message-timeout) + (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) ;; Show only when Emacs has started already. @@ -2236,7 +2243,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; `tramp-error' does not show messages. So we must do it ourselves. (apply #'message fmt-string arguments) (discard-input) - (sit-for 30) + (sit-for tramp-error-show-message-timeout) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection)) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index fe27629d902..54d1ecf3652 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -888,7 +888,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -(ert-deftest tramp-archive-test46-auto-load () +(ert-deftest tramp-archive-test47-auto-load () "Check that `tramp-archive' autoloads properly." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) @@ -931,7 +931,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (format "(setq tramp-archive-enabled %s)" enabled)) (shell-quote-argument (format code file))))))))))) -(ert-deftest tramp-archive-test46-delay-load () +(ert-deftest tramp-archive-test47-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e9ea758956a..a5058f92ef0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -125,6 +125,7 @@ tramp-allow-unsafe-temporary-files t tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil + tramp-error-show-message-timeout nil tramp-persistency-file-name nil tramp-verbose 0) @@ -7301,8 +7302,62 @@ process sentinels. They shall not disturb each other." (delete-directory tmp-name) (delete-file (concat tmp-name ".tar.gz")))) +(ert-deftest tramp-test46-read-password () + "Check Tramp password handling." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-mock-p)) + + (let ((pass "aaaa") + (mock-entry (copy-sequence (assoc "mock" tramp-methods))) + mocked-input tramp-methods) + ;; We must mock `read-string', in order to avoid interactive + ;; arguments. + (cl-letf* (((symbol-function #'read-string) + (lambda (&rest _args) (pop mocked-input)))) + (setcdr + (assq 'tramp-login-args mock-entry) + `((("-c") + (,(tramp-shell-quote-argument + (concat + "read -s -p 'Password: ' pass; echo; " + "(test \"pass$pass\" != \"pass" pass "\" && " + "echo \"Login incorrect\" || sh -i)")))))) + (setq tramp-methods `(,mock-entry)) + + ;; Reading password from stdin works. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + ;; We don't want to invalidate the password. + (setq mocked-input `(,(copy-sequence pass))) + (should (file-exists-p tramp-test-temporary-file-directory)) + + ;; Don't entering a password returns in error. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (should-error (file-exists-p tramp-test-temporary-file-directory)) + + ;; A wrong password doesn't work either. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input `(,(concat pass pass))) + (should-error (file-exists-p tramp-test-temporary-file-directory)) + + ;; Reading password from auth-source works. We use the netrc + ;; backend; the other backends shall behave similar. + ;; Macro `ert-with-temp-file' was introduced in Emacs 29.1. + (with-no-warnings (when (symbol-plist 'ert-with-temp-file) + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (auth-source-forget-all-cached) + (ert-with-temp-file netrc-file + :prefix "tramp-test" :suffix "" + :text (format + "machine %s port mock password %s" + (file-remote-p tramp-test-temporary-file-directory 'host) pass) + (let ((auth-sources `(,netrc-file))) + (should (file-exists-p tramp-test-temporary-file-directory))))))))) + ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test46-auto-load () +(ert-deftest tramp-test47-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@ -7327,7 +7382,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test46-delay-load () +(ert-deftest tramp-test47-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file @@ -7356,7 +7411,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test46-recursive-load () +(ert-deftest tramp-test47-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -7380,7 +7435,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test46-remote-load-path () +(ert-deftest tramp-test47-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -7405,7 +7460,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test47-unload () +(ert-deftest tramp-test48-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) -- 2.39.2