Function: auth-source-netrc-create
auth-source-netrc-create is a byte-compiled function defined in
auth-source.el.gz.
Signature
(auth-source-netrc-create &rest SPEC &key BACKEND HOST PORT CREATE USER &allow-other-keys)
Source Code
;; Defined in /usr/src/emacs/lisp/auth-source.el.gz
;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
(cl-defun auth-source-netrc-create (&rest spec
&key backend host port create user
&allow-other-keys)
(let* ((base-required '(host user port secret))
;; 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))
(file (oref backend source))
(add "")
;; Whether to set save-function.
save-function
;; `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);
;; otherwise take `given-default'
(default (cond
((and (not given-default) (eq r 'user))
(user-login-name))
(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]"))))
(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"))
(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)
;; Special case prompt for passwords.
;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") nil) (t gpg)))
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
(let* ((ep (format "Use GPG password tokens in %s?" file))
(gpg-encrypt
(cond
((eq auth-source-netrc-use-gpg-tokens 'never)
'never)
((listp auth-source-netrc-use-gpg-tokens)
(let ((check (copy-sequence
auth-source-netrc-use-gpg-tokens))
item ret)
(while check
(setq item (pop check))
(when (or (eq (car item) t)
(string-match (car item) file))
(setq ret (cdr item))
(setq check nil)))
ret))
(t 'never)))
(plain
(or (eval default)
(read-passwd (format-prompt prompt nil)))))
;; ask if we don't know what to do (in which case
;; auth-source-netrc-use-gpg-tokens must be a list)
(unless gpg-encrypt
(setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never))
;; TODO: save the defcustom now? or ask?
(setq auth-source-netrc-use-gpg-tokens
(cons `(,file ,gpg-encrypt)
auth-source-netrc-use-gpg-tokens)))
(if (eq gpg-encrypt 'gpg)
(auth-source-epa-make-gpg-token plain file)
plain))
(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)))
(when (eq r 'secret)
(setq save-function
(not (and (string-match-p "\"" data)
(string-match-p "'" data)))))
;; this function is not strictly necessary but I think it
;; makes the code clearer -tzz
(let ((printer (lambda ()
;; append the key (the symbol name of r)
;; and the value in r
(format "%s%s %s"
;; prepend a space
(if (zerop (length add)) "" " ")
;; remap auth-source tokens to netrc
(cl-case r
(user "login")
(host "machine")
(secret "password")
(port "port") ; redundant but clearer
(t (symbol-name r)))
(cond
((string-match-p "\"" data)
(format "'%s'" data))
((string-match-p "['# ]" data)
(format "%S" data))
(t data))))))
(setq add (concat add (funcall printer)))))))
(when save-function
(plist-put
artificial
:save-function
(let ((file file)
(add add))
(lambda () (auth-source-netrc-saver file add)))))
(list artificial)))