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.

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index a2ed47a0d45c1a38c3fffb2e227fefdae2046668..df3622a412ab5e26a32c1eb509b2c3b877824410 100644 (file)
--- 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 8070ccf96e200d287f2bf961ce6ee70a46651a20..f7cc011615e56d6f56214fdefbd68b5d96fd74ac 100644 (file)
--- 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 cbb9cd37005cdd818960be3c4fa92aed1e3d62d9..b05f475f2fdeae64d72fe8ca0fd7fe93ca18d87d 100644 (file)
--- 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 b3d5339321b0d66028f66fec34403ec6cfca05d1..199ac4fad24bd3ae059e0a8275afe9ebcf71e80c 100644 (file)
--- 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 5c785b16d89104f9de7e8bdcc7bf515f1270192e..c394f28a561399ab4715962552448239c80d6e68 100644 (file)
--- 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 dc9c7f1004a019840ebc7a0667ac5fb313455223..23512d48ee5a7b1e4e794d6c00a97dbb3c70187a 100644 (file)
--- 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)