[Emacs-diffs] master 0ecc10a 2/2: Let Tramp save passwords

[Michael Albinus]

branch: master
commit 0ecc10a7771bf1f62d15b2e6c747bee9f7a557ff
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Let Tramp save passwords
    
    * lisp/auth-source.el (auth-source-secrets-saver): New defun.
    (auth-source-secrets-create): Use it.
    
    * lisp/net/secrets.el (secrets-struct-secret-content-type):
    (secrets-create-item): Do not hard-code :xdg:schema.
    
    * lisp/net/tramp.el (tramp-password-save-function): New defvar.
    (tramp-read-passwd): Set it properly.
    (tramp-process-actions):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
    Save password.
    
    * lisp/net/tramp-cmds.el (tramp-bug): Don't report
    `tramp-password-save-function'.
    
    * test/lisp/net/secrets-tests.el (secrets-test03-items):
    Extend test with another :xdg:schema.
---
 lisp/auth-source.el            | 37 ++++++++++++++++++++++++++++++-
 lisp/net/secrets.el            | 21 +++++++++++++-----
 lisp/net/tramp-cmds.el         |  4 +++-
 lisp/net/tramp-gvfs.el         |  3 +++
 lisp/net/tramp.el              | 50 ++++++++++++++++++++++++++++--------------
 test/lisp/net/secrets-tests.el | 15 ++++++++++---
 6 files changed, 102 insertions(+), 28 deletions(-)

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index a2ed47a..df3622a 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1732,10 +1732,45 @@ authentication tokens:
             (item (plist-get artificial :label))
             (secret (plist-get artificial :secret))
             (secret (if (functionp secret) (funcall secret) secret)))
-       (lambda () (apply 'secrets-create-item collection item secret args))))
+       (lambda ()
+        (apply 'auth-source-secrets-saver collection item secret args))))
 
     (list artificial)))
 
+(defun auth-source-secrets-saver (collection item secret args)
+  "Wrapper around `secrets-create-item', prompting along the way.
+Respects `auth-source-save-behavior'."
+  (let ((prompt (format "Save auth info to secrets collection %s? " 
collection))
+        (done (not (eq auth-source-save-behavior 'ask)))
+        (bufname "*auth-source Help*")
+        doit k)
+    (while (not done)
+      (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ??)))
+      (cl-case k
+        (?y (setq done t doit t))
+        (?? (save-excursion
+              (with-output-to-temp-buffer bufname
+                (princ
+                 (concat "(y)es, save\n"
+                         "(n)o but use the info\n"
+                         "(N)o and don't ask to save again\n"
+                         "(?) for help as you can see.\n"))
+                ;; Why?  Doesn't with-output-to-temp-buffer already do
+                ;; the exact same thing anyway?  --Stef
+                (set-buffer standard-output)
+                (help-mode))))
+        (?n (setq done t doit nil))
+        (?N (setq done t doit nil)
+            (customize-save-variable 'auth-source-save-behavior nil))
+        (t nil)))
+
+    (when doit
+      (progn
+        (auth-source-do-debug
+         "secrets-create-item: wrote 1 new item to %s" collection)
+        (message "Saved new authentication information to %s" collection)
+       (apply 'secrets-create-item collection item secret args)))))
+
 ;;; Backend specific parsing: Mac OS Keychain (using /usr/bin/security) backend
 
 (cl-defun auth-source-macos-keychain-search (&rest spec
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index 8070ccf..f7cc011 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -331,9 +331,7 @@ It returns t if not."
             ;; Properties.
             `(:array
               (:dict-entry ,(concat secrets-interface-item ".Label")
-                           (:variant "dummy"))
-              (:dict-entry ,(concat secrets-interface-item ".Type")
-                           (:variant ,secrets-interface-item-type-generic)))
+                           (:variant " ")))
             ;; Secret.
             `(:struct :object-path ,path
                       (:array :signature "y")
@@ -649,11 +647,24 @@ keys are keyword symbols, starting with a colon.  Example:
   (secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
    :method \"sudo\" :user \"joe\" :host \"remote-host\")
 
+The key `:xdg:schema' determines the scope of the item to be
+generated, i.e. for which applications the item is intended for.
+This is just a string like \"org.freedesktop.NetworkManager.Mobile\"
+or \"org.gnome.OnlineAccounts\", the other required keys are
+determined by this.  If no `:xdg:schema' is given,
+\"org.freedesktop.Secret.Generic\" is used by default.
+
 The object path of the created item is returned."
   (unless (member item (secrets-list-items collection))
     (let ((collection-path (secrets-unlock-collection collection))
          result props)
       (unless (secrets-empty-path collection-path)
+        ;; Set default type if needed.
+        (unless (member :xdg:schema attributes)
+          (setq attributes
+                (append
+                 attributes
+                 `(:xdg:schema ,secrets-interface-item-type-generic))))
        ;; Create attributes list.
        (while (consp (cdr attributes))
          (unless (keywordp (car attributes))
@@ -675,9 +686,7 @@ The object path of the created item is returned."
               (append
                `(:array
                  (:dict-entry ,(concat secrets-interface-item ".Label")
-                              (:variant ,item))
-                 (:dict-entry ,(concat secrets-interface-item ".Type")
-                              (:variant ,secrets-interface-item-type-generic)))
+                              (:variant ,item)))
                (when props
                  `((:dict-entry ,(concat secrets-interface-item ".Attributes")
                                 (:variant ,(append '(:array) props))))))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index cbb9cd3..b05f475 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -181,7 +181,9 @@ This includes password cache, file cache, connection cache, 
buffers."
   "Submit a bug report to the Tramp developers."
   (interactive)
   (catch 'dont-send
-    (let ((reporter-prompt-for-summary-p t))
+    (let ((reporter-prompt-for-summary-p t)
+         ;; In rare cases, it could contain the password.  So we make it nil.
+         tramp-password-save-function)
       (reporter-submit-bug-report
        tramp-bug-report-address                ; to-address
        (format "tramp (%s)" tramp-version) ; package name and version
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index b3d5339..199ac4f 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -2041,6 +2041,9 @@ connection if a previous connection has died for some 
reason."
               (tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
          (tramp-error vec 'file-error "FUSE mount denied"))
 
+       ;; Save the password.
+       (ignore-errors (funcall tramp-password-save-function))
+
        ;; Set connection-local variables.
        (tramp-set-connection-local-variables vec)
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5c785b1..c394f28 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1192,6 +1192,11 @@ means to use always cached values for the directory 
contents."
 (defvar tramp-current-connection nil
   "Last connection timestamp.")
 
+(defvar tramp-password-save-function nil
+  "Password save function.
+Will be called once the password has been verified by successful
+authentication.")
+
 (defconst tramp-completion-file-name-handler-alist
   '((file-name-all-completions
      . tramp-completion-handle-file-name-all-completions)
@@ -3852,7 +3857,9 @@ connection buffer."
        (with-current-buffer (tramp-get-connection-buffer vec)
          (widen)
          (tramp-message vec 6 "\n%s" (buffer-string)))
-       (unless (eq exit 'ok)
+       (if (eq exit 'ok)
+           (ignore-errors (funcall tramp-password-save-function))
+         ;; Not successful.
          (tramp-clear-passwd vec)
          (delete-process proc)
          (tramp-error-with-buffer
@@ -4458,12 +4465,14 @@ Invokes `password-read' if available, `read-passwd' 
else."
              (with-current-buffer (process-buffer proc)
                (tramp-check-for-regexp proc tramp-password-prompt-regexp)
                (format "%s for %s " (capitalize (match-string 1)) key))))
+        (auth-source-creation-prompts `((secret . ,pw-prompt)))
         ;; We suspend the timers while reading the password.
          (stimers (with-timeout-suspend))
         auth-info auth-passwd)
 
     (unwind-protect
        (with-parsed-tramp-file-name key nil
+         (setq tramp-password-save-function nil)
          (setq user
                (or user (tramp-get-connection-property key "login-as" nil)))
          (prog1
@@ -4474,31 +4483,38 @@ Invokes `password-read' if available, `read-passwd' 
else."
                       v "first-password-request" nil)
                      ;; Try with Tramp's current method.
                      (setq auth-info
-                           (auth-source-search
-                            :max 1
-                            (and user :user)
-                            (if domain
-                                (concat user tramp-prefix-domain-format domain)
-                              user)
-                            :host
-                            (if port
-                                (concat host tramp-prefix-port-format port)
-                              host)
-                            :port method
-                            :require (cons :secret (and user '(:user))))
-                           auth-passwd (plist-get
-                                        (nth 0 auth-info) :secret)
+                           (car
+                            (auth-source-search
+                             :max 1
+                             (and user :user)
+                             (if domain
+                                 (concat
+                                  user tramp-prefix-domain-format domain)
+                               user)
+                             :host
+                             (if port
+                                 (concat
+                                  host tramp-prefix-port-format port)
+                               host)
+                             :port method
+                             :require (cons :secret (and user '(:user)))
+                             :create t))
+                           tramp-password-save-function
+                           (plist-get auth-info :save-function)
+                           auth-passwd (plist-get auth-info :secret)
                            auth-passwd (if (functionp auth-passwd)
                                            (funcall auth-passwd)
                                          auth-passwd))))
+
               ;; Try the password cache.
               (let ((password (password-read pw-prompt key)))
-                ;; FIXME test password works before caching it.
-                (password-cache-add key password)
+                (setq tramp-password-save-function
+                      (lambda () (password-cache-add key password)))
                 password)
               ;; Else, get the password interactively.
               (read-passwd pw-prompt))
            (tramp-set-connection-property v "first-password-request" nil)))
+
       ;; Reenable the timers.
       (with-timeout-unsuspend stimers))))
 
diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el
index dc9c7f1..23512d4 100644
--- a/test/lisp/net/secrets-tests.el
+++ b/test/lisp/net/secrets-tests.el
@@ -169,9 +169,16 @@
        (should
         (equal
          (secrets-get-attributes "session" "bar")
-         '((:host . "remote-host") (:user . "joe")
-           (:method . "sudo")
-           (:xdg:schema . "org.freedesktop.Secret.Generic"))))
+         '((:xdg:schema . "org.freedesktop.Secret.Generic")
+            (:host . "remote-host") (:user . "joe") (:method . "sudo"))))
+
+       ;; Create an item with another schema.
+       (secrets-create-item
+         "session" "baz" "secret" :xdg:schema "org.gnu.Emacs.foo")
+       (should
+        (equal
+         (secrets-get-attributes "session" "baz")
+         '((:xdg:schema . "org.gnu.Emacs.foo"))))
 
        ;; Delete them.
        (dolist (item (secrets-list-items "session"))
@@ -206,6 +213,8 @@
 
        ;; Search the items.
        (should-not (secrets-search-items "session" :user "john"))
+       (should-not
+         (secrets-search-items "session" :xdg:schema "org.gnu.Emacs.foo"))
        (should
         (equal
          (sort (secrets-search-items "session" :user "joe") 'string-lessp)