auth-source.el 75.6 KB
Newer Older
Miles Bader's avatar
Miles Bader committed
1 2
;;; auth-source.el --- authentication sources for Gnus and Emacs

3
;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
Miles Bader's avatar
Miles Bader committed
4 5 6 7 8 9

;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Miles Bader's avatar
Miles Bader committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Miles Bader's avatar
Miles Bader committed
14 15 16

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Miles Bader's avatar
Miles Bader committed
18 19 20
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Miles Bader's avatar
Miles Bader committed
22 23 24 25 26 27 28

;;; Commentary:

;; This is the auth-source.el package.  It lets users tell Gnus how to
;; authenticate in a single place.  Simplicity is the goal.  Instead
;; of providing 5000 options, we'll stick to simple, easy to
;; understand options.
Miles Bader's avatar
Miles Bader committed
29

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
30
;; See the auth.info Info documentation for details.
Miles Bader's avatar
Miles Bader committed
31

32 33 34 35 36 37 38 39
;; TODO:

;; - never decode the backend file unless it's necessary
;; - a more generic way to match backends and search backend contents
;; - absorb netrc.el and simplify it
;; - protect passwords better
;; - allow creating and changing netrc lines (not files) e.g. change a password

Miles Bader's avatar
Miles Bader committed
40 41
;;; Code:

