emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 788a658: Do not save empty passwords in auth-source-search


From: Michael Albinus
Subject: master 788a658: Do not save empty passwords in auth-source-search
Date: Sun, 19 Sep 2021 13:59:12 -0400 (EDT)

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

    Do not save empty passwords in auth-source-search
    
    * lisp/auth-source.el (auth-source-netrc-create)
    (auth-source-secrets-create): Set :save-function only for non
    empty passwords.
    
    * lisp/net/tramp.el (tramp-read-passwd): Don't save empty passwords.
    
    * test/lisp/auth-source-tests.el
    (auth-source-test-secrets-create-secret): Adapt test.
    (auth-source-test-netrc-create-secret): New test.
---
 lisp/auth-source.el            |  52 +++++++++-------
 lisp/net/tramp.el              |   4 ++
 test/lisp/auth-source-tests.el | 132 ++++++++++++++++++++++++++++++-----------
 3 files changed, 134 insertions(+), 54 deletions(-)

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 8d6ebd3..d938522 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1282,6 +1282,8 @@ See `auth-source-search' for details on SPEC."
          (required (append base-required create-extra))
          (file (oref backend source))
          (add "")
+         ;; Whether to set save-function.
+         save-function
          ;; `valist' is an alist
          valist
          ;; `artificial' will be returned if no creation is needed
@@ -1411,6 +1413,8 @@ See `auth-source-search' for details on SPEC."
         ;; When r is not an empty string...
         (when (and (stringp data)
                    (< 0 (length data)))
+          (when (eq r 'secret)
+            (setq save-function t))
           ;; this function is not strictly necessary but I think it
           ;; makes the code clearer -tzz
           (let ((printer (lambda ()
@@ -1431,12 +1435,13 @@ See `auth-source-search' for details on SPEC."
                                      data)))))
             (setq add (concat add (funcall printer)))))))
 
-    (plist-put
-     artificial
-     :save-function
-     (let ((file file)
-           (add add))
-       (lambda () (auth-source-netrc-saver file add))))
+    (when save-function
+      (plist-put
+       artificial
+       :save-function
+       (let ((file file)
+             (add add))
+         (lambda () (auth-source-netrc-saver file add)))))
 
     (list artificial)))
 
@@ -1664,6 +1669,8 @@ authentication tokens:
                                                 :port port)))
          (required (append base-required create-extra))
          (collection (oref backend source))
+         ;; Whether to set save-function.
+         save-function
          ;; `args' are the arguments for `secrets-create-item'.
          args
          ;; `valist' is an alist
@@ -1778,21 +1785,24 @@ authentication tokens:
 
         ;; When r is not an empty string...
         (when (and (stringp data)
-                   (< 0 (length data))
-                   (not (member r '(secret label))))
-          ;; append the key (the symbol name of r)
-          ;; and the value in r
-          (setq args (append args (list (auth-source--symbol-keyword r) 
data))))))
-
-    (plist-put
-     artificial
-     :save-function
-     (let* ((collection collection)
-            (item (plist-get artificial :label))
-            (secret (plist-get artificial :secret))
-            (secret (if (functionp secret) (funcall secret) secret)))
-       (lambda ()
-        (auth-source-secrets-saver collection item secret args))))
+                   (< 0 (length data)))
+          (if (eq r 'secret)
+              (setq save-function t)
+            (if (not (eq r 'label))
+                ;; append the key (the symbol name of r)
+                ;; and the value in r
+                (setq args (append args (list (auth-source--symbol-keyword r) 
data))))))))
+
+    (when save-function
+      (plist-put
+       artificial
+       :save-function
+       (let* ((collection collection)
+              (item (plist-get artificial :label))
+              (secret (plist-get artificial :secret))
+              (secret (if (functionp secret) (funcall secret) secret)))
+         (lambda ()
+          (auth-source-secrets-saver collection item secret args)))))
 
     (list artificial)))
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 93ec8d6..8c92000 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5677,6 +5677,10 @@ Invokes `password-read' if available, `read-passwd' 
else."
               ;; Else, get the password interactively w/o cache.
               (read-passwd pw-prompt))
 
+           ;; Workaround.  Prior Emacs 28.1, auth-source has saved
+           ;; empty passwords.  See discussion in Bug#50399.
+           (when (zerop (length auth-passwd))
+             (setq tramp-password-save-function nil))
            (tramp-set-connection-property v "first-password-request" nil)))
 
       ;; Reenable the timers.
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 45482e9..08e8325 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -312,39 +312,105 @@
   ;; Emacs process.  Therefore, we don't care to delete it.
   (let ((auth-sources '((:source (:secrets "session"))))
         (auth-source-save-behavior t)
-        (host (md5 (concat (prin1-to-string process-environment)
-                          (current-time-string))))
-        (passwd (md5 (concat (prin1-to-string process-environment)
-                            (current-time-string) (current-time-string))))
-        auth-info auth-passwd)
-    ;; Redefine `read-*' in order to avoid interactive input.
-    (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
-              ((symbol-function 'read-string)
-               (lambda (_prompt &optional _initial _history default
-                                _inherit-input-method)
-                 default)))
-      (setq auth-info
-            (car (auth-source-search
-                  :max 1 :host host :require '(:user :secret) :create t))))
-    (should (functionp (plist-get auth-info :save-function)))
-    (funcall (plist-get auth-info :save-function))
-
-    ;; Check, that the item has been created indeed.
-    (auth-source-forget+ :host t)
-    (setq auth-info (car (auth-source-search :host host))
-         auth-passwd (plist-get auth-info :secret)
-         auth-passwd (if (functionp auth-passwd)
-                         (funcall auth-passwd)
-                       auth-passwd))
-    (should (string-equal (plist-get auth-info :user) (user-login-name)))
-    (should (string-equal (plist-get auth-info :host) host))
-    (should (string-equal auth-passwd passwd))
-
-    ;; Cleanup.
-    ;; Should use `auth-source-delete' when implemented for :secrets backend.
-    (secrets-delete-item
-     "session"
-     (format "%s@%s" (plist-get auth-info :user) (plist-get auth-info 
:host)))))
+        host auth-info auth-passwd)
+    (dolist (passwd '("foo" "" nil))
+      (unwind-protect
+          ;; Redefine `read-*' in order to avoid interactive input.
+          (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
+                    ((symbol-function 'read-string)
+                     (lambda (_prompt &optional _initial _history default
+                                      _inherit-input-method)
+                       default)))
+            (setq host
+                  (md5 (concat (prin1-to-string process-environment) passwd))
+                  auth-info
+                  (car (auth-source-search
+                        :max 1 :host host :require '(:user :secret) :create t))
+                 auth-passwd (plist-get auth-info :secret)
+                 auth-passwd (if (functionp auth-passwd)
+                                 (funcall auth-passwd)
+                               auth-passwd))
+            (should (string-equal (plist-get auth-info :user) 
(user-login-name)))
+            (should (string-equal (plist-get auth-info :host) host))
+            (should (equal auth-passwd passwd))
+            (when (functionp (plist-get auth-info :save-function))
+              (funcall (plist-get auth-info :save-function)))
+
+            ;; Check, that the item has been created indeed.
+            (auth-source-forget+ :host t)
+            (setq auth-info (car (auth-source-search :host host))
+                 auth-passwd (plist-get auth-info :secret)
+                 auth-passwd (if (functionp auth-passwd)
+                                 (funcall auth-passwd)
+                               auth-passwd))
+            (if (zerop (length passwd))
+                (progn
+                  (should-not (plist-get auth-info :user))
+                  (should-not (plist-get auth-info :host))
+                  (should-not auth-passwd))
+              (should
+               (string-equal (plist-get auth-info :user) (user-login-name)))
+              (should (string-equal (plist-get auth-info :host) host))
+              (should (string-equal auth-passwd passwd)))))
+
+      ;; Cleanup.
+      ;; Should use `auth-source-delete' when implemented for :secrets backend.
+      (secrets-delete-item
+       "session"
+       (format "%s@%s" (plist-get auth-info :user) (plist-get auth-info 
:host))))))
+
+(ert-deftest auth-source-test-netrc-create-secret ()
+  (skip-unless secrets-enabled)
+  (let* ((netrc-file (make-temp-file "auth-source-test"))
+         (auth-sources (list netrc-file))
+         (auth-source-save-behavior t)
+         host auth-info auth-passwd)
+    (unwind-protect
+        (dolist (passwd '("foo" "" nil))
+          ;; Redefine `read-*' in order to avoid interactive input.
+          (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
+                    ((symbol-function 'read-string)
+                     (lambda (_prompt &optional _initial _history default
+                                      _inherit-input-method)
+                       default)))
+            (setq host
+                  (md5 (concat (prin1-to-string process-environment) passwd))
+                  auth-info
+                  (car (auth-source-search
+                        :max 1 :host host :require '(:user :secret) :create t))
+                 auth-passwd (plist-get auth-info :secret)
+                 auth-passwd (if (functionp auth-passwd)
+                                 (funcall auth-passwd)
+                               auth-passwd))
+            (should (string-equal (plist-get auth-info :user) 
(user-login-name)))
+            (should (string-equal (plist-get auth-info :host) host))
+            (should (equal auth-passwd passwd))
+            (when (functionp (plist-get auth-info :save-function))
+              (funcall (plist-get auth-info :save-function)))
+
+            ;; Check, that the item has been created indeed.
+            (auth-source-forget+ :host t)
+            (setq auth-info (car (auth-source-search :host host))
+                 auth-passwd (plist-get auth-info :secret)
+                 auth-passwd (if (functionp auth-passwd)
+                                 (funcall auth-passwd)
+                               auth-passwd))
+            (with-temp-buffer
+              (insert-file-contents netrc-file)
+              (if (zerop (length passwd))
+                  (progn
+                    (should-not (plist-get auth-info :user))
+                    (should-not (plist-get auth-info :host))
+                    (should-not auth-passwd)
+                    (should-not (search-forward host nil 'noerror)))
+                (should
+                 (string-equal (plist-get auth-info :user) (user-login-name)))
+                (should (string-equal (plist-get auth-info :host) host))
+                (should (string-equal auth-passwd passwd))
+                (should (search-forward host nil 'noerror))))))
+
+      ;; Cleanup.
+      (delete-file netrc-file))))
 
 (ert-deftest auth-source-delete ()
   (let* ((netrc-file (make-temp-file "auth-source-test" nil nil "\



reply via email to

[Prev in Thread] Current Thread [Next in Thread]