Function: auth-source-plstore-create

auth-source-plstore-create is a byte-compiled function defined in auth-source.el.gz.

Signature

(auth-source-plstore-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-plstore-create (&rest spec
                                      &key backend host port create user
                                      &allow-other-keys)
  (let* ((base-required '(host user port secret))
         (base-secret '(secret))
         ;; we know (because of an assertion in auth-source-search) that the
         ;; :create parameter is either t, or a list (which includes nil
         ;; or a plist)
         (create-extra-secret (plist-get create :encrypted))
         (create-extra (if (eq t create) nil
                         (or (append (plist-get create :unencrypted)
                                     create-extra-secret)
                             create)))
         (current-data (car (auth-source-search :max 1
                                                :host host
                                                :user user
                                                :port port)))
         (required (append base-required create-extra))
         (required-secret (append base-secret create-extra-secret))
         ;; `valist' is an alist
         valist
         ;; `artificial' will be returned if no creation is needed
         artificial
         secret-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
    (let ((keys (cl-loop for i below (length spec) by 2
                         collect (nth i spec)))
          k)
      (dolist (er create-extra)
        (setq k (auth-source--symbol-keyword er))
        (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)
                           (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
          (if (member r required-secret)
              (setq secret-artificial
                    (plist-put secret-artificial
                               (auth-source--symbol-keyword r)
                               data))
            (setq artificial (plist-put artificial
                                        (auth-source--symbol-keyword r)
                                        data))))))
    (plstore-put (oref backend data)
                 (sha1 (format "%s@%s:%s"
                               (plist-get artificial :user)
                               (plist-get artificial :host)
                               (plist-get artificial :port)))
                 artificial secret-artificial)
    (if (y-or-n-p (format "Save auth info to file %s? "
                          (plstore-get-file (oref backend data))))
        (plstore-save (oref backend data)))))