42
(require 'password-cache)
43
(require 'mm-util)
Miles Bader's avatar
Miles Bader committed
44
(require 'gnus-util)
45
(require 'assoc)
Miles Bader's avatar
Miles Bader committed
46
(eval-when-compile (require 'cl))
47
(require 'eieio)
48

49 50
(autoload 'secrets-create-item "secrets")
(autoload 'secrets-delete-item "secrets")
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
51
(autoload 'secrets-get-alias "secrets")
52
(autoload 'secrets-get-attributes "secrets")
53
(autoload 'secrets-get-secret "secrets")
54 55
(autoload 'secrets-list-collections "secrets")
(autoload 'secrets-search-items "secrets")
Miles Bader's avatar
Miles Bader committed
56

57 58
(autoload 'rfc2104-hash "rfc2104")

59 60 61 62
(autoload 'plstore-open "plstore")
(autoload 'plstore-find "plstore")
(autoload 'plstore-put "plstore")
(autoload 'plstore-save "plstore")
63
(autoload 'plstore-get-file "plstore")
64

65 66
(defvar secrets-enabled)

Miles Bader's avatar
Miles Bader committed
67 68
(defgroup auth-source nil
  "Authentication sources."
Miles Bader's avatar
Miles Bader committed
69
  :version "23.1" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
70 71
  :group 'gnus)

72 73 74 75 76 77 78 79 80 81 82 83
;;;###autoload
(defcustom auth-source-cache-expiry 7200
  "How many seconds passwords are cached, or nil to disable
expiring.  Overrides `password-cache-expiry' through a
let-binding."
  :group 'auth-source
  :type '(choice (const :tag "Never" nil)
                 (const :tag "All Day" 86400)
                 (const :tag "2 Hours" 7200)
                 (const :tag "30 Minutes" 1800)
                 (integer :tag "Seconds")))

84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
(defclass auth-source-backend ()
  ((type :initarg :type
         :initform 'netrc
         :type symbol
         :custom symbol
         :documentation "The backend type.")
   (source :initarg :source
           :type string
           :custom string
           :documentation "The backend source.")
   (host :initarg :host
         :initform t
         :type t
         :custom string
         :documentation "The backend host.")
   (user :initarg :user
         :initform t
         :type t
         :custom string
         :documentation "The backend user.")
104 105 106 107 108
   (port :initarg :port
         :initform t
         :type t
         :custom string
         :documentation "The backend protocol.")
109 110 111
   (arg :initarg :arg
	:initform nil
	:documentation "The backend arg.")
112 113 114 115 116 117 118 119 120 121 122
   (create-function :initarg :create-function
                    :initform ignore
                    :type function
                    :custom function
                    :documentation "The create function.")
   (search-function :initarg :search-function
                    :initform ignore
                    :type function
                    :custom function
                    :documentation "The search function.")))

Miles Bader's avatar
Miles Bader committed
123
(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
124 125 126 127
                                   (pop3 "pop3" "pop" "pop3s" "110" "995")
                                   (ssh  "ssh" "22")
                                   (sftp "sftp" "115")
                                   (smtp "smtp" "25"))
Miles Bader's avatar
Miles Bader committed
128 129 130
  "List of authentication protocols and their names"

  :group 'auth-source
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
131
  :version "23.2" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
132
  :type '(repeat :tag "Authentication Protocols"
133 134 135 136
                 (cons :tag "Protocol Entry"
                       (symbol :tag "Protocol")
                       (repeat :tag "Names"
                               (string :tag "Name")))))
Miles Bader's avatar
Miles Bader committed
137 138

;;; generate all the protocols in a format Customize can use
139
;;; TODO: generate on the fly from auth-source-protocols
Miles Bader's avatar
Miles Bader committed
140 141
(defconst auth-source-protocols-customize
  (mapcar (lambda (a)
142 143 144 145 146
            (let ((p (car-safe a)))
              (list 'const
                    :tag (upcase (symbol-name p))
                    p)))
          auth-source-protocols))
Miles Bader's avatar
Miles Bader committed
147

148 149 150
(defvar auth-source-creation-defaults nil
  "Defaults for creating token values.  Usually let-bound.")

151 152 153
(defvar auth-source-creation-prompts nil
  "Default prompts for token values.  Usually let-bound.")

154 155
(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")

156 157 158 159 160 161 162 163 164 165
(defcustom auth-source-save-behavior 'ask
  "If set, auth-source will respect it for save behavior."
  :group 'auth-source
  :version "23.2" ;; No Gnus
  :type `(choice
          :tag "auth-source new token save behavior"
          (const :tag "Always save" t)
          (const :tag "Never save" nil)
          (const :tag "Ask" ask)))

166 167 168 169 170 171
;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)

(defcustom auth-source-netrc-use-gpg-tokens 'never
  "Set this to tell auth-source when to create GPG password
tokens in netrc files.  It's either an alist or `never'."
172 173 174
  :group 'auth-source
  :version "23.2" ;; No Gnus
  :type `(choice
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
          (const :tag "Always use GPG password tokens" (t gpg))
          (const :tag "Never use GPG password tokens" never)
          (repeat :tag "Use a lookup list"
                  (list
                   (choice :tag "Matcher"
                           (const :tag "Match anything" t)
                           (const :tag "The EPA encrypted file extensions"
                                  ,(if (boundp 'epa-file-auto-mode-alist-entry)
                                       (car (symbol-value
                                             'epa-file-auto-mode-alist-entry))
                                     "\\.gpg\\'"))
                           (regexp :tag "Regular expression"))
                   (choice :tag "What to do"
                           (const :tag "Save GPG-encrypted password tokens" gpg)
                           (const :tag "Don't encrypt tokens" never))))))
190

191
(defvar auth-source-magic "auth-source-magic ")
Miles Bader's avatar
Miles Bader committed
192 193

(defcustom auth-source-do-cache t
194
  "Whether auth-source should cache information with `password-cache'."
Miles Bader's avatar
Miles Bader committed
195
  :group 'auth-source
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
196
  :version "23.2" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
197 198
  :type `boolean)

199
(defcustom auth-source-debug nil
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
200 201 202
  "Whether auth-source should log debug messages.

If the value is nil, debug messages are not logged.
203 204 205 206 207

If the value is t, debug messages are logged with `message'.  In
that case, your authentication data will be in the clear (except
for passwords).

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
208 209 210
If the value is a function, debug messages are logged by calling
 that function using the same arguments as `message'."
  :group 'auth-source
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
211
  :version "23.2" ;; No Gnus
212 213 214
  :type `(choice
          :tag "auth-source debugging mode"
          (const :tag "Log using `message' to the *Messages* buffer" t)
215 216
          (const :tag "Log all trivia with `message' to the *Messages* buffer"
                 trivia)
217 218
          (function :tag "Function that takes arguments like `message'")
          (const :tag "Don't log anything" nil)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
219

220
(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
Miles Bader's avatar
Miles Bader committed
221 222
  "List of authentication sources.

223 224 225
The default will get login and password information from
\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
packages to be encrypted.  If that file doesn't exist, it will
226 227
try the unencrypted version \"~/.authinfo\" and the famous
\"~/.netrc\" file.
228 229

See the auth.info manual for details.
230

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
231 232 233 234
Each entry is the authentication type with optional properties.

It's best to customize this with `M-x customize-variable' because the choices
can get pretty complex."
Miles Bader's avatar
Miles Bader committed
235
  :group 'auth-source
236
  :version "24.1" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
237
  :type `(repeat :tag "Authentication Sources"
238 239 240
                 (choice
                  (string :tag "Just a file")
                  (const :tag "Default Secrets API Collection" 'default)
241
                  (const :tag "Login Secrets API Collection" "secrets:Login")
242 243 244 245 246 247 248 249 250 251 252
                  (const :tag "Temp Secrets API Collection" "secrets:session")
                  (list :tag "Source definition"
                        (const :format "" :value :source)
                        (choice :tag "Authentication backend choice"
                                (string :tag "Authentication Source (file)")
                                (list
                                 :tag "Secret Service API/KWallet/GNOME Keyring"
                                 (const :format "" :value :secrets)
                                 (choice :tag "Collection to use"
                                         (string :tag "Collection name")
                                         (const :tag "Default" 'default)
253
                                         (const :tag "Login" "Login")
254 255 256 257 258 259 260 261 262 263 264 265 266
                                         (const
                                          :tag "Temporary" "session"))))
                        (repeat :tag "Extra Parameters" :inline t
                                (choice :tag "Extra parameter"
                                        (list
                                         :tag "Host"
                                         (const :format "" :value :host)
                                         (choice :tag "Host (machine) choice"
                                                 (const :tag "Any" t)
                                                 (regexp
                                                  :tag "Regular expression")))
                                        (list
                                         :tag "Protocol"
267
                                         (const :format "" :value :port)
268 269 270 271 272 273
                                         (choice
                                          :tag "Protocol"
                                          (const :tag "Any" t)
                                          ,@auth-source-protocols-customize))
                                        (list :tag "User" :inline t
                                              (const :format "" :value :user)
274 275
                                              (choice
                                               :tag "Personality/Username"
276
                                                      (const :tag "Any" t)
277 278
                                                      (string
                                                       :tag "Name")))))))))
Miles Bader's avatar
Miles Bader committed
279

280 281 282 283
(defcustom auth-source-gpg-encrypt-to t
  "List of recipient keys that `authinfo.gpg' encrypted to.
If the value is not a list, symmetric encryption will be used."
  :group 'auth-source
284
  :version "24.1" ;; No Gnus
285
  :type '(choice (const :tag "Symmetric encryption" t)
286 287
                 (repeat :tag "Recipient public keys"
                         (string :tag "Recipient public key"))))
288

Miles Bader's avatar
Miles Bader committed
289
;; temp for debugging
Miles Bader's avatar
Miles Bader committed
290 291 292 293 294 295 296 297
;; (unintern 'auth-source-protocols)
;; (unintern 'auth-sources)
;; (customize-variable 'auth-sources)
;; (setq auth-sources nil)
;; (format "%S" auth-sources)
;; (customize-variable 'auth-source-protocols)
;; (setq auth-source-protocols nil)
;; (format "%S" auth-source-protocols)
298
;; (auth-source-pick nil :host "a" :port 'imap)
Miles Bader's avatar
Miles Bader committed
299 300 301 302 303 304
;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
;; (auth-source-protocol-defaults 'imap)

305 306 307
;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
308 309
(defun auth-source-do-debug (&rest msg)
  (when auth-source-debug
310 311
    (apply 'auth-source-do-warn msg)))

312 313 314 315 316
(defun auth-source-do-trivia (&rest msg)
  (when (or (eq auth-source-debug 'trivia)
            (functionp auth-source-debug))
    (apply 'auth-source-do-warn msg)))

317 318 319 320 321 322 323 324 325
(defun auth-source-do-warn (&rest msg)
  (apply
    ;; set logger to either the function in auth-source-debug or 'message
    ;; note that it will be 'message if auth-source-debug is nil
   (if (functionp auth-source-debug)
       auth-source-debug
     'message)
   msg))

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
326

327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348
;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
(defun auth-source-read-char-choice (prompt choices)
  "Read one of CHOICES by `read-char-choice', or `read-char'.
`dropdown-list' support is disabled because it doesn't work reliably.
Only one of CHOICES will be returned.  The PROMPT is augmented
with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
  (when choices
    (let* ((prompt-choices
            (apply 'concat (loop for c in choices
                                 collect (format "%c/" c))))
           (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
           (full-prompt (concat prompt prompt-choices))
           k)

      (while (not (memq k choices))
        (setq k (cond
                 ((fboundp 'read-char-choice)
                  (read-char-choice full-prompt choices))
                 (t (message "%s" full-prompt)
                    (setq k (read-char))))))
      k)))

349 350 351 352 353 354
;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
;; (auth-source-pick t :host "any" :port 'imap :user "joe")
;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
;;                   (:source (:secrets "session") :host t :port t :user "joe")
;;                   (:source (:secrets "Login") :host t :port t)
;;                   (:source "~/.authinfo.gpg" :host t :port t)))
355

356 357 358
;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
;;                   (:source (:secrets "session") :host t :port t :user "joe")
;;                   (:source (:secrets "Login") :host t :port t)
359
;;                   ))
360

361
;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
362

363 364
;; (auth-source-backend-parse "myfile.gpg")
;; (auth-source-backend-parse 'default)
365
;; (auth-source-backend-parse "secrets:Login")
366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386

(defun auth-source-backend-parse (entry)
  "Creates an auth-source-backend from an ENTRY in `auth-sources'."
  (auth-source-backend-parse-parameters
   entry
   (cond
    ;; take 'default and recurse to get it as a Secrets API default collection
    ;; matching any user, host, and protocol
    ((eq entry 'default)
     (auth-source-backend-parse '(:source (:secrets default))))
    ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
    ;; matching any user, host, and protocol
    ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
     (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
    ;; take just a file name and recurse to get it as a netrc file
    ;; matching any user, host, and protocol
    ((stringp entry)
     (auth-source-backend-parse `(:source ,entry)))

    ;; a file name with parameters
    ((stringp (plist-get entry :source))
387 388 389 390 391 392 393 394 395 396 397 398 399 400
     (if (equal (file-name-extension (plist-get entry :source)) "plist")
	 (auth-source-backend
	  (plist-get entry :source)
	  :source (plist-get entry :source)
	  :type 'plstore
	  :search-function 'auth-source-plstore-search
	  :create-function 'auth-source-plstore-create
	  :arg (plstore-open (plist-get entry :source)))
       (auth-source-backend
	(plist-get entry :source)
	:source (plist-get entry :source)
	:type 'netrc
	:search-function 'auth-source-netrc-search
	:create-function 'auth-source-netrc-create)))
401 402 403 404 405 406 407 408 409 410 411 412 413 414 415

    ;; the Secrets API.  We require the package, in order to have a
    ;; defined value for `secrets-enabled'.
    ((and
      (not (null (plist-get entry :source))) ; the source must not be nil
      (listp (plist-get entry :source))      ; and it must be a list
      (require 'secrets nil t)               ; and we must load the Secrets API
      secrets-enabled)                       ; and that API must be enabled

     ;; the source is either the :secrets key in ENTRY or
     ;; if that's missing or nil, it's "session"
     (let ((source (or (plist-get (plist-get entry :source) :secrets)
                       "session")))

       ;; if the source is a symbol, we look for the alias named so,
416
       ;; and if that alias is missing, we use "Login"
417 418
       (when (symbolp source)
         (setq source (or (secrets-get-alias (symbol-name source))
419
                          "Login")))
420

421 422 423 424 425 426 427 428 429 430 431 432 433
       (if (featurep 'secrets)
           (auth-source-backend
            (format "Secrets API (%s)" source)
            :source source
            :type 'secrets
            :search-function 'auth-source-secrets-search
            :create-function 'auth-source-secrets-create)
         (auth-source-do-warn
          "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
         (auth-source-backend
          (format "Ignored Secrets API (%s)" source)
          :source ""
          :type 'ignore))))
434 435 436

    ;; none of them
    (t
437
     (auth-source-do-warn
438 439 440 441 442 443 444 445
      "auth-source-backend-parse: invalid backend spec: %S" entry)
     (auth-source-backend
      "Empty"
      :source ""
      :type 'ignore)))))

(defun auth-source-backend-parse-parameters (entry backend)
  "Fills in the extra auth-source-backend parameters of ENTRY.
446 447
Using the plist ENTRY, get the :host, :port, and :user search
parameters."
448 449 450 451
  (let ((entry (if (stringp entry)
                   nil
                 entry))
        val)
452 453 454 455
    (when (setq val (plist-get entry :host))
      (oset backend host val))
    (when (setq val (plist-get entry :user))
      (oset backend user val))
456 457
    (when (setq val (plist-get entry :port))
      (oset backend port val)))
458 459 460 461 462
  backend)

;; (mapcar 'auth-source-backend-parse auth-sources)

(defun* auth-source-search (&rest spec
463
                                  &key type max host user port secret
464
                                  require create delete
465 466 467 468 469 470 471 472 473 474 475
                                  &allow-other-keys)
  "Search or modify authentication backends according to SPEC.

This function parses `auth-sources' for matches of the SPEC
plist.  It can optionally create or update an authentication
token if requested.  A token is just a standard Emacs property
list with a :secret property that can be a function; all the
other properties will always hold scalar values.

Typically the :secret property, if present, contains a password.

476
Common search keys are :max, :host, :port, and :user.  In
477 478 479 480 481 482 483 484 485 486 487 488 489
addition, :create specifies how tokens will be or created.
Finally, :type can specify which backend types you want to check.

A string value is always matched literally.  A symbol is matched
as its string value, literally.  All the SPEC values can be
single values (symbol or string) or lists thereof (in which case
any of the search terms matches).

:create t means to create a token if possible.

A new token will be created if no matching tokens were found.
The new token will have only the keys the backend requires.  For
the netrc backend, for instance, that's the user, host, and
490
port keys.
491 492 493 494 495 496 497 498 499 500 501 502 503 504 505

Here's an example:

\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
                                        (A    . \"default A\"))))
  (auth-source-search :host \"mine\" :type 'netrc :max 1
                      :P \"pppp\" :Q \"qqqq\"
                      :create t))

which says:

\"Search for any entry matching host 'mine' in backends of type
 'netrc', maximum one result.

 Create a new entry if you found none.  The netrc backend will
506
 automatically require host, user, and port.  The host will be
507
 'mine'.  We prompt for the user with default 'defaultUser' and
508
 for the port without a default.  We will not prompt for A, Q,
509
 or P.  The resulting token will only have keys user, host, and
510
 port.\"
511 512 513 514 515 516 517 518

:create '(A B C) also means to create a token if possible.

The behavior is like :create t but if the list contains any
parameter, that parameter will be required in the resulting
token.  The value for that parameter will be obtained from the
search parameters or from user input.  If any queries are needed,
the alist `auth-source-creation-defaults' will be checked for the
519 520 521 522 523
default value.  If the user, host, or port are missing, the alist
`auth-source-creation-prompts' will be used to look up the
prompts IN THAT ORDER (so the 'user prompt will be queried first,
then 'host, then 'port, and finally 'secret).  Each prompt string
can use %u, %h, and %p to show the user, host, and port.
524 525 526 527

Here's an example:

\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
528 529 530
                                        (A    . \"default A\")))
       (auth-source-creation-prompts
        '((password . \"Enter IMAP password for %h:%p: \"))))
531 532 533 534 535 536 537 538 539 540
  (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
                      :P \"pppp\" :Q \"qqqq\"
                      :create '(A B Q)))

which says:

\"Search for any entry matching host 'nonesuch'
 or 'twosuch' in backends of type 'netrc', maximum one result.

 Create a new entry if you found none.  The netrc backend will
541
 automatically require host, user, and port.  The host will be
542 543 544 545 546
 'nonesuch' and Q will be 'qqqq'.  We prompt for the password
 with the shown prompt.  We will not prompt for Q.  The resulting
 token will have keys user, host, port, A, B, and Q.  It will not
 have P with any value, even though P is used in the search to
 find only entries that have P set to 'pppp'.\"
547 548

When multiple values are specified in the search parameter, the
549 550
user is prompted for which one.  So :host (X Y Z) would ask the
user to choose between X, Y, and Z.
551 552 553 554 555 556 557

This creation can fail if the search was not specific enough to
create a new token (it's up to the backend to decide that).  You
should `catch' the backend-specific error as usual.  Some
backends (netrc, at least) will prompt the user rather than throw
an error.

558 559 560 561 562
:require (A B C) means that only results that contain those
tokens will be returned.  Thus for instance requiring :secret
will ensure that any results will actually have a :secret
property.

563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
:delete t means to delete any found entries.  nil by default.
Use `auth-source-delete' in ELisp code instead of calling
`auth-source-search' directly with this parameter.

:type (X Y Z) will check only those backend types.  'netrc and
'secrets are the only ones supported right now.

:max N means to try to return at most N items (defaults to 1).
When 0 the function will return just t or nil to indicate if any
matches were found.  More than N items may be returned, depending
on the search and the backend.

:host (X Y Z) means to match only hosts X, Y, or Z according to
the match rules above.  Defaults to t.

:user (X Y Z) means to match only users X, Y, or Z according to
the match rules above.  Defaults to t.

581
:port (P Q R) means to match only protocols P, Q, or R.
582 583 584 585 586 587
Defaults to t.

:K (V1 V2 V3) for any other key K will match values V1, V2, or
V3 (note the match rules above).

The return value is a list with at most :max tokens.  Each token
588
is a plist with keys :backend :host :port :user, plus any other
589 590 591
keys provided by the backend (notably :secret).  But note the
exception for :max 0, which see above.

592 593 594 595 596 597
The token can hold a :save-function key.  If you call that, the
user will be prompted to save the data to the backend.  You can't
request that this should happen right after creation, because
`auth-source-search' has no way of knowing if the token is
actually useful.  So the caller must arrange to call this function.

598 599 600 601
The token's :secret key can hold a function.  In that case you
must call it to obtain the actual value."
  (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
         (max (or max 1))
602
         (ignored-keys '(:require :create :delete :max))
603 604 605
         (keys (loop for i below (length spec) by 2
                     unless (memq (nth i spec) ignored-keys)
                     collect (nth i spec)))
606 607 608
         (cached (auth-source-remembered-p spec))
         ;; note that we may have cached results but found is still nil
         ;; (there were no results from the search)
609
         (found (auth-source-recall spec))
610
         filtered-backends accessor-key backend)
611

612
    (if (and cached auth-source-do-cache)
613 614 615 616 617 618
        (auth-source-do-debug
         "auth-source-search: found %d CACHED results matching %S"
         (length found) spec)

      (assert
       (or (eq t create) (listp create)) t
619
       "Invalid auth-source :create parameter (must be t or a list): %s %s")
620

621 622 623 624
      (assert
       (listp require) t
       "Invalid auth-source :require parameter (must be a list): %s")

625
      (setq filtered-backends (copy-sequence backends))
626 627 628 629 630 631 632 633 634 635 636
      (dolist (backend backends)
        (dolist (key keys)
          ;; ignore invalid slots
          (condition-case signal
              (unless (eval `(auth-source-search-collection
                              (plist-get spec key)
                              (oref backend ,key)))
                (setq filtered-backends (delq backend filtered-backends))
                (return))
            (invalid-slot-name))))

637
      (auth-source-do-trivia
638 639 640 641
       "auth-source-search: found %d backends matching %S"
       (length filtered-backends) spec)

      ;; (debug spec "filtered" filtered-backends)
642 643
      ;; First go through all the backends without :create, so we can
      ;; query them all.
644 645 646 647
      (setq found (auth-source-search-backends filtered-backends
                                               spec
                                               ;; to exit early
                                               max
648 649 650
                                               ;; create is always nil here
                                               nil delete
                                               require))
651 652 653 654 655

      (auth-source-do-debug
       "auth-source-search: found %d results (max %d) matching %S"
       (length found) max spec)

656 657
      ;; If we didn't find anything, then we allow the backend(s) to
      ;; create the entries.
658
      (when (and create
659 660 661 662 663
                 (not found))
        (setq found (auth-source-search-backends filtered-backends
                                                 spec
                                                 ;; to exit early
                                                 max
664 665 666
                                                 create delete
                                                 require))
        (auth-source-do-debug
667 668 669
         "auth-source-search: CREATED %d results (max %d) matching %S"
         (length found) max spec))

670 671
      ;; note we remember the lack of result too, if it's applicable
      (when auth-source-do-cache
672 673 674 675
        (auth-source-remember spec found)))

      found))

676
(defun auth-source-search-backends (backends spec max create delete require)
677 678 679
  (let (matches)
    (dolist (backend backends)
      (when (> max (length matches))   ; when we need more matches...
680 681 682 683 684 685 686 687 688
        (let* ((bmatches (apply
                          (slot-value backend 'search-function)
                          :backend backend
                          ;; note we're overriding whatever the spec
                          ;; has for :require, :create, and :delete
                          :require require
                          :create create
                          :delete delete
                          spec)))
689 690 691 692 693 694 695 696 697
          (when bmatches
            (auth-source-do-trivia
             "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
             (length bmatches) max
             (slot-value backend :type)
             (slot-value backend :source)
             spec)
            (setq matches (append matches bmatches))))))
    matches))
698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723

;;; (auth-source-search :max 1)
;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
;;; (auth-source-search :host "nonesuch" :type 'secrets)

(defun* auth-source-delete (&rest spec
                                  &key delete
                                  &allow-other-keys)
  "Delete entries from the authentication backends according to SPEC.
Calls `auth-source-search' with the :delete property in SPEC set to t.
The backend may not actually delete the entries.

Returns the deleted entries."
  (auth-source-search (plist-put spec :delete t)))

(defun auth-source-search-collection (collection value)
  "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
  (when (and (atom collection) (not (eq t collection)))
    (setq collection (list collection)))

  ;; (debug :collection collection :value value)
  (or (eq collection t)
      (eq value t)
      (equal collection value)
      (member value collection)))
Miles Bader's avatar
Miles Bader committed
724

725 726
(defvar auth-source-netrc-cache nil)

Miles Bader's avatar
Miles Bader committed
727
(defun auth-source-forget-all-cached ()
728
  "Forget all cached auth-source data."
Miles Bader's avatar
Miles Bader committed
729
  (interactive)
730 731 732 733 734
  (loop for sym being the symbols of password-data
        ;; when the symbol name starts with auth-source-magic
        when (string-match (concat "^" auth-source-magic)
                           (symbol-name sym))
        ;; remove that key
735 736
        do (password-cache-remove (symbol-name sym)))
  (setq auth-source-netrc-cache nil))
737 738 739

(defun auth-source-remember (spec found)
  "Remember FOUND search results for SPEC."
740 741 742
  (let ((password-cache-expiry auth-source-cache-expiry))
    (password-cache-add
     (concat auth-source-magic (format "%S" spec)) found)))
743 744 745 746 747 748

(defun auth-source-recall (spec)
  "Recall FOUND search results for SPEC."
  (password-read-from-cache
   (concat auth-source-magic (format "%S" spec))))

749 750 751 752 753
(defun auth-source-remembered-p (spec)
  "Check if SPEC is remembered."
  (password-in-cache-p
   (concat auth-source-magic (format "%S" spec))))

754 755 756 757 758 759 760 761 762 763
(defun auth-source-forget (spec)
  "Forget any cached data matching SPEC exactly.

This is the same SPEC you passed to `auth-source-search'.
Returns t or nil for forgotten or not found."
  (password-cache-remove (concat auth-source-magic (format "%S" spec))))

;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))

;;; (auth-source-remember '(:host "wedd") '(4 5 6))
764
;;; (auth-source-remembered-p '(:host "wedd"))
765
;;; (auth-source-remember '(:host "xedd") '(1 2 3))
766 767
;;; (auth-source-remembered-p '(:host "xedd"))
;;; (auth-source-remembered-p '(:host "zedd"))
768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803
;;; (auth-source-recall '(:host "xedd"))
;;; (auth-source-recall '(:host t))
;;; (auth-source-forget+ :host t)

(defun* auth-source-forget+ (&rest spec &allow-other-keys)
  "Forget any cached data matching SPEC.  Returns forgotten count.

This is not a full `auth-source-search' spec but works similarly.
For instance, \(:host \"myhost\" \"yourhost\") would find all the
cached data that was found with a search for those two hosts,
while \(:host t) would find all host entries."
  (let ((count 0)
        sname)
    (loop for sym being the symbols of password-data
          ;; when the symbol name matches with auth-source-magic
          when (and (setq sname (symbol-name sym))
                    (string-match (concat "^" auth-source-magic "\\(.+\\)")
                                  sname)
                    ;; and the spec matches what was stored in the cache
                    (auth-source-specmatchp spec (read (match-string 1 sname))))
          ;; remove that key
          do (progn
               (password-cache-remove sname)
               (incf count)))
    count))

(defun auth-source-specmatchp (spec stored)
  (let ((keys (loop for i below (length spec) by 2
                   collect (nth i spec))))
    (not (eq
          (dolist (key keys)
            (unless (auth-source-search-collection (plist-get stored key)
                                                   (plist-get spec key))
              (return 'no)))
          'no))))

804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821
;;; (auth-source-pick-first-password :host "z.lifelogs.com")
;;; (auth-source-pick-first-password :port "imap")
(defun auth-source-pick-first-password (&rest spec)
  "Pick the first secret found from applying SPEC to `auth-source-search'."
  (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
         (secret (plist-get result :secret)))

    (if (functionp secret)
        (funcall secret)
      secret)))

;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
(defun auth-source-format-prompt (prompt alist)
  "Format PROMPT using %x (for any character x) specifiers in ALIST."
  (dolist (cell alist)
    (let ((c (nth 0 cell))
          (v (nth 1 cell)))
      (when (and c v)
822 823 824
        (setq prompt (replace-regexp-in-string (format "%%%c" c)
                                               (format "%s" v)
                                               prompt)))))
825
  prompt)
826

827 828 829 830 831 832 833 834 835
(defun auth-source-ensure-strings (values)
  (unless (listp values)
    (setq values (list values)))
  (mapcar (lambda (value)
	    (if (numberp value)
		(format "%s" value)
	      value))
	  values))

836 837
;;; Backend specific parsing: netrc/authinfo backend

838 839 840
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
                                 spec
841
                                 &key file max host user port delete require
842 843 844 845 846 847 848
                                 &allow-other-keys)
  "Parse FILE and return a list of all entries in the file.
Note that the MAX parameter is used so we can exit the parse early."
  (if (listp file)
      ;; We got already parsed contents; just return it.
      file
    (when (file-exists-p file)
849
      (setq port (auth-source-ensure-strings port))
850
      (with-temp-buffer
851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879
        (let* ((tokens '("machine" "host" "default" "login" "user"
                         "password" "account" "macdef" "force"
                         "port" "protocol"))
               (max (or max 5000))       ; sanity check: default to stop at 5K
               (modified 0)
               (cached (cdr-safe (assoc file auth-source-netrc-cache)))
               (cached-mtime (plist-get cached :mtime))
               (cached-secrets (plist-get cached :secret))
               alist elem result pair)

          (if (and (functionp cached-secrets)
                   (equal cached-mtime
                          (nth 5 (file-attributes file))))
              (progn
                (auth-source-do-trivia
                 "auth-source-netrc-parse: using CACHED file data for %s"
                 file)
                (insert (funcall cached-secrets)))
            (insert-file-contents file)
            ;; cache all netrc files (used to be just .gpg files)
            ;; Store the contents of the file heavily encrypted in memory.
            ;; (note for the irony-impaired: they are just obfuscated)
            (aput 'auth-source-netrc-cache file
                  (list :mtime (nth 5 (file-attributes file))
                        :secret (lexical-let ((v (rot13-string
                                                  (base64-encode-string
                                                   (buffer-string)))))
                                  (lambda () (base64-decode-string
                                         (rot13-string v)))))))
880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925
          (goto-char (point-min))
          ;; Go through the file, line by line.
          (while (and (not (eobp))
                      (> max 0))

            (narrow-to-region (point) (point-at-eol))
            ;; For each line, get the tokens and values.
            (while (not (eobp))
              (skip-chars-forward "\t ")
              ;; Skip lines that begin with a "#".
              (if (eq (char-after) ?#)
                  (goto-char (point-max))
                (unless (eobp)
                  (setq elem
                        (if (= (following-char) ?\")
                            (read (current-buffer))
                          (buffer-substring
                           (point) (progn (skip-chars-forward "^\t ")
                                          (point)))))
                  (cond
                   ((equal elem "macdef")
                    ;; We skip past the macro definition.
                    (widen)
                    (while (and (zerop (forward-line 1))
                                (looking-at "$")))
                    (narrow-to-region (point) (point)))
                   ((member elem tokens)
                    ;; Tokens that don't have a following value are ignored,
                    ;; except "default".
                    (when (and pair (or (cdr pair)
                                        (equal (car pair) "default")))
                      (push pair alist))
                    (setq pair (list elem)))
                   (t
                    ;; Values that haven't got a preceding token are ignored.
                    (when pair
                      (setcdr pair elem)
                      (push pair alist)
                      (setq pair nil)))))))

            (when (and alist
                       (> max 0)
                       (auth-source-search-collection
                        host
                        (or
                         (aget alist "machine")
926 927
                         (aget alist "host")
                         t))
928 929 930 931 932
                       (auth-source-search-collection
                        user
                        (or
                         (aget alist "login")
                         (aget alist "account")
933 934
                         (aget alist "user")
                         t))
935
                       (auth-source-search-collection
936
                        port
937 938
                        (or
                         (aget alist "port")
939
                         (aget alist "protocol")
940 941 942 943 944 945
                         t))
                       (or
                        ;; the required list of keys is nil, or
                        (null require)
                        ;; every element of require is in the normalized list
                        (let ((normalized (nth 0 (auth-source-netrc-normalize
946
                                                 (list alist) file))))
947 948
                          (loop for req in require
                                always (plist-get normalized req)))))
949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972
              (decf max)
              (push (nreverse alist) result)
              ;; to delete a line, we just comment it out
              (when delete
                (goto-char (point-min))
                (insert "#")
                (incf modified)))
            (setq alist nil
                  pair nil)
            (widen)
            (forward-line 1))

          (when (< 0 modified)
            (when auth-source-gpg-encrypt-to
              ;; (see bug#7487) making `epa-file-encrypt-to' local to
              ;; this buffer lets epa-file skip the key selection query
              ;; (see the `local-variable-p' check in
              ;; `epa-file-write-region').
              (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
                (make-local-variable 'epa-file-encrypt-to))
              (if (listp auth-source-gpg-encrypt-to)
                  (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))

            ;; ask AFTER we've successfully opened the file
973
            (when (y-or-n-p (format "Save file %s? (%d deletions)"
974 975 976 977 978 979 980 981
                                    file modified))
              (write-region (point-min) (point-max) file nil 'silent)
              (auth-source-do-debug
               "auth-source-netrc-parse: modified %d lines in %s"
               modified file)))

          (nreverse result))))))

982 983 984 985 986 987
(defmacro with-auth-source-epa-overrides (&rest body)
  `(let ((file-name-handler-alist
          ',(if (boundp 'epa-file-handler)
                (remove (symbol-value 'epa-file-handler)
                        file-name-handler-alist)
              file-name-handler-alist))
988 989 990
         (,(if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)
          ',(remove
             'epa-file-find-file-hook
991 992 993
             (if (boundp 'find-file-hook)
		 (symbol-value 'find-file-hook)
	       (symbol-value 'find-file-hooks))))
994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033
         (auto-mode-alist
          ',(if (boundp 'epa-file-auto-mode-alist-entry)
                (remove (symbol-value 'epa-file-auto-mode-alist-entry)
                        auto-mode-alist)
              auto-mode-alist)))
     ,@body))

(defun auth-source-epa-make-gpg-token (secret file)
  (require 'epa nil t)
  (unless (featurep 'epa)
    (error "EPA could not be loaded."))
  (let* ((base (file-name-sans-extension file))
         (passkey (format "gpg:-%s" base))
         (stash (concat base ".gpg"))
         ;; temporarily disable EPA
         (stashfile
          (with-auth-source-epa-overrides
           (make-temp-file "gpg-token" nil
                           stash)))
         (epa-file-passphrase-alist
          `((,stashfile
             . ,(password-read
                 (format
                  "token pass for %s? "
                  file)
                 passkey)))))
    (write-region secret nil stashfile)
    ;; temporarily disable EPA
    (unwind-protect
        (with-auth-source-epa-overrides
         (with-temp-buffer
           (insert-file-contents stashfile)
           (base64-encode-region (point-min) (point-max) t)
           (concat "gpg:"
                   (buffer-substring-no-properties
                    (point-min)
                    (point-max)))))
      (delete-file stashfile))))

(defun auth-source-netrc-normalize (alist filename)
1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048
  (mapcar (lambda (entry)
            (let (ret item)
              (while (setq item (pop entry))
                (let ((k (car item))
                      (v (cdr item)))

                  ;; apply key aliases
                  (setq k (cond ((member k '("machine")) "host")
                                ((member k '("login" "account")) "user")
                                ((member k '("protocol")) "port")
                                ((member k '("password")) "secret")
                                (t k)))

                  ;; send back the secret in a function (lexical binding)
                  (when (equal k "secret")
1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107
                    (setq v (lexical-let ((v v)
                                          (filename filename)
                                          (base (file-name-nondirectory
                                                 filename))
                                          (token-decoder nil)
                                          (gpgdata nil)
                                          (stash nil))
                              (setq stash (concat base ".gpg"))
                              (when (string-match "gpg:\\(.+\\)" v)
                                (require 'epa nil t)
                                (unless (featurep 'epa)
                                  (error "EPA could not be loaded."))
                                (setq gpgdata (base64-decode-string
                                               (match-string 1 v)))
                                ;; it's a GPG token
                                (setq
                                 token-decoder
                                 (lambda (gpgdata)
;;; FIXME: this relies on .gpg files being handled by EPA/EPG
                                   (let* ((passkey (format "gpg:-%s" base))
                                          ;; temporarily disable EPA
                                          (stashfile
                                           (with-auth-source-epa-overrides
                                            (make-temp-file "gpg-token" nil
                                                            stash)))
                                          (epa-file-passphrase-alist
                                           `((,stashfile
                                              . ,(password-read
                                                  (format
                                                   "token pass for %s? "
                                                   filename)
                                                  passkey)))))
                                     (unwind-protect
                                         (progn
                                           ;; temporarily disable EPA
                                           (with-auth-source-epa-overrides
                                            (write-region gpgdata
                                                          nil
                                                          stashfile))
                                           (setq
                                            v
                                            (with-temp-buffer
                                              (insert-file-contents stashfile)
                                              (buffer-substring-no-properties
                                               (point-min)
                                               (point-max)))))
                                       (delete-file stashfile)))
                                   ;; clear out the decoder at end
                                   (setq token-decoder nil
                                         gpgdata nil))))
                          (lambda ()
                            (when token-decoder
                              (funcall token-decoder gpgdata))
                            v))))
                (setq ret (plist-put ret
                                     (intern (concat ":" k))
                                     v))))
            ret))
  alist))
1108 1109 1110 1111 1112 1113

;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
;;; (funcall secret)

(defun* auth-source-netrc-search (&rest
                                  spec
1114
                                  &key backend require create delete
1115
                                  type max host user port
1116 1117 1118 1119 1120
                                  &allow-other-keys)
"Given a property list SPEC, return search matches from the :backend.
See `auth-source-search' for details on SPEC."
  ;; just in case, check that the type is correct (null or same as the backend)
  (assert (or (null type) (eq type (oref backend type)))
1121
          t "Invalid netrc search: %s %s")
1122 1123 1124 1125

  (let ((results (auth-source-netrc-normalize
                  (auth-source-netrc-parse
                   :max max
1126
                   :require require
1127 1128 1129 1130
                   :delete delete
                   :file (oref backend source)
                   :host (or host t)
                   :user (or user t)
1131 1132
                   :port (or port t))
                  (oref backend source))))
1133 1134 1135

    ;; if we need to create an entry AND none were found to match
    (when (and create
1136
               (not results))
1137

1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148
      ;; create based on the spec and record the value
      (setq results (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-netrc-search
                            (plist-put spec :create nil)))))
1149 1150
    results))

1151 1152 1153 1154 1155
(defun auth-source-netrc-element-or-first (v)
  (if (listp v)
      (nth 0 v)
    v))

1156 1157 1158 1159 1160
;;; (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)))

(defun* auth-source-netrc-create (&rest spec
                                        &key backend
1161
                                        secret host user port create
1162
                                        &allow-other-keys)
1163
  (let* ((base-required '(host user port secret))
1164 1165 1166
         ;; 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))
1167 1168 1169
	 (current-data (car (auth-source-search :max 1
						:host host
						:port port)))
1170 1171 1172 1173
         (required (append base-required create-extra))
         (file (oref backend source))
         (add "")
         ;; `valist' is an alist
1174 1175 1176
         valist
         ;; `artificial' will be returned if no creation is needed
         artificial)
1177 1178 1179

    ;; only for base required elements (defined as function parameters):
    ;; fill in the valist with whatever data we may have from the search
1180
    ;; we complete the first value if it's a list and use the value otherwise
1181 1182
    (dolist (br base-required)
      (when (symbol-value br)
1183 1184 1185 1186 1187 1188 1189
        (let ((br-choice (cond
                          ;; all-accepting choice (predicate is t)
                          ((eq t (symbol-value br)) nil)
                          ;; just the value otherwise
                          (t (symbol-value br)))))
          (when br-choice
            (aput 'valist br br-choice)))))
1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202

    ;; for extra required elements, see if the spec includes a value for them
    (dolist (er create-extra)
      (let ((name (concat ":" (symbol-name er)))
            (keys (loop for i below (length spec) by 2
                        collect (nth i spec))))
        (dolist (k keys)
          (when (equal (symbol-name k) name)
            (aput 'valist er (plist-get spec k))))))

    ;; for each required element
    (dolist (r required)
      (let* ((data (aget valist r))
1203
             ;; take the first element if the data is a list
1204 1205 1206
             (data (or (auth-source-netrc-element-or-first data)
		       (plist-get current-data
				  (intern (format ":%s" r) obarray))))
1207
             ;; this is the default to be offered
1208
             (given-default (aget auth-source-creation-defaults r))
1209 1210 1211
             ;; the default supplementals are simple:
             ;; for the user, try `given-default' and then (user-login-name);
             ;; otherwise take `given-default'
1212
             (default (cond
1213 1214
                       ((and (not given-default) (eq r 'user))
                        (user-login-name))
1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236
                       (t given-default)))
             (printable-defaults (list
                                  (cons 'user
                                        (or
                                         (auth-source-netrc-element-or-first
                                          (aget valist 'user))
                                         (plist-get artificial :user)
                                         "[any user]"))
                                  (cons 'host
                                        (or
                                         (auth-source-netrc-element-or-first
                                          (aget valist 'host))
                                         (plist-get artificial :host)
                                         "[any host]"))
                                  (cons 'port
                                        (or
                                         (auth-source-netrc-element-or-first
                                          (aget valist 'port))
                                         (plist-get artificial :port)
                                         "[any port]"))))
             (prompt (or (aget auth-source-creation-prompts r)
                         (case r