]> git.eshelyaron.com Git - emacs.git/commitdiff
Add new Tramp test
authorMichael Albinus <michael.albinus@gmx.de>
Mon, 25 Sep 2023 10:48:32 +0000 (12:48 +0200)
committerMichael Albinus <michael.albinus@gmx.de>
Mon, 25 Sep 2023 10:48:32 +0000 (12:48 +0200)
* test/lisp/net/tramp-tests.el (tramp-test46-read-password):
Use `copy-tree' but `copy-sequence'.
(tramp-test46-read-otp-password): New test.

test/lisp/net/tramp-tests.el

index 6021eda8dffd794d71499f0c818e3351cc065971..3c2ec9275c68114bf62b18aef3f4c51b431fbdf9 100644 (file)
@@ -7843,7 +7843,7 @@ process sentinels.  They shall not disturb each other."
       (shell-command-to-string "read -s -p Password: pass"))))
 
   (let ((pass "secret")
-       (mock-entry (copy-sequence (assoc "mock" tramp-methods)))
+       (mock-entry (copy-tree (assoc "mock" tramp-methods)))
        mocked-input tramp-methods)
     ;; We must mock `read-string', in order to avoid interactive
     ;; arguments.
@@ -7890,6 +7890,65 @@ process sentinels.  They shall not disturb each other."
          (let ((auth-sources `(,netrc-file)))
            (should (file-exists-p ert-remote-temporary-file-directory)))))))))
 
+(ert-deftest tramp-test46-read-otp-password ()
+  "Check Tramp one-time password handling."
+  :tags '(:expensive-test)
+  (skip-unless (tramp--test-mock-p))
+  ;; Not all read commands understand argument "-s" or "-p".
+  (skip-unless
+   (string-empty-p
+    (let ((shell-file-name "sh"))
+      (shell-command-to-string "read -s -p Password: pass"))))
+
+  (let ((pass "secret")
+       (mock-entry (copy-tree (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 'Verification code: ' 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 ert-remote-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 ert-remote-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 ert-remote-temporary-file-directory))
+
+      ;; The password shouldn't be read from auth-source.
+      ;; 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 ert-remote-temporary-file-directory 'host)
+                pass)
+         (let ((auth-sources `(,netrc-file)))
+           (should-error
+            (file-exists-p ert-remote-temporary-file-directory)))))))))
+
 ;; This test is inspired by Bug#29163.
 (ert-deftest tramp-test47-auto-load ()
   "Check that Tramp autoloads properly."