Fix Bug#30246
* lisp/auth-source.el (auth-source-secrets-search): Do not suppress creation. (auth-source-secrets-create): Implement it. (Bug#30246) * lisp/net/secrets.el (secrets-debug): Set default to nil. * test/lisp/auth-source-tests.el (secrets): Require it. (auth-source-test-secrets-create-secret): New test.
This commit is contained in:
Michael Albinus
parent
9822a6a570
commit
1f31c1348c
3 changed files with 192 additions and 11 deletions
|
|
@ -1514,9 +1514,6 @@ authentication tokens:
|
|||
"
|
||||
|
||||
;; TODO
|
||||
(cl-assert (not create) nil
|
||||
"The Secrets API auth-source backend doesn't support creation yet")
|
||||
;; TODO
|
||||
;; (secrets-delete-item coll elt)
|
||||
(cl-assert (not delete) nil
|
||||
"The Secrets API auth-source backend doesn't support deletion yet")
|
||||
|
|
@ -1576,12 +1573,168 @@ authentication tokens:
|
|||
returned-keys))
|
||||
plist))
|
||||
items)))
|
||||
(cond
|
||||
;; if we need to create an entry AND none were found to match
|
||||
((and create
|
||||
(not items))
|
||||
|
||||
;; create based on the spec and record the value
|
||||
(setq items (or
|
||||
;; if the user did not want to create the entry
|
||||
;; in the file, it will be returned
|
||||
(apply (slot-value backend 'create-function) spec)
|
||||
;; if not, we do the search again without :create
|
||||
;; to get the updated data.
|
||||
|
||||
;; the result will be returned, even if the search fails
|
||||
(apply #'auth-source-secrets-search
|
||||
(plist-put spec :create nil))))))
|
||||
items))
|
||||
|
||||
(defun auth-source-secrets-create (&rest spec)
|
||||
;; TODO
|
||||
;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
|
||||
(debug spec))
|
||||
(cl-defun auth-source-secrets-create (&rest spec
|
||||
&key backend host port create
|
||||
&allow-other-keys)
|
||||
(let* ((base-required '(host user port secret label))
|
||||
;; we know (because of an assertion in auth-source-search) that the
|
||||
;; :create parameter is either t or a list (which includes nil)
|
||||
(create-extra (if (eq t create) nil create))
|
||||
(current-data (car (auth-source-search :max 1
|
||||
:host host
|
||||
:port port)))
|
||||
(required (append base-required create-extra))
|
||||
(collection (oref backend source))
|
||||
;; `args' are the arguments for `secrets-create-item'.
|
||||
args
|
||||
;; `valist' is an alist
|
||||
valist
|
||||
;; `artificial' will be returned if no creation is needed
|
||||
artificial)
|
||||
|
||||
;; only for base required elements (defined as function parameters):
|
||||
;; fill in the valist with whatever data we may have from the search
|
||||
;; we complete the first value if it's a list and use the value otherwise
|
||||
(dolist (br base-required)
|
||||
(let ((val (plist-get spec (auth-source--symbol-keyword br))))
|
||||
(when val
|
||||
(let ((br-choice (cond
|
||||
;; all-accepting choice (predicate is t)
|
||||
((eq t val) nil)
|
||||
;; just the value otherwise
|
||||
(t val))))
|
||||
(when br-choice
|
||||
(auth-source--aput valist br br-choice))))))
|
||||
|
||||
;; for extra required elements, see if the spec includes a value for them
|
||||
(dolist (er create-extra)
|
||||
(let ((k (auth-source--symbol-keyword er))
|
||||
(keys (cl-loop for i below (length spec) by 2
|
||||
collect (nth i spec))))
|
||||
(when (memq k keys)
|
||||
(auth-source--aput valist er (plist-get spec k)))))
|
||||
|
||||
;; for each required element
|
||||
(dolist (r required)
|
||||
(let* ((data (auth-source--aget valist r))
|
||||
;; take the first element if the data is a list
|
||||
(data (or (auth-source-netrc-element-or-first data)
|
||||
(plist-get current-data
|
||||
(auth-source--symbol-keyword r))))
|
||||
;; this is the default to be offered
|
||||
(given-default (auth-source--aget
|
||||
auth-source-creation-defaults r))
|
||||
;; the default supplementals are simple:
|
||||
;; for the user, try `given-default' and then (user-login-name);
|
||||
;; for the label, try `given-default' and then user@host;
|
||||
;; otherwise take `given-default'
|
||||
(default (cond
|
||||
((and (not given-default) (eq r 'user))
|
||||
(user-login-name))
|
||||
((and (not given-default) (eq r 'label))
|
||||
(format "%s@%s"
|
||||
(or (auth-source-netrc-element-or-first
|
||||
(auth-source--aget valist 'user))
|
||||
(plist-get artificial :user))
|
||||
(or (auth-source-netrc-element-or-first
|
||||
(auth-source--aget valist 'host))
|
||||
(plist-get artificial :host))))
|
||||
(t given-default)))
|
||||
(printable-defaults (list
|
||||
(cons 'user
|
||||
(or
|
||||
(auth-source-netrc-element-or-first
|
||||
(auth-source--aget valist 'user))
|
||||
(plist-get artificial :user)
|
||||
"[any user]"))
|
||||
(cons 'host
|
||||
(or
|
||||
(auth-source-netrc-element-or-first
|
||||
(auth-source--aget valist 'host))
|
||||
(plist-get artificial :host)
|
||||
"[any host]"))
|
||||
(cons 'port
|
||||
(or
|
||||
(auth-source-netrc-element-or-first
|
||||
(auth-source--aget valist 'port))
|
||||
(plist-get artificial :port)
|
||||
"[any port]"))
|
||||
(cons 'label
|
||||
(or
|
||||
(auth-source-netrc-element-or-first
|
||||
(auth-source--aget valist 'label))
|
||||
(plist-get artificial :label)
|
||||
"[any label]"))))
|
||||
(prompt (or (auth-source--aget auth-source-creation-prompts r)
|
||||
(cl-case r
|
||||
(secret "%p password for %u@%h: ")
|
||||
(user "%p user name for %h: ")
|
||||
(host "%p host name for user %u: ")
|
||||
(port "%p port for %u@%h: ")
|
||||
(label "Enter label for %u@%h: "))
|
||||
(format "Enter %s (%%u@%%h:%%p): " r)))
|
||||
(prompt (auth-source-format-prompt
|
||||
prompt
|
||||
`((?u ,(auth-source--aget printable-defaults 'user))
|
||||
(?h ,(auth-source--aget printable-defaults 'host))
|
||||
(?p ,(auth-source--aget printable-defaults 'port))))))
|
||||
|
||||
;; Store the data, prompting for the password if needed.
|
||||
(setq data (or data
|
||||
(if (eq r 'secret)
|
||||
(or (eval default) (read-passwd prompt))
|
||||
(if (stringp default)
|
||||
(read-string (if (string-match ": *\\'" prompt)
|
||||
(concat (substring prompt 0 (match-beginning 0))
|
||||
" (default " default "): ")
|
||||
(concat prompt "(default " default ") "))
|
||||
nil nil default)
|
||||
(eval default)))))
|
||||
|
||||
(when data
|
||||
(setq artificial (plist-put artificial
|
||||
(auth-source--symbol-keyword r)
|
||||
(if (eq r 'secret)
|
||||
(let ((data data))
|
||||
(lambda () data))
|
||||
data))))
|
||||
|
||||
;; 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 () (apply 'secrets-create-item collection item secret args))))
|
||||
|
||||
(list artificial)))
|
||||
|
||||
;;; Backend specific parsing: Mac OS Keychain (using /usr/bin/security) backend
|
||||
|
||||
|
|
|
|||
|
|
@ -158,7 +158,7 @@
|
|||
(defvar secrets-enabled nil
|
||||
"Whether there is a daemon offering the Secret Service API.")
|
||||
|
||||
(defvar secrets-debug t
|
||||
(defvar secrets-debug nil
|
||||
"Write debug messages")
|
||||
|
||||
(defconst secrets-service "org.freedesktop.secrets"
|
||||
|
|
|
|||
|
|
@ -29,9 +29,7 @@
|
|||
(require 'ert)
|
||||
(require 'cl-lib)
|
||||
(require 'auth-source)
|
||||
|
||||
(defvar secrets-enabled t
|
||||
"Enable the secrets backend to test its features.")
|
||||
(require 'secrets)
|
||||
|
||||
(defun auth-source-ensure-ignored-backend (source)
|
||||
(auth-source-validate-backend source '((:source . "")
|
||||
|
|
@ -289,5 +287,35 @@
|
|||
(should (equal found-as-string (concat testname ": " needed)))))
|
||||
(delete-file netrc-file)))
|
||||
|
||||
(ert-deftest auth-source-test-secrets-create-secret ()
|
||||
(skip-unless secrets-enabled)
|
||||
;; The "session" collection is temporary for the lifetime of the
|
||||
;; Emacs process. Therefore, we don't care to delete it.
|
||||
(let ((auth-sources '((:source (:secrets "session"))))
|
||||
(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 _initial _history default) 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 auth-passwd passwd))))
|
||||
|
||||
(provide 'auth-source-tests)
|
||||
;;; auth-source-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue