cgit.sxemacs.org Git - gnus/blob - lisp/auth-source.el

   1 ;;; auth-source.el --- authentication sources for Gnus and Emacs
   2
   3 ;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
   4
   5 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; 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/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This is the auth-source.el package.  It lets users tell Gnus how to
  26 ;; authenticate in a single place.  Simplicity is the goal.  Instead
  27 ;; of providing 5000 options, we'll stick to simple, easy to
  28 ;; understand options.
  29
  30 ;; See the auth.info Info documentation for details.
  31
  32 ;; TODO:
  33
  34 ;; - never decode the backend file unless it's necessary
  35 ;; - a more generic way to match backends and search backend contents
  36 ;; - absorb netrc.el and simplify it
  37 ;; - protect passwords better
  38 ;; - allow creating and changing netrc lines (not files) e.g. change a password
  39
  40 ;;; Code:
  41
  42 (require 'password-cache)
  43 (require 'mm-util)
  44 (require 'gnus-util)
  45 (require 'assoc)
  46 (eval-when-compile (require 'cl))
  47 (eval-and-compile
  48   (or (ignore-errors (require 'eieio))
  49       ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
  50       (ignore-errors
  51         (let ((load-path (cons (expand-file-name
  52                                 "gnus-fallback-lib/eieio"
  53                                 (file-name-directory (locate-library "gnus")))
  54                                load-path)))
  55           (require 'eieio)))
  56       (error
  57        "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
  58
  59 (autoload 'secrets-create-item "secrets")
  60 (autoload 'secrets-delete-item "secrets")
  61 (autoload 'secrets-get-alias "secrets")
  62 (autoload 'secrets-get-attributes "secrets")
  63 (autoload 'secrets-get-secret "secrets")
  64 (autoload 'secrets-list-collections "secrets")
  65 (autoload 'secrets-search-items "secrets")
  66
  67 (defvar secrets-enabled)
  68
  69 (defgroup auth-source nil
  70   "Authentication sources."
  71   :version "23.1" ;; No Gnus
  72   :group 'gnus)
  73
  74 ;;;###autoload
  75 (defcustom auth-source-cache-expiry 7200
  76   "How many seconds passwords are cached, or nil to disable
  77 expiring.  Overrides `password-cache-expiry' through a
  78 let-binding."
  79   :group 'auth-source
  80   :type '(choice (const :tag "Never" nil)
  81                  (const :tag "All Day" 86400)
  82                  (const :tag "2 Hours" 7200)
  83                  (const :tag "30 Minutes" 1800)
  84                  (integer :tag "Seconds")))
  85
  86 (defclass auth-source-backend ()
  87   ((type :initarg :type
  88          :initform 'netrc
  89          :type symbol
  90          :custom symbol
  91          :documentation "The backend type.")
  92    (source :initarg :source
  93            :type string
  94            :custom string
  95            :documentation "The backend source.")
  96    (host :initarg :host
  97          :initform t
  98          :type t
  99          :custom string
 100          :documentation "The backend host.")
 101    (user :initarg :user
 102          :initform t
 103          :type t
 104          :custom string
 105          :documentation "The backend user.")
 106    (port :initarg :port
 107          :initform t
 108          :type t
 109          :custom string
 110          :documentation "The backend protocol.")
 111    (create-function :initarg :create-function
 112                     :initform ignore
 113                     :type function
 114                     :custom function
 115                     :documentation "The create function.")
 116    (search-function :initarg :search-function
 117                     :initform ignore
 118                     :type function
 119                     :custom function
 120                     :documentation "The search function.")))
 121
 122 (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
 123                                    (pop3 "pop3" "pop" "pop3s" "110" "995")
 124                                    (ssh  "ssh" "22")
 125                                    (sftp "sftp" "115")
 126                                    (smtp "smtp" "25"))
 127   "List of authentication protocols and their names"
 128
 129   :group 'auth-source
 130   :version "23.2" ;; No Gnus
 131   :type '(repeat :tag "Authentication Protocols"
 132                  (cons :tag "Protocol Entry"
 133                        (symbol :tag "Protocol")
 134                        (repeat :tag "Names"
 135                                (string :tag "Name")))))
 136
 137 ;;; generate all the protocols in a format Customize can use
 138 ;;; TODO: generate on the fly from auth-source-protocols
 139 (defconst auth-source-protocols-customize
 140   (mapcar (lambda (a)
 141             (let ((p (car-safe a)))
 142               (list 'const
 143                     :tag (upcase (symbol-name p))
 144                     p)))
 145           auth-source-protocols))
 146
 147 (defvar auth-source-creation-defaults nil
 148   "Defaults for creating token values.  Usually let-bound.")
 149
 150 (defvar auth-source-creation-prompts nil
 151   "Default prompts for token values.  Usually let-bound.")
 152
 153 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
 154
 155 (defcustom auth-source-save-behavior 'ask
 156   "If set, auth-source will respect it for save behavior."
 157   :group 'auth-source
 158   :version "23.2" ;; No Gnus
 159   :type `(choice
 160           :tag "auth-source new token save behavior"
 161           (const :tag "Always save" t)
 162           (const :tag "Never save" nil)
 163           (const :tag "Ask" ask)))
 164
 165 (defvar auth-source-magic "auth-source-magic ")
 166
 167 (defcustom auth-source-do-cache t
 168   "Whether auth-source should cache information with `password-cache'."
 169   :group 'auth-source
 170   :version "23.2" ;; No Gnus
 171   :type `boolean)
 172
 173 (defcustom auth-source-debug nil
 174   "Whether auth-source should log debug messages.
 175
 176 If the value is nil, debug messages are not logged.
 177
 178 If the value is t, debug messages are logged with `message'.  In
 179 that case, your authentication data will be in the clear (except
 180 for passwords).
 181
 182 If the value is a function, debug messages are logged by calling
 183  that function using the same arguments as `message'."
 184   :group 'auth-source
 185   :version "23.2" ;; No Gnus
 186   :type `(choice
 187           :tag "auth-source debugging mode"
 188           (const :tag "Log using `message' to the *Messages* buffer" t)
 189           (const :tag "Log all trivia with `message' to the *Messages* buffer"
 190                  trivia)
 191           (function :tag "Function that takes arguments like `message'")
 192           (const :tag "Don't log anything" nil)))
 193
 194 (defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
 195   "List of authentication sources.
 196
 197 The default will get login and password information from
 198 \"~/.authinfo.gpg\", which you should set up with the EPA/EPG
 199 packages to be encrypted.  If that file doesn't exist, it will
 200 try the unencrypted version \"~/.authinfo\" and the famous
 201 \"~/.netrc\" file.
 202
 203 See the auth.info manual for details.
 204
 205 Each entry is the authentication type with optional properties.
 206
 207 It's best to customize this with `M-x customize-variable' because the choices
 208 can get pretty complex."
 209   :group 'auth-source
 210   :version "24.1" ;; No Gnus
 211   :type `(repeat :tag "Authentication Sources"
 212                  (choice
 213                   (string :tag "Just a file")
 214                   (const :tag "Default Secrets API Collection" 'default)
 215                   (const :tag "Login Secrets API Collection" "secrets:Login")
 216                   (const :tag "Temp Secrets API Collection" "secrets:session")
 217                   (list :tag "Source definition"
 218                         (const :format "" :value :source)
 219                         (choice :tag "Authentication backend choice"
 220                                 (string :tag "Authentication Source (file)")
 221                                 (list
 222                                  :tag "Secret Service API/KWallet/GNOME Keyring"
 223                                  (const :format "" :value :secrets)
 224                                  (choice :tag "Collection to use"
 225                                          (string :tag "Collection name")
 226                                          (const :tag "Default" 'default)
 227                                          (const :tag "Login" "Login")
 228                                          (const
 229                                           :tag "Temporary" "session"))))
 230                         (repeat :tag "Extra Parameters" :inline t
 231                                 (choice :tag "Extra parameter"
 232                                         (list
 233                                          :tag "Host"
 234                                          (const :format "" :value :host)
 235                                          (choice :tag "Host (machine) choice"
 236                                                  (const :tag "Any" t)
 237                                                  (regexp
 238                                                   :tag "Regular expression")))
 239                                         (list
 240                                          :tag "Protocol"
 241                                          (const :format "" :value :port)
 242                                          (choice
 243                                           :tag "Protocol"
 244                                           (const :tag "Any" t)
 245                                           ,@auth-source-protocols-customize))
 246                                         (list :tag "User" :inline t
 247                                               (const :format "" :value :user)
 248                                               (choice :tag "Personality/Username"
 249                                                       (const :tag "Any" t)
 250                                                       (string :tag "Name")))))))))
 251
 252 (defcustom auth-source-gpg-encrypt-to t
 253   "List of recipient keys that `authinfo.gpg' encrypted to.
 254 If the value is not a list, symmetric encryption will be used."
 255   :group 'auth-source
 256   :version "24.1" ;; No Gnus
 257   :type '(choice (const :tag "Symmetric encryption" t)
 258                  (repeat :tag "Recipient public keys"
 259                          (string :tag "Recipient public key"))))
 260
 261 ;; temp for debugging
 262 ;; (unintern 'auth-source-protocols)
 263 ;; (unintern 'auth-sources)
 264 ;; (customize-variable 'auth-sources)
 265 ;; (setq auth-sources nil)
 266 ;; (format "%S" auth-sources)
 267 ;; (customize-variable 'auth-source-protocols)
 268 ;; (setq auth-source-protocols nil)
 269 ;; (format "%S" auth-source-protocols)
 270 ;; (auth-source-pick nil :host "a" :port 'imap)
 271 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
 272 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
 273 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
 274 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
 275 ;; (auth-source-protocol-defaults 'imap)
 276
 277 ;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
 278 ;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
 279 ;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
 280 (defun auth-source-do-debug (&rest msg)
 281   (when auth-source-debug
 282     (apply 'auth-source-do-warn msg)))
 283
 284 (defun auth-source-do-trivia (&rest msg)
 285   (when (or (eq auth-source-debug 'trivia)
 286             (functionp auth-source-debug))
 287     (apply 'auth-source-do-warn msg)))
 288
 289 (defun auth-source-do-warn (&rest msg)
 290   (apply
 291     ;; set logger to either the function in auth-source-debug or 'message
 292     ;; note that it will be 'message if auth-source-debug is nil
 293    (if (functionp auth-source-debug)
 294        auth-source-debug
 295      'message)
 296    msg))
 297
 298
 299 ;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
 300 (defun auth-source-read-char-choice (prompt choices)
 301   "Read one of CHOICES by `read-char-choice', or `read-char'.
 302 `dropdown-list' support is disabled because it doesn't work reliably.
 303 Only one of CHOICES will be returned.  The PROMPT is augmented
 304 with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
 305   (when choices
 306     (let* ((prompt-choices
 307             (apply 'concat (loop for c in choices
 308                                  collect (format "%c/" c))))
 309            (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
 310            (full-prompt (concat prompt prompt-choices))
 311            k)
 312
 313       (while (not (memq k choices))
 314         (setq k (cond
 315                  ((fboundp 'read-char-choice)
 316                   (read-char-choice full-prompt choices))
 317                  (t (message "%s" full-prompt)
 318                     (setq k (read-char))))))
 319       k)))
 320
 321 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
 322 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
 323 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 324 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 325 ;;                   (:source (:secrets "Login") :host t :port t)
 326 ;;                   (:source "~/.authinfo.gpg" :host t :port t)))
 327
 328 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 329 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 330 ;;                   (:source (:secrets "Login") :host t :port t)
 331 ;;                   ))
 332
 333 ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
 334
 335 ;; (auth-source-backend-parse "myfile.gpg")
 336 ;; (auth-source-backend-parse 'default)
 337 ;; (auth-source-backend-parse "secrets:Login")
 338
 339 (defun auth-source-backend-parse (entry)
 340   "Creates an auth-source-backend from an ENTRY in `auth-sources'."
 341   (auth-source-backend-parse-parameters
 342    entry
 343    (cond
 344     ;; take 'default and recurse to get it as a Secrets API default collection
 345     ;; matching any user, host, and protocol
 346     ((eq entry 'default)
 347      (auth-source-backend-parse '(:source (:secrets default))))
 348     ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
 349     ;; matching any user, host, and protocol
 350     ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
 351      (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
 352     ;; take just a file name and recurse to get it as a netrc file
 353     ;; matching any user, host, and protocol
 354     ((stringp entry)
 355      (auth-source-backend-parse `(:source ,entry)))
 356
 357     ;; a file name with parameters
 358     ((stringp (plist-get entry :source))
 359      (auth-source-backend
 360       (plist-get entry :source)
 361       :source (plist-get entry :source)
 362       :type 'netrc
 363       :search-function 'auth-source-netrc-search
 364       :create-function 'auth-source-netrc-create))
 365
 366     ;; the Secrets API.  We require the package, in order to have a
 367     ;; defined value for `secrets-enabled'.
 368     ((and
 369       (not (null (plist-get entry :source))) ; the source must not be nil
 370       (listp (plist-get entry :source))      ; and it must be a list
 371       (require 'secrets nil t)               ; and we must load the Secrets API
 372       secrets-enabled)                       ; and that API must be enabled
 373
 374      ;; the source is either the :secrets key in ENTRY or
 375      ;; if that's missing or nil, it's "session"
 376      (let ((source (or (plist-get (plist-get entry :source) :secrets)
 377                        "session")))
 378
 379        ;; if the source is a symbol, we look for the alias named so,
 380        ;; and if that alias is missing, we use "Login"
 381        (when (symbolp source)
 382          (setq source (or (secrets-get-alias (symbol-name source))
 383                           "Login")))
 384
 385        (if (featurep 'secrets)
 386            (auth-source-backend
 387             (format "Secrets API (%s)" source)
 388             :source source
 389             :type 'secrets
 390             :search-function 'auth-source-secrets-search
 391             :create-function 'auth-source-secrets-create)
 392          (auth-source-do-warn
 393           "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
 394          (auth-source-backend
 395           (format "Ignored Secrets API (%s)" source)
 396           :source ""
 397           :type 'ignore))))
 398
 399     ;; none of them
 400     (t
 401      (auth-source-do-warn
 402       "auth-source-backend-parse: invalid backend spec: %S" entry)
 403      (auth-source-backend
 404       "Empty"
 405       :source ""
 406       :type 'ignore)))))
 407
 408 (defun auth-source-backend-parse-parameters (entry backend)
 409   "Fills in the extra auth-source-backend parameters of ENTRY.
 410 Using the plist ENTRY, get the :host, :port, and :user search
 411 parameters."
 412   (let ((entry (if (stringp entry)
 413                    nil
 414                  entry))
 415         val)
 416     (when (setq val (plist-get entry :host))
 417       (oset backend host val))
 418     (when (setq val (plist-get entry :user))
 419       (oset backend user val))
 420     (when (setq val (plist-get entry :port))
 421       (oset backend port val)))
 422   backend)
 423
 424 ;; (mapcar 'auth-source-backend-parse auth-sources)
 425
 426 (defun* auth-source-search (&rest spec
 427                                   &key type max host user port secret
 428                                   require create delete
 429                                   &allow-other-keys)
 430   "Search or modify authentication backends according to SPEC.
 431
 432 This function parses `auth-sources' for matches of the SPEC
 433 plist.  It can optionally create or update an authentication
 434 token if requested.  A token is just a standard Emacs property
 435 list with a :secret property that can be a function; all the
 436 other properties will always hold scalar values.
 437
 438 Typically the :secret property, if present, contains a password.
 439
 440 Common search keys are :max, :host, :port, and :user.  In
 441 addition, :create specifies how tokens will be or created.
 442 Finally, :type can specify which backend types you want to check.
 443
 444 A string value is always matched literally.  A symbol is matched
 445 as its string value, literally.  All the SPEC values can be
 446 single values (symbol or string) or lists thereof (in which case
 447 any of the search terms matches).
 448
 449 :create t means to create a token if possible.
 450
 451 A new token will be created if no matching tokens were found.
 452 The new token will have only the keys the backend requires.  For
 453 the netrc backend, for instance, that's the user, host, and
 454 port keys.
 455
 456 Here's an example:
 457
 458 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
 459                                         (A    . \"default A\"))))
 460   (auth-source-search :host \"mine\" :type 'netrc :max 1
 461                       :P \"pppp\" :Q \"qqqq\"
 462                       :create t))
 463
 464 which says:
 465
 466 \"Search for any entry matching host 'mine' in backends of type
 467  'netrc', maximum one result.
 468
 469  Create a new entry if you found none.  The netrc backend will
 470  automatically require host, user, and port.  The host will be
 471  'mine'.  We prompt for the user with default 'defaultUser' and
 472  for the port without a default.  We will not prompt for A, Q,
 473  or P.  The resulting token will only have keys user, host, and
 474  port.\"
 475
 476 :create '(A B C) also means to create a token if possible.
 477
 478 The behavior is like :create t but if the list contains any
 479 parameter, that parameter will be required in the resulting
 480 token.  The value for that parameter will be obtained from the
 481 search parameters or from user input.  If any queries are needed,
 482 the alist `auth-source-creation-defaults' will be checked for the
 483 default value.  If the user, host, or port are missing, the alist
 484 `auth-source-creation-prompts' will be used to look up the
 485 prompts IN THAT ORDER (so the 'user prompt will be queried first,
 486 then 'host, then 'port, and finally 'secret).  Each prompt string
 487 can use %u, %h, and %p to show the user, host, and port.
 488
 489 Here's an example:
 490
 491 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
 492                                         (A    . \"default A\")))
 493        (auth-source-creation-prompts
 494         '((password . \"Enter IMAP password for %h:%p: \"))))
 495   (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
 496                       :P \"pppp\" :Q \"qqqq\"
 497                       :create '(A B Q)))
 498
 499 which says:
 500
 501 \"Search for any entry matching host 'nonesuch'
 502  or 'twosuch' in backends of type 'netrc', maximum one result.
 503
 504  Create a new entry if you found none.  The netrc backend will
 505  automatically require host, user, and port.  The host will be
 506  'nonesuch' and Q will be 'qqqq'.  We prompt for the password
 507  with the shown prompt.  We will not prompt for Q.  The resulting
 508  token will have keys user, host, port, A, B, and Q.  It will not
 509  have P with any value, even though P is used in the search to
 510  find only entries that have P set to 'pppp'.\"
 511
 512 When multiple values are specified in the search parameter, the
 513 user is prompted for which one.  So :host (X Y Z) would ask the
 514 user to choose between X, Y, and Z.
 515
 516 This creation can fail if the search was not specific enough to
 517 create a new token (it's up to the backend to decide that).  You
 518 should `catch' the backend-specific error as usual.  Some
 519 backends (netrc, at least) will prompt the user rather than throw
 520 an error.
 521
 522 :require (A B C) means that only results that contain those
 523 tokens will be returned.  Thus for instance requiring :secret
 524 will ensure that any results will actually have a :secret
 525 property.
 526
 527 :delete t means to delete any found entries.  nil by default.
 528 Use `auth-source-delete' in ELisp code instead of calling
 529 `auth-source-search' directly with this parameter.
 530
 531 :type (X Y Z) will check only those backend types.  'netrc and
 532 'secrets are the only ones supported right now.
 533
 534 :max N means to try to return at most N items (defaults to 1).
 535 When 0 the function will return just t or nil to indicate if any
 536 matches were found.  More than N items may be returned, depending
 537 on the search and the backend.
 538
 539 :host (X Y Z) means to match only hosts X, Y, or Z according to
 540 the match rules above.  Defaults to t.
 541
 542 :user (X Y Z) means to match only users X, Y, or Z according to
 543 the match rules above.  Defaults to t.
 544
 545 :port (P Q R) means to match only protocols P, Q, or R.
 546 Defaults to t.
 547
 548 :K (V1 V2 V3) for any other key K will match values V1, V2, or
 549 V3 (note the match rules above).
 550
 551 The return value is a list with at most :max tokens.  Each token
 552 is a plist with keys :backend :host :port :user, plus any other
 553 keys provided by the backend (notably :secret).  But note the
 554 exception for :max 0, which see above.
 555
 556 The token can hold a :save-function key.  If you call that, the
 557 user will be prompted to save the data to the backend.  You can't
 558 request that this should happen right after creation, because
 559 `auth-source-search' has no way of knowing if the token is
 560 actually useful.  So the caller must arrange to call this function.
 561
 562 The token's :secret key can hold a function.  In that case you
 563 must call it to obtain the actual value."
 564   (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
 565          (max (or max 1))
 566          (ignored-keys '(:require :create :delete :max))
 567          (keys (loop for i below (length spec) by 2
 568                      unless (memq (nth i spec) ignored-keys)
 569                      collect (nth i spec)))
 570          (cached (auth-source-remembered-p spec))
 571          ;; note that we may have cached results but found is still nil
 572          ;; (there were no results from the search)
 573          (found (auth-source-recall spec))
 574          filtered-backends accessor-key backend)
 575
 576     (if (and cached auth-source-do-cache)
 577         (auth-source-do-debug
 578          "auth-source-search: found %d CACHED results matching %S"
 579          (length found) spec)
 580
 581       (assert
 582        (or (eq t create) (listp create)) t
 583        "Invalid auth-source :create parameter (must be t or a list): %s %s")
 584
 585       (assert
 586        (listp require) t
 587        "Invalid auth-source :require parameter (must be a list): %s")
 588
 589       (setq filtered-backends (copy-sequence backends))
 590       (dolist (backend backends)
 591         (dolist (key keys)
 592           ;; ignore invalid slots
 593           (condition-case signal
 594               (unless (eval `(auth-source-search-collection
 595                               (plist-get spec key)
 596                               (oref backend ,key)))
 597                 (setq filtered-backends (delq backend filtered-backends))
 598                 (return))
 599             (invalid-slot-name))))
 600
 601       (auth-source-do-trivia
 602        "auth-source-search: found %d backends matching %S"
 603        (length filtered-backends) spec)
 604
 605       ;; (debug spec "filtered" filtered-backends)
 606       ;; First go through all the backends without :create, so we can
 607       ;; query them all.
 608       (setq found (auth-source-search-backends filtered-backends
 609                                                spec
 610                                                ;; to exit early
 611                                                max
 612                                                ;; create is always nil here
 613                                                nil delete
 614                                                require))
 615
 616       (auth-source-do-debug
 617        "auth-source-search: found %d results (max %d) matching %S"
 618        (length found) max spec)
 619
 620       ;; If we didn't find anything, then we allow the backend(s) to
 621       ;; create the entries.
 622       (when (and create
 623                  (not found))
 624         (setq found (auth-source-search-backends filtered-backends
 625                                                  spec
 626                                                  ;; to exit early
 627                                                  max
 628                                                  create delete
 629                                                  require))
 630         (auth-source-do-debug
 631          "auth-source-search: CREATED %d results (max %d) matching %S"
 632          (length found) max spec))
 633
 634       ;; note we remember the lack of result too, if it's applicable
 635       (when auth-source-do-cache
 636         (auth-source-remember spec found)))
 637
 638       found))
 639
 640 (defun auth-source-search-backends (backends spec max create delete require)
 641   (let (matches)
 642     (dolist (backend backends)
 643       (when (> max (length matches))   ; when we need more matches...
 644         (let* ((bmatches (apply
 645                           (slot-value backend 'search-function)
 646                           :backend backend
 647                           ;; note we're overriding whatever the spec
 648                           ;; has for :require, :create, and :delete
 649                           :require require
 650                           :create create
 651                           :delete delete
 652                           spec)))
 653           (when bmatches
 654             (auth-source-do-trivia
 655              "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
 656              (length bmatches) max
 657              (slot-value backend :type)
 658              (slot-value backend :source)
 659              spec)
 660             (setq matches (append matches bmatches))))))
 661     matches))
 662
 663 ;;; (auth-source-search :max 1)
 664 ;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
 665 ;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
 666 ;;; (auth-source-search :host "nonesuch" :type 'secrets)
 667
 668 (defun* auth-source-delete (&rest spec
 669                                   &key delete
 670                                   &allow-other-keys)
 671   "Delete entries from the authentication backends according to SPEC.
 672 Calls `auth-source-search' with the :delete property in SPEC set to t.
 673 The backend may not actually delete the entries.
 674
 675 Returns the deleted entries."
 676   (auth-source-search (plist-put spec :delete t)))
 677
 678 (defun auth-source-search-collection (collection value)
 679   "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
 680   (when (and (atom collection) (not (eq t collection)))
 681     (setq collection (list collection)))
 682
 683   ;; (debug :collection collection :value value)
 684   (or (eq collection t)
 685       (eq value t)
 686       (equal collection value)
 687       (member value collection)))
 688
 689 (defun auth-source-forget-all-cached ()
 690   "Forget all cached auth-source data."
 691   (interactive)
 692   (loop for sym being the symbols of password-data
 693         ;; when the symbol name starts with auth-source-magic
 694         when (string-match (concat "^" auth-source-magic)
 695                            (symbol-name sym))
 696         ;; remove that key
 697         do (password-cache-remove (symbol-name sym))))
 698
 699 (defun auth-source-remember (spec found)
 700   "Remember FOUND search results for SPEC."
 701   (let ((password-cache-expiry auth-source-cache-expiry))
 702     (password-cache-add
 703      (concat auth-source-magic (format "%S" spec)) found)))
 704
 705 (defun auth-source-recall (spec)
 706   "Recall FOUND search results for SPEC."
 707   (password-read-from-cache
 708    (concat auth-source-magic (format "%S" spec))))
 709
 710 (defun auth-source-remembered-p (spec)
 711   "Check if SPEC is remembered."
 712   (password-in-cache-p
 713    (concat auth-source-magic (format "%S" spec))))
 714
 715 (defun auth-source-forget (spec)
 716   "Forget any cached data matching SPEC exactly.
 717
 718 This is the same SPEC you passed to `auth-source-search'.
 719 Returns t or nil for forgotten or not found."
 720   (password-cache-remove (concat auth-source-magic (format "%S" spec))))
 721
 722 ;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
 723
 724 ;;; (auth-source-remember '(:host "wedd") '(4 5 6))
 725 ;;; (auth-source-remembered-p '(:host "wedd"))
 726 ;;; (auth-source-remember '(:host "xedd") '(1 2 3))
 727 ;;; (auth-source-remembered-p '(:host "xedd"))
 728 ;;; (auth-source-remembered-p '(:host "zedd"))
 729 ;;; (auth-source-recall '(:host "xedd"))
 730 ;;; (auth-source-recall '(:host t))
 731 ;;; (auth-source-forget+ :host t)
 732
 733 (defun* auth-source-forget+ (&rest spec &allow-other-keys)
 734   "Forget any cached data matching SPEC.  Returns forgotten count.
 735
 736 This is not a full `auth-source-search' spec but works similarly.
 737 For instance, \(:host \"myhost\" \"yourhost\") would find all the
 738 cached data that was found with a search for those two hosts,
 739 while \(:host t) would find all host entries."
 740   (let ((count 0)
 741         sname)
 742     (loop for sym being the symbols of password-data
 743           ;; when the symbol name matches with auth-source-magic
 744           when (and (setq sname (symbol-name sym))
 745                     (string-match (concat "^" auth-source-magic "\\(.+\\)")
 746                                   sname)
 747                     ;; and the spec matches what was stored in the cache
 748                     (auth-source-specmatchp spec (read (match-string 1 sname))))
 749           ;; remove that key
 750           do (progn
 751                (password-cache-remove sname)
 752                (incf count)))
 753     count))
 754
 755 (defun auth-source-specmatchp (spec stored)
 756   (let ((keys (loop for i below (length spec) by 2
 757                    collect (nth i spec))))
 758     (not (eq
 759           (dolist (key keys)
 760             (unless (auth-source-search-collection (plist-get stored key)
 761                                                    (plist-get spec key))
 762               (return 'no)))
 763           'no))))
 764
 765 ;;; (auth-source-pick-first-password :host "z.lifelogs.com")
 766 ;;; (auth-source-pick-first-password :port "imap")
 767 (defun auth-source-pick-first-password (&rest spec)
 768   "Pick the first secret found from applying SPEC to `auth-source-search'."
 769   (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
 770          (secret (plist-get result :secret)))
 771
 772     (if (functionp secret)
 773         (funcall secret)
 774       secret)))
 775
 776 ;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
 777 (defun auth-source-format-prompt (prompt alist)
 778   "Format PROMPT using %x (for any character x) specifiers in ALIST."
 779   (dolist (cell alist)
 780     (let ((c (nth 0 cell))
 781           (v (nth 1 cell)))
 782       (when (and c v)
 783         (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt)))))
 784   prompt)
 785
 786 (defun auth-source-ensure-strings (values)
 787   (unless (listp values)
 788     (setq values (list values)))
 789   (mapcar (lambda (value)
 790             (if (numberp value)
 791                 (format "%s" value)
 792               value))
 793           values))
 794
 795 ;;; Backend specific parsing: netrc/authinfo backend
 796
 797 (defvar auth-source-netrc-cache nil)
 798
 799 ;;; (auth-source-netrc-parse "~/.authinfo.gpg")
 800 (defun* auth-source-netrc-parse (&rest
 801                                  spec
 802                                  &key file max host user port delete require
 803                                  &allow-other-keys)
 804   "Parse FILE and return a list of all entries in the file.
 805 Note that the MAX parameter is used so we can exit the parse early."
 806   (if (listp file)
 807       ;; We got already parsed contents; just return it.
 808       file
 809     (when (file-exists-p file)
 810       (setq port (auth-source-ensure-strings port))
 811       (with-temp-buffer
 812         (let* ((tokens '("machine" "host" "default" "login" "user"
 813                          "password" "account" "macdef" "force"
 814                          "port" "protocol"))
 815                (max (or max 5000))       ; sanity check: default to stop at 5K
 816                (modified 0)
 817                (cached (cdr-safe (assoc file auth-source-netrc-cache)))
 818                (cached-mtime (plist-get cached :mtime))
 819                (cached-secrets (plist-get cached :secret))
 820                alist elem result pair)
 821
 822           (if (and (functionp cached-secrets)
 823                    (equal cached-mtime
 824                           (nth 5 (file-attributes file))))
 825               (progn
 826                 (auth-source-do-trivia
 827                  "auth-source-netrc-parse: using CACHED file data for %s"
 828                  file)
 829                 (insert (funcall cached-secrets)))
 830             (insert-file-contents file)
 831             ;; cache all netrc files (used to be just .gpg files)
 832             ;; Store the contents of the file heavily encrypted in memory.
 833             ;; (note for the irony-impaired: they are just obfuscated)
 834             (aput 'auth-source-netrc-cache file
 835                   (list :mtime (nth 5 (file-attributes file))
 836                         :secret (lexical-let ((v (rot13-string
 837                                                   (base64-encode-string
 838                                                    (buffer-string)))))
 839                                   (lambda () (base64-decode-string
 840                                          (rot13-string v)))))))
 841           (goto-char (point-min))
 842           ;; Go through the file, line by line.
 843           (while (and (not (eobp))
 844                       (> max 0))
 845
 846             (narrow-to-region (point) (point-at-eol))
 847             ;; For each line, get the tokens and values.
 848             (while (not (eobp))
 849               (skip-chars-forward "\t ")
 850               ;; Skip lines that begin with a "#".
 851               (if (eq (char-after) ?#)
 852                   (goto-char (point-max))
 853                 (unless (eobp)
 854                   (setq elem
 855                         (if (= (following-char) ?\")
 856                             (read (current-buffer))
 857                           (buffer-substring
 858                            (point) (progn (skip-chars-forward "^\t ")
 859                                           (point)))))
 860                   (cond
 861                    ((equal elem "macdef")
 862                     ;; We skip past the macro definition.
 863                     (widen)
 864                     (while (and (zerop (forward-line 1))
 865                                 (looking-at "$")))
 866                     (narrow-to-region (point) (point)))
 867                    ((member elem tokens)
 868                     ;; Tokens that don't have a following value are ignored,
 869                     ;; except "default".
 870                     (when (and pair (or (cdr pair)
 871                                         (equal (car pair) "default")))
 872                       (push pair alist))
 873                     (setq pair (list elem)))
 874                    (t
 875                     ;; Values that haven't got a preceding token are ignored.
 876                     (when pair
 877                       (setcdr pair elem)
 878                       (push pair alist)
 879                       (setq pair nil)))))))
 880
 881             (when (and alist
 882                        (> max 0)
 883                        (auth-source-search-collection
 884                         host
 885                         (or
 886                          (aget alist "machine")
 887                          (aget alist "host")
 888                          t))
 889                        (auth-source-search-collection
 890                         user
 891                         (or
 892                          (aget alist "login")
 893                          (aget alist "account")
 894                          (aget alist "user")
 895                          t))
 896                        (auth-source-search-collection
 897                         port
 898                         (or
 899                          (aget alist "port")
 900                          (aget alist "protocol")
 901                          t))
 902                        (or
 903                         ;; the required list of keys is nil, or
 904                         (null require)
 905                         ;; every element of require is in the normalized list
 906                         (let ((normalized (nth 0 (auth-source-netrc-normalize
 907                                                  (list alist)))))
 908                           (loop for req in require
 909                                 always (plist-get normalized req)))))
 910               (decf max)
 911               (push (nreverse alist) result)
 912               ;; to delete a line, we just comment it out
 913               (when delete
 914                 (goto-char (point-min))
 915                 (insert "#")
 916                 (incf modified)))
 917             (setq alist nil
 918                   pair nil)
 919             (widen)
 920             (forward-line 1))
 921
 922           (when (< 0 modified)
 923             (when auth-source-gpg-encrypt-to
 924               ;; (see bug#7487) making `epa-file-encrypt-to' local to
 925               ;; this buffer lets epa-file skip the key selection query
 926               ;; (see the `local-variable-p' check in
 927               ;; `epa-file-write-region').
 928               (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
 929                 (make-local-variable 'epa-file-encrypt-to))
 930               (if (listp auth-source-gpg-encrypt-to)
 931                   (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
 932
 933             ;; ask AFTER we've successfully opened the file
 934             (when (y-or-n-p (format "Save file %s? (%d deletions)"
 935                                     file modified))
 936               (write-region (point-min) (point-max) file nil 'silent)
 937               (auth-source-do-debug
 938                "auth-source-netrc-parse: modified %d lines in %s"
 939                modified file)))
 940
 941           (nreverse result))))))
 942
 943 (defun auth-source-netrc-normalize (alist)
 944   (mapcar (lambda (entry)
 945             (let (ret item)
 946               (while (setq item (pop entry))
 947                 (let ((k (car item))
 948                       (v (cdr item)))
 949
 950                   ;; apply key aliases
 951                   (setq k (cond ((member k '("machine")) "host")
 952                                 ((member k '("login" "account")) "user")
 953                                 ((member k '("protocol")) "port")
 954                                 ((member k '("password")) "secret")
 955                                 (t k)))
 956
 957                   ;; send back the secret in a function (lexical binding)
 958                   (when (equal k "secret")
 959                     (setq v (lexical-let ((v v))
 960                               (lambda () v))))
 961
 962                   (setq ret (plist-put ret
 963                                        (intern (concat ":" k))
 964                                        v))
 965                   ))
 966               ret))
 967           alist))
 968
 969 ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
 970 ;;; (funcall secret)
 971
 972 (defun* auth-source-netrc-search (&rest
 973                                   spec
 974                                   &key backend require create delete
 975                                   type max host user port
 976                                   &allow-other-keys)
 977 "Given a property list SPEC, return search matches from the :backend.
 978 See `auth-source-search' for details on SPEC."
 979   ;; just in case, check that the type is correct (null or same as the backend)
 980   (assert (or (null type) (eq type (oref backend type)))
 981           t "Invalid netrc search: %s %s")
 982
 983   (let ((results (auth-source-netrc-normalize
 984                   (auth-source-netrc-parse
 985                    :max max
 986                    :require require
 987                    :delete delete
 988                    :file (oref backend source)
 989                    :host (or host t)
 990                    :user (or user t)
 991                    :port (or port t)))))
 992
 993     ;; if we need to create an entry AND none were found to match
 994     (when (and create
 995                (not results))
 996
 997       ;; create based on the spec and record the value
 998       (setq results (or
 999                      ;; if the user did not want to create the entry
1000                      ;; in the file, it will be returned
1001                      (apply (slot-value backend 'create-function) spec)
1002                      ;; if not, we do the search again without :create
1003                      ;; to get the updated data.
1004
1005                      ;; the result will be returned, even if the search fails
1006                      (apply 'auth-source-netrc-search
1007                             (plist-put spec :create nil)))))
1008     results))
1009
1010 (defun auth-source-netrc-element-or-first (v)
1011   (if (listp v)
1012       (nth 0 v)
1013     v))
1014
1015 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
1016 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
1017
1018 (defun* auth-source-netrc-create (&rest spec
1019                                         &key backend
1020                                         secret host user port create
1021                                         &allow-other-keys)
1022   (let* ((base-required '(host user port secret))
1023          ;; we know (because of an assertion in auth-source-search) that the
1024          ;; :create parameter is either t or a list (which includes nil)
1025          (create-extra (if (eq t create) nil create))
1026          (required (append base-required create-extra))
1027          (file (oref backend source))
1028          (add "")
1029          ;; `valist' is an alist
1030          valist
1031          ;; `artificial' will be returned if no creation is needed
1032          artificial)
1033
1034     ;; only for base required elements (defined as function parameters):
1035     ;; fill in the valist with whatever data we may have from the search
1036     ;; we complete the first value if it's a list and use the value otherwise
1037     (dolist (br base-required)
1038       (when (symbol-value br)
1039         (let ((br-choice (cond
1040                           ;; all-accepting choice (predicate is t)
1041                           ((eq t (symbol-value br)) nil)
1042                           ;; just the value otherwise
1043                           (t (symbol-value br)))))
1044           (when br-choice
1045             (aput 'valist br br-choice)))))
1046
1047     ;; for extra required elements, see if the spec includes a value for them
1048     (dolist (er create-extra)
1049       (let ((name (concat ":" (symbol-name er)))
1050             (keys (loop for i below (length spec) by 2
1051                         collect (nth i spec))))
1052         (dolist (k keys)
1053           (when (equal (symbol-name k) name)
1054             (aput 'valist er (plist-get spec k))))))
1055
1056     ;; for each required element
1057     (dolist (r required)
1058       (let* ((data (aget valist r))
1059              ;; take the first element if the data is a list
1060              (data (auth-source-netrc-element-or-first data))
1061              ;; this is the default to be offered
1062              (given-default (aget auth-source-creation-defaults r))
1063              ;; the default supplementals are simple:
1064              ;; for the user, try `given-default' and then (user-login-name);
1065              ;; otherwise take `given-default'
1066              (default (cond
1067                        ((and (not given-default) (eq r 'user))
1068                         (user-login-name))
1069                        (t given-default)))
1070              (printable-defaults (list
1071                                   (cons 'user
1072                                         (or
1073                                          (auth-source-netrc-element-or-first
1074                                           (aget valist 'user))
1075                                          (plist-get artificial :user)
1076                                          "[any user]"))
1077                                   (cons 'host
1078                                         (or
1079                                          (auth-source-netrc-element-or-first
1080                                           (aget valist 'host))
1081                                          (plist-get artificial :host)
1082                                          "[any host]"))
1083                                   (cons 'port
1084                                         (or
1085                                          (auth-source-netrc-element-or-first
1086                                           (aget valist 'port))
1087                                          (plist-get artificial :port)
1088                                          "[any port]"))))
1089              (prompt (or (aget auth-source-creation-prompts r)
1090                          (case r
1091                            (secret "%p password for %u@%h: ")
1092                            (user "%p user name for %h: ")
1093                            (host "%p host name for user %u: ")
1094                            (port "%p port for %u@%h: "))
1095                          (format "Enter %s (%%u@%%h:%%p): " r)))
1096              (prompt (auth-source-format-prompt
1097                       prompt
1098                       `((?u ,(aget printable-defaults 'user))
1099                         (?h ,(aget printable-defaults 'host))
1100                         (?p ,(aget printable-defaults 'port))))))
1101
1102         ;; store the data, prompting for the password if needed
1103         (setq data
1104               (cond
1105                ((and (null data) (eq r 'secret))
1106                 ;; special case prompt for passwords
1107                 (read-passwd prompt))
1108                ((null data)
1109                 (read-string prompt default))
1110                (t (or data default))))
1111
1112         (when data
1113           (setq artificial (plist-put artificial
1114                                       (intern (concat ":" (symbol-name r)))
1115                                       (if (eq r 'secret)
1116                                           (lexical-let ((data data))
1117                                             (lambda () data))
1118                                         data))))
1119
1120         ;; when r is not an empty string...
1121         (when (and (stringp data)
1122                    (< 0 (length data)))
1123           ;; this function is not strictly necessary but I think it
1124           ;; makes the code clearer -tzz
1125           (let ((printer (lambda ()
1126                            ;; append the key (the symbol name of r)
1127                            ;; and the value in r
1128                            (format "%s%s %S"
1129                                    ;; prepend a space
1130                                    (if (zerop (length add)) "" " ")
1131                                    ;; remap auth-source tokens to netrc
1132                                    (case r
1133                                      ('user   "login")
1134                                      ('host   "machine")
1135                                      ('secret "password")
1136                                      ('port   "port") ; redundant but clearer
1137                                      (t (symbol-name r)))
1138                                    ;; the value will be printed in %S format
1139                                    data))))
1140             (setq add (concat add (funcall printer)))))))
1141
1142     (plist-put
1143      artificial
1144      :save-function
1145      (lexical-let ((file file)
1146                    (add add))
1147        (lambda () (auth-source-netrc-saver file add))))
1148
1149     (list artificial)))
1150
1151 ;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch") :user "tzz" :port "imap" :create t :max 1)) :save-function))
1152 (defun auth-source-netrc-saver (file add)
1153   "Save a line ADD in FILE, prompting along the way.
1154 Respects `auth-source-save-behavior'."
1155   (with-temp-buffer
1156     (when (file-exists-p file)
1157       (insert-file-contents file))
1158     (when auth-source-gpg-encrypt-to
1159       ;; (see bug#7487) making `epa-file-encrypt-to' local to
1160       ;; this buffer lets epa-file skip the key selection query
1161       ;; (see the `local-variable-p' check in
1162       ;; `epa-file-write-region').
1163       (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
1164         (make-local-variable 'epa-file-encrypt-to))
1165       (if (listp auth-source-gpg-encrypt-to)
1166           (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
1167     ;; we want the new data to be found first, so insert at beginning
1168     (goto-char (point-min))
1169
1170     ;; ask AFTER we've successfully opened the file
1171     (let ((prompt (format "Save auth info to file %s? " file))
1172           (done (not (eq auth-source-save-behavior 'ask)))
1173           (bufname "*auth-source Help*")
1174           k)
1175       (while (not done)
1176         (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
1177         (case k
1178           (?y (setq done t))
1179           (?? (save-excursion
1180                 (with-output-to-temp-buffer bufname
1181                   (princ
1182                    (concat "(y)es, save\n"
1183                            "(n)o but use the info\n"
1184                            "(N)o and don't ask to save again\n"
1185                            "(e)dit the line\n"
1186                            "(?) for help as you can see.\n"))
1187                   (set-buffer standard-output)
1188                   (help-mode))))
1189           (?n (setq add ""
1190                     done t))
1191           (?N (setq add ""
1192                     done t
1193                     auth-source-save-behavior nil))
1194           (?e (setq add (read-string "Line to add: " add)))
1195           (t nil)))
1196
1197       (when (get-buffer-window bufname)
1198         (delete-window (get-buffer-window bufname)))
1199
1200       ;; make sure the info is not saved
1201       (when (null auth-source-save-behavior)
1202         (setq add ""))
1203
1204       (when (< 0 (length add))
1205         (progn
1206           (unless (bolp)
1207             (insert "\n"))
1208           (insert add "\n")
1209           (write-region (point-min) (point-max) file nil 'silent)
1210           (auth-source-do-debug
1211            "auth-source-netrc-create: wrote 1 new line to %s"
1212            file)
1213           (message "Saved new authentication information to %s" file)
1214           nil)))))
1215
1216 ;;; Backend specific parsing: Secrets API backend
1217
1218 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
1219 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
1220 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
1221 ;;; (let ((auth-sources '(default))) (auth-source-search))
1222 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
1223 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
1224
1225 (defun* auth-source-secrets-search (&rest
1226                                     spec
1227                                     &key backend create delete label
1228                                     type max host user port
1229                                     &allow-other-keys)
1230   "Search the Secrets API; spec is like `auth-source'.
1231
1232 The :label key specifies the item's label.  It is the only key
1233 that can specify a substring.  Any :label value besides a string
1234 will allow any label.
1235
1236 All other search keys must match exactly.  If you need substring
1237 matching, do a wider search and narrow it down yourself.
1238
1239 You'll get back all the properties of the token as a plist.
1240
1241 Here's an example that looks for the first item in the 'Login'
1242 Secrets collection:
1243
1244  \(let ((auth-sources '(\"secrets:Login\")))
1245     (auth-source-search :max 1)
1246
1247 Here's another that looks for the first item in the 'Login'
1248 Secrets collection whose label contains 'gnus':
1249
1250  \(let ((auth-sources '(\"secrets:Login\")))
1251     (auth-source-search :max 1 :label \"gnus\")
1252
1253 And this one looks for the first item in the 'Login' Secrets
1254 collection that's a Google Chrome entry for the git.gnus.org site
1255 authentication tokens:
1256
1257  \(let ((auth-sources '(\"secrets:Login\")))
1258     (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
1259 "
1260
1261   ;; TODO
1262   (assert (not create) nil
1263           "The Secrets API auth-source backend doesn't support creation yet")
1264   ;; TODO
1265   ;; (secrets-delete-item coll elt)
1266   (assert (not delete) nil
1267           "The Secrets API auth-source backend doesn't support deletion yet")
1268
1269   (let* ((coll (oref backend source))
1270          (max (or max 5000))     ; sanity check: default to stop at 5K
1271          (ignored-keys '(:create :delete :max :backend :label))
1272          (search-keys (loop for i below (length spec) by 2
1273                             unless (memq (nth i spec) ignored-keys)
1274                             collect (nth i spec)))
1275          ;; build a search spec without the ignored keys
1276          ;; if a search key is nil or t (match anything), we skip it
1277          (search-spec (apply 'append (mapcar
1278                                       (lambda (k)
1279                                         (if (or (null (plist-get spec k))
1280                                                 (eq t (plist-get spec k)))
1281                                             nil
1282                                           (list k (plist-get spec k))))
1283                               search-keys)))
1284          ;; needed keys (always including host, login, port, and secret)
1285          (returned-keys (mm-delete-duplicates (append
1286                                                '(:host :login :port :secret)
1287                                                search-keys)))
1288          (items (loop for item in (apply 'secrets-search-items coll search-spec)
1289                       unless (and (stringp label)
1290                                   (not (string-match label item)))
1291                       collect item))
1292          ;; TODO: respect max in `secrets-search-items', not after the fact
1293          (items (butlast items (- (length items) max)))
1294          ;; convert the item name to a full plist
1295          (items (mapcar (lambda (item)
1296                           (append
1297                            ;; make an entry for the secret (password) element
1298                            (list
1299                             :secret
1300                             (lexical-let ((v (secrets-get-secret coll item)))
1301                               (lambda () v)))
1302                            ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
1303                            (apply 'append
1304                                   (mapcar (lambda (entry)
1305                                             (list (car entry) (cdr entry)))
1306                                           (secrets-get-attributes coll item)))))
1307                         items))
1308          ;; ensure each item has each key in `returned-keys'
1309          (items (mapcar (lambda (plist)
1310                           (append
1311                            (apply 'append
1312                                   (mapcar (lambda (req)
1313                                             (if (plist-get plist req)
1314                                                 nil
1315                                               (list req nil)))
1316                                           returned-keys))
1317                            plist))
1318                         items)))
1319     items))
1320
1321 (defun* auth-source-secrets-create (&rest
1322                                     spec
1323                                     &key backend type max host user port
1324                                     &allow-other-keys)
1325   ;; TODO
1326   ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
1327   (debug spec))
1328
1329 ;;; older API
1330
1331 ;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
1332
1333 ;; deprecate the old interface
1334 (make-obsolete 'auth-source-user-or-password
1335                'auth-source-search "Emacs 24.1")
1336 (make-obsolete 'auth-source-forget-user-or-password
1337                'auth-source-forget "Emacs 24.1")
1338
1339 (defun auth-source-user-or-password
1340   (mode host port &optional username create-missing delete-existing)
1341   "Find MODE (string or list of strings) matching HOST and PORT.
1342
1343 DEPRECATED in favor of `auth-source-search'!
1344
1345 USERNAME is optional and will be used as \"login\" in a search
1346 across the Secret Service API (see secrets.el) if the resulting
1347 items don't have a username.  This means that if you search for
1348 username \"joe\" and it matches an item but the item doesn't have
1349 a :user attribute, the username \"joe\" will be returned.
1350
1351 A non nil DELETE-EXISTING means deleting any matching password
1352 entry in the respective sources.  This is useful only when
1353 CREATE-MISSING is non nil as well; the intended use case is to
1354 remove wrong password entries.
1355
1356 If no matching entry is found, and CREATE-MISSING is non nil,
1357 the password will be retrieved interactively, and it will be
1358 stored in the password database which matches best (see
1359 `auth-sources').
1360
1361 MODE can be \"login\" or \"password\"."
1362   (auth-source-do-debug
1363    "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
1364    mode host port username)
1365
1366   (let* ((listy (listp mode))
1367          (mode (if listy mode (list mode)))
1368          (cname (if username
1369                     (format "%s %s:%s %s" mode host port username)
1370                   (format "%s %s:%s" mode host port)))
1371          (search (list :host host :port port))
1372          (search (if username (append search (list :user username)) search))
1373          (search (if create-missing
1374                      (append search (list :create t))
1375                    search))
1376          (search (if delete-existing
1377                      (append search (list :delete t))
1378                    search))
1379          ;; (found (if (not delete-existing)
1380          ;;            (gethash cname auth-source-cache)
1381          ;;          (remhash cname auth-source-cache)
1382          ;;          nil)))
1383          (found nil))
1384     (if found
1385         (progn
1386           (auth-source-do-debug
1387            "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
1388            mode
1389            ;; don't show the password
1390            (if (and (member "password" mode) t)
1391                "SECRET"
1392              found)
1393            host port username)
1394           found)                        ; return the found data
1395       ;; else, if not found, search with a max of 1
1396       (let ((choice (nth 0 (apply 'auth-source-search
1397                                   (append '(:max 1) search)))))
1398         (when choice
1399           (dolist (m mode)
1400             (cond
1401              ((equal "password" m)
1402               (push (if (plist-get choice :secret)
1403                       (funcall (plist-get choice :secret))
1404                     nil) found))
1405              ((equal "login" m)
1406               (push (plist-get choice :user) found)))))
1407         (setq found (nreverse found))
1408         (setq found (if listy found (car-safe found)))))
1409
1410         found))
1411
1412 (provide 'auth-source)
1413
1414 ;;; auth-source.el ends here