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.

6 files changed, 102 insertions, 28 deletions

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index a2ed47a0d45..df3622a412a 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 8070ccf96e2..f7cc011615e 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 cbb9cd37005..b05f475f2fd 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 b3d5339321b..199ac4fad24 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 5c785b16d89..c394f28a561 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 dc9c7f1004a..23512d48ee5 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)