Function: auth-source-secrets-create
auth-source-secrets-create is a byte-compiled function defined in
auth-source.el.gz.
Signature
(auth-source-secrets-create &rest SPEC &key BACKEND HOST PORT CREATE USER &allow-other-keys)
Source Code
;; Defined in /usr/src/emacs/lisp/auth-source.el.gz
(cl-defun auth-source-secrets-create (&rest spec
&key backend host port create user
&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
:user user
: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
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 (auth-source-keys 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 (format-prompt prompt nil)))
(if (and (stringp default) auth-source-save-behavior)
(read-string
(format-prompt prompt 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)))
(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 (auth-info-password artificial)))
(lambda ()
(auth-source-secrets-saver collection item secret args)))))
(list artificial)))