master d932c402aa: Add test for Tramp password handling

[Michael Albinus]

branch: master
commit d932c402aa44c50af60085193b489bc1979cfbc3
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    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 9aac5b27e6..3d28861179 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 fe27629d90..54d1ecf365 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 e9ea758956..a5058f92ef 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)