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 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
 151
 152 (defvar auth-source-magic "auth-source-magic ")
 153
 154 (defcustom auth-source-do-cache t
 155   "Whether auth-source should cache information with `password-cache'."
 156   :group 'auth-source
 157   :version "23.2" ;; No Gnus
 158   :type `boolean)
 159
 160 (defcustom auth-source-debug nil
 161   "Whether auth-source should log debug messages.
 162
 163 If the value is nil, debug messages are not logged.
 164
 165 If the value is t, debug messages are logged with `message'.  In
 166 that case, your authentication data will be in the clear (except
 167 for passwords).
 168
 169 If the value is a function, debug messages are logged by calling
 170  that function using the same arguments as `message'."
 171   :group 'auth-source
 172   :version "23.2" ;; No Gnus
 173   :type `(choice
 174           :tag "auth-source debugging mode"
 175           (const :tag "Log using `message' to the *Messages* buffer" t)
 176           (const :tag "Log all trivia with `message' to the *Messages* buffer"
 177                  trivia)
 178           (function :tag "Function that takes arguments like `message'")
 179           (const :tag "Don't log anything" nil)))
 180
 181 (defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
 182   "List of authentication sources.
 183
 184 The default will get login and password information from
 185 \"~/.authinfo.gpg\", which you should set up with the EPA/EPG
 186 packages to be encrypted.  If that file doesn't exist, it will
 187 try the unencrypted version \"~/.authinfo\" and the famous
 188 \"~/.netrc\" file.
 189
 190 See the auth.info manual for details.
 191
 192 Each entry is the authentication type with optional properties.
 193
 194 It's best to customize this with `M-x customize-variable' because the choices
 195 can get pretty complex."
 196   :group 'auth-source
 197   :version "24.1" ;; No Gnus
 198   :type `(repeat :tag "Authentication Sources"
 199                  (choice
 200                   (string :tag "Just a file")
 201                   (const :tag "Default Secrets API Collection" 'default)
 202                   (const :tag "Login Secrets API Collection" "secrets:Login")
 203                   (const :tag "Temp Secrets API Collection" "secrets:session")
 204                   (list :tag "Source definition"
 205                         (const :format "" :value :source)
 206                         (choice :tag "Authentication backend choice"
 207                                 (string :tag "Authentication Source (file)")
 208                                 (list
 209                                  :tag "Secret Service API/KWallet/GNOME Keyring"
 210                                  (const :format "" :value :secrets)
 211                                  (choice :tag "Collection to use"
 212                                          (string :tag "Collection name")
 213                                          (const :tag "Default" 'default)
 214                                          (const :tag "Login" "Login")
 215                                          (const
 216                                           :tag "Temporary" "session"))))
 217                         (repeat :tag "Extra Parameters" :inline t
 218                                 (choice :tag "Extra parameter"
 219                                         (list
 220                                          :tag "Host"
 221                                          (const :format "" :value :host)
 222                                          (choice :tag "Host (machine) choice"
 223                                                  (const :tag "Any" t)
 224                                                  (regexp
 225                                                   :tag "Regular expression")))
 226                                         (list
 227                                          :tag "Protocol"
 228                                          (const :format "" :value :port)
 229                                          (choice
 230                                           :tag "Protocol"
 231                                           (const :tag "Any" t)
 232                                           ,@auth-source-protocols-customize))
 233                                         (list :tag "User" :inline t
 234                                               (const :format "" :value :user)
 235                                               (choice :tag "Personality/Username"
 236                                                       (const :tag "Any" t)
 237                                                       (string :tag "Name")))))))))
 238
 239 (defcustom auth-source-gpg-encrypt-to t
 240   "List of recipient keys that `authinfo.gpg' encrypted to.
 241 If the value is not a list, symmetric encryption will be used."
 242   :group 'auth-source
 243   :version "24.1" ;; No Gnus
 244   :type '(choice (const :tag "Symmetric encryption" t)
 245                  (repeat :tag "Recipient public keys"
 246                          (string :tag "Recipient public key"))))
 247
 248 ;; temp for debugging
 249 ;; (unintern 'auth-source-protocols)
 250 ;; (unintern 'auth-sources)
 251 ;; (customize-variable 'auth-sources)
 252 ;; (setq auth-sources nil)
 253 ;; (format "%S" auth-sources)
 254 ;; (customize-variable 'auth-source-protocols)
 255 ;; (setq auth-source-protocols nil)
 256 ;; (format "%S" auth-source-protocols)
 257 ;; (auth-source-pick nil :host "a" :port 'imap)
 258 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
 259 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
 260 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
 261 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
 262 ;; (auth-source-protocol-defaults 'imap)
 263
 264 ;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
 265 ;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
 266 ;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
 267 (defun auth-source-do-debug (&rest msg)
 268   (when auth-source-debug
 269     (apply 'auth-source-do-warn msg)))
 270
 271 (defun auth-source-do-trivia (&rest msg)
 272   (when (or (eq auth-source-debug 'trivia)
 273             (functionp auth-source-debug))
 274     (apply 'auth-source-do-warn msg)))
 275
 276 (defun auth-source-do-warn (&rest msg)
 277   (apply
 278     ;; set logger to either the function in auth-source-debug or 'message
 279     ;; note that it will be 'message if auth-source-debug is nil
 280    (if (functionp auth-source-debug)
 281        auth-source-debug
 282      'message)
 283    msg))
 284
 285
 286 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
 287 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
 288 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 289 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 290 ;;                   (:source (:secrets "Login") :host t :port t)
 291 ;;                   (:source "~/.authinfo.gpg" :host t :port t)))
 292
 293 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
 294 ;;                   (:source (:secrets "session") :host t :port t :user "joe")
 295 ;;                   (:source (:secrets "Login") :host t :port t)
 296 ;;                   ))
 297
 298 ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
 299
 300 ;; (auth-source-backend-parse "myfile.gpg")
 301 ;; (auth-source-backend-parse 'default)
 302 ;; (auth-source-backend-parse "secrets:Login")
 303
 304 (defun auth-source-backend-parse (entry)
 305   "Creates an auth-source-backend from an ENTRY in `auth-sources'."
 306   (auth-source-backend-parse-parameters
 307    entry
 308    (cond
 309     ;; take 'default and recurse to get it as a Secrets API default collection
 310     ;; matching any user, host, and protocol
 311     ((eq entry 'default)
 312      (auth-source-backend-parse '(:source (:secrets default))))
 313     ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
 314     ;; matching any user, host, and protocol
 315     ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
 316      (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
 317     ;; take just a file name and recurse to get it as a netrc file
 318     ;; matching any user, host, and protocol
 319     ((stringp entry)
 320      (auth-source-backend-parse `(:source ,entry)))
 321
 322     ;; a file name with parameters
 323     ((stringp (plist-get entry :source))
 324      (auth-source-backend
 325       (plist-get entry :source)
 326       :source (plist-get entry :source)
 327       :type 'netrc
 328       :search-function 'auth-source-netrc-search
 329       :create-function 'auth-source-netrc-create))
 330
 331     ;; the Secrets API.  We require the package, in order to have a
 332     ;; defined value for `secrets-enabled'.
 333     ((and
 334       (not (null (plist-get entry :source))) ; the source must not be nil
 335       (listp (plist-get entry :source))      ; and it must be a list
 336       (require 'secrets nil t)               ; and we must load the Secrets API
 337       secrets-enabled)                       ; and that API must be enabled
 338
 339      ;; the source is either the :secrets key in ENTRY or
 340      ;; if that's missing or nil, it's "session"
 341      (let ((source (or (plist-get (plist-get entry :source) :secrets)
 342                        "session")))
 343
 344        ;; if the source is a symbol, we look for the alias named so,
 345        ;; and if that alias is missing, we use "Login"
 346        (when (symbolp source)
 347          (setq source (or (secrets-get-alias (symbol-name source))
 348                           "Login")))
 349
 350        (if (featurep 'secrets)
 351            (auth-source-backend
 352             (format "Secrets API (%s)" source)
 353             :source source
 354             :type 'secrets
 355             :search-function 'auth-source-secrets-search
 356             :create-function 'auth-source-secrets-create)
 357          (auth-source-do-warn
 358           "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
 359          (auth-source-backend
 360           (format "Ignored Secrets API (%s)" source)
 361           :source ""
 362           :type 'ignore))))
 363
 364     ;; none of them
 365     (t
 366      (auth-source-do-warn
 367       "auth-source-backend-parse: invalid backend spec: %S" entry)
 368      (auth-source-backend
 369       "Empty"
 370       :source ""
 371       :type 'ignore)))))
 372
 373 (defun auth-source-backend-parse-parameters (entry backend)
 374   "Fills in the extra auth-source-backend parameters of ENTRY.
 375 Using the plist ENTRY, get the :host, :port, and :user search
 376 parameters."
 377   (let ((entry (if (stringp entry)
 378                    nil
 379                  entry))
 380         val)
 381     (when (setq val (plist-get entry :host))
 382       (oset backend host val))
 383     (when (setq val (plist-get entry :user))
 384       (oset backend user val))
 385     (when (setq val (plist-get entry :port))
 386       (oset backend port val)))
 387   backend)
 388
 389 ;; (mapcar 'auth-source-backend-parse auth-sources)
 390
 391 (defun* auth-source-search (&rest spec
 392                                   &key type max host user port secret
 393                                   create delete
 394                                   &allow-other-keys)
 395   "Search or modify authentication backends according to SPEC.
 396
 397 This function parses `auth-sources' for matches of the SPEC
 398 plist.  It can optionally create or update an authentication
 399 token if requested.  A token is just a standard Emacs property
 400 list with a :secret property that can be a function; all the
 401 other properties will always hold scalar values.
 402
 403 Typically the :secret property, if present, contains a password.
 404
 405 Common search keys are :max, :host, :port, and :user.  In
 406 addition, :create specifies how tokens will be or created.
 407 Finally, :type can specify which backend types you want to check.
 408
 409 A string value is always matched literally.  A symbol is matched
 410 as its string value, literally.  All the SPEC values can be
 411 single values (symbol or string) or lists thereof (in which case
 412 any of the search terms matches).
 413
 414 :create t means to create a token if possible.
 415
 416 A new token will be created if no matching tokens were found.
 417 The new token will have only the keys the backend requires.  For
 418 the netrc backend, for instance, that's the user, host, and
 419 port keys.
 420
 421 Here's an example:
 422
 423 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
 424                                         (A    . \"default A\"))))
 425   (auth-source-search :host \"mine\" :type 'netrc :max 1
 426                       :P \"pppp\" :Q \"qqqq\"
 427                       :create t))
 428
 429 which says:
 430
 431 \"Search for any entry matching host 'mine' in backends of type
 432  'netrc', maximum one result.
 433
 434  Create a new entry if you found none.  The netrc backend will
 435  automatically require host, user, and port.  The host will be
 436  'mine'.  We prompt for the user with default 'defaultUser' and
 437  for the port without a default.  We will not prompt for A, Q,
 438  or P.  The resulting token will only have keys user, host, and
 439  port.\"
 440
 441 :create '(A B C) also means to create a token if possible.
 442
 443 The behavior is like :create t but if the list contains any
 444 parameter, that parameter will be required in the resulting
 445 token.  The value for that parameter will be obtained from the
 446 search parameters or from user input.  If any queries are needed,
 447 the alist `auth-source-creation-defaults' will be checked for the
 448 default prompt.
 449
 450 Here's an example:
 451
 452 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
 453                                         (A    . \"default A\"))))
 454   (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
 455                       :P \"pppp\" :Q \"qqqq\"
 456                       :create '(A B Q)))
 457
 458 which says:
 459
 460 \"Search for any entry matching host 'nonesuch'
 461  or 'twosuch' in backends of type 'netrc', maximum one result.
 462
 463  Create a new entry if you found none.  The netrc backend will
 464  automatically require host, user, and port.  The host will be
 465  'nonesuch' and Q will be 'qqqq'.  We prompt for A with default
 466  'default A', for B and port with default nil, and for the
 467  user with default 'defaultUser'.  We will not prompt for Q.  The
 468  resulting token will have keys user, host, port, A, B, and Q.
 469  It will not have P with any value, even though P is used in the
 470  search to find only entries that have P set to 'pppp'.\"
 471
 472 When multiple values are specified in the search parameter, the
 473 user is prompted for which one.  So :host (X Y Z) would ask the
 474 user to choose between X, Y, and Z.
 475
 476 This creation can fail if the search was not specific enough to
 477 create a new token (it's up to the backend to decide that).  You
 478 should `catch' the backend-specific error as usual.  Some
 479 backends (netrc, at least) will prompt the user rather than throw
 480 an error.
 481
 482 :delete t means to delete any found entries.  nil by default.
 483 Use `auth-source-delete' in ELisp code instead of calling
 484 `auth-source-search' directly with this parameter.
 485
 486 :type (X Y Z) will check only those backend types.  'netrc and
 487 'secrets are the only ones supported right now.
 488
 489 :max N means to try to return at most N items (defaults to 1).
 490 When 0 the function will return just t or nil to indicate if any
 491 matches were found.  More than N items may be returned, depending
 492 on the search and the backend.
 493
 494 :host (X Y Z) means to match only hosts X, Y, or Z according to
 495 the match rules above.  Defaults to t.
 496
 497 :user (X Y Z) means to match only users X, Y, or Z according to
 498 the match rules above.  Defaults to t.
 499
 500 :port (P Q R) means to match only protocols P, Q, or R.
 501 Defaults to t.
 502
 503 :K (V1 V2 V3) for any other key K will match values V1, V2, or
 504 V3 (note the match rules above).
 505
 506 The return value is a list with at most :max tokens.  Each token
 507 is a plist with keys :backend :host :port :user, plus any other
 508 keys provided by the backend (notably :secret).  But note the
 509 exception for :max 0, which see above.
 510
 511 The token's :secret key can hold a function.  In that case you
 512 must call it to obtain the actual value."
 513   (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
 514          (max (or max 1))
 515          (ignored-keys '(:create :delete :max))
 516          (keys (loop for i below (length spec) by 2
 517                      unless (memq (nth i spec) ignored-keys)
 518                      collect (nth i spec)))
 519          (found (auth-source-recall spec))
 520          filtered-backends accessor-key backend)
 521
 522     (if (and found auth-source-do-cache)
 523         (auth-source-do-debug
 524          "auth-source-search: found %d CACHED results matching %S"
 525          (length found) spec)
 526
 527       (assert
 528        (or (eq t create) (listp create)) t
 529        "Invalid auth-source :create parameter (must be t or a list): %s %s")
 530
 531       (setq filtered-backends (copy-sequence backends))
 532       (dolist (backend backends)
 533         (dolist (key keys)
 534           ;; ignore invalid slots
 535           (condition-case signal
 536               (unless (eval `(auth-source-search-collection
 537                               (plist-get spec key)
 538                               (oref backend ,key)))
 539                 (setq filtered-backends (delq backend filtered-backends))
 540                 (return))
 541             (invalid-slot-name))))
 542
 543       (auth-source-do-trivia
 544        "auth-source-search: found %d backends matching %S"
 545        (length filtered-backends) spec)
 546
 547       ;; (debug spec "filtered" filtered-backends)
 548       ;; First go through all the backends without :create, so we can
 549       ;; query them all.
 550       (setq found (auth-source-search-backends filtered-backends
 551                                                spec
 552                                                ;; to exit early
 553                                                max
 554                                                ;; create and delete
 555                                                nil delete))
 556
 557       (auth-source-do-debug
 558        "auth-source-search: found %d results (max %d) matching %S"
 559        (length found) max spec)
 560
 561       ;; If we didn't find anything, then we allow the backend(s) to
 562       ;; create the entries.
 563       (when (and create
 564                  (not found))
 565         (setq found (auth-source-search-backends filtered-backends
 566                                                  spec
 567                                                  ;; to exit early
 568                                                  max
 569                                                  ;; create and delete
 570                                                  create delete))
 571         (auth-source-do-warn
 572          "auth-source-search: CREATED %d results (max %d) matching %S"
 573          (length found) max spec))
 574
 575       (when (and found auth-source-do-cache)
 576         (auth-source-remember spec found)))
 577
 578       found))
 579
 580 (defun auth-source-search-backends (backends spec max create delete)
 581   (let (matches)
 582     (dolist (backend backends)
 583       (when (> max (length matches))   ; when we need more matches...
 584         (let ((bmatches (apply
 585                          (slot-value backend 'search-function)
 586                          :backend backend
 587                          ;; note we're overriding whatever the spec
 588                          ;; has for :create and :delete
 589                          :create create
 590                          :delete delete
 591                          spec)))
 592           (when bmatches
 593             (auth-source-do-trivia
 594              "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
 595              (length bmatches) max
 596              (slot-value backend :type)
 597              (slot-value backend :source)
 598              spec)
 599             (setq matches (append matches bmatches))))))
 600     matches))
 601
 602 ;;; (auth-source-search :max 1)
 603 ;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
 604 ;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
 605 ;;; (auth-source-search :host "nonesuch" :type 'secrets)
 606
 607 (defun* auth-source-delete (&rest spec
 608                                   &key delete
 609                                   &allow-other-keys)
 610   "Delete entries from the authentication backends according to SPEC.
 611 Calls `auth-source-search' with the :delete property in SPEC set to t.
 612 The backend may not actually delete the entries.
 613
 614 Returns the deleted entries."
 615   (auth-source-search (plist-put spec :delete t)))
 616
 617 (defun auth-source-search-collection (collection value)
 618   "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
 619   (when (and (atom collection) (not (eq t collection)))
 620     (setq collection (list collection)))
 621
 622   ;; (debug :collection collection :value value)
 623   (or (eq collection t)
 624       (eq value t)
 625       (equal collection value)
 626       (member value collection)))
 627
 628 (defun auth-source-forget-all-cached ()
 629   "Forget all cached auth-source data."
 630   (interactive)
 631   (loop for sym being the symbols of password-data
 632         ;; when the symbol name starts with auth-source-magic
 633         when (string-match (concat "^" auth-source-magic)
 634                            (symbol-name sym))
 635         ;; remove that key
 636         do (password-cache-remove (symbol-name sym))))
 637
 638 (defun auth-source-remember (spec found)
 639   "Remember FOUND search results for SPEC."
 640   (let ((password-cache-expiry auth-source-cache-expiry))
 641     (password-cache-add
 642      (concat auth-source-magic (format "%S" spec)) found)))
 643
 644 (defun auth-source-recall (spec)
 645   "Recall FOUND search results for SPEC."
 646   (password-read-from-cache
 647    (concat auth-source-magic (format "%S" spec))))
 648
 649 (defun auth-source-forget (spec)
 650   "Forget any cached data matching SPEC exactly.
 651
 652 This is the same SPEC you passed to `auth-source-search'.
 653 Returns t or nil for forgotten or not found."
 654   (password-cache-remove (concat auth-source-magic (format "%S" spec))))
 655
 656 ;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
 657
 658 ;;; (auth-source-remember '(:host "wedd") '(4 5 6))
 659 ;;; (auth-source-remember '(:host "xedd") '(1 2 3))
 660 ;;; (auth-source-recall '(:host "xedd"))
 661 ;;; (auth-source-recall '(:host t))
 662 ;;; (auth-source-forget+ :host t)
 663
 664 (defun* auth-source-forget+ (&rest spec &allow-other-keys)
 665   "Forget any cached data matching SPEC.  Returns forgotten count.
 666
 667 This is not a full `auth-source-search' spec but works similarly.
 668 For instance, \(:host \"myhost\" \"yourhost\") would find all the
 669 cached data that was found with a search for those two hosts,
 670 while \(:host t) would find all host entries."
 671   (let ((count 0)
 672         sname)
 673     (loop for sym being the symbols of password-data
 674           ;; when the symbol name matches with auth-source-magic
 675           when (and (setq sname (symbol-name sym))
 676                     (string-match (concat "^" auth-source-magic "\\(.+\\)")
 677                                   sname)
 678                     ;; and the spec matches what was stored in the cache
 679                     (auth-source-specmatchp spec (read (match-string 1 sname))))
 680           ;; remove that key
 681           do (progn
 682                (password-cache-remove sname)
 683                (incf count)))
 684     count))
 685
 686 (defun auth-source-specmatchp (spec stored)
 687   (let ((keys (loop for i below (length spec) by 2
 688                    collect (nth i spec))))
 689     (not (eq
 690           (dolist (key keys)
 691             (unless (auth-source-search-collection (plist-get stored key)
 692                                                    (plist-get spec key))
 693               (return 'no)))
 694           'no))))
 695
 696 ;;; Backend specific parsing: netrc/authinfo backend
 697
 698 (defun auth-source-ensure-strings (values)
 699   (unless (listp values)
 700     (setq values (list values)))
 701   (mapcar (lambda (value)
 702             (if (numberp value)
 703                 (format "%s" value)
 704               value))
 705           values))
 706
 707 (defvar auth-source-netrc-cache nil)
 708
 709 ;;; (auth-source-netrc-parse "~/.authinfo.gpg")
 710 (defun* auth-source-netrc-parse (&rest
 711                                  spec
 712                                  &key file max host user port delete
 713                                  &allow-other-keys)
 714   "Parse FILE and return a list of all entries in the file.
 715 Note that the MAX parameter is used so we can exit the parse early."
 716   (if (listp file)
 717       ;; We got already parsed contents; just return it.
 718       file
 719     (when (file-exists-p file)
 720       (setq port (auth-source-ensure-strings port))
 721       (with-temp-buffer
 722         (let* ((tokens '("machine" "host" "default" "login" "user"
 723                          "password" "account" "macdef" "force"
 724                          "port" "protocol"))
 725                (max (or max 5000))       ; sanity check: default to stop at 5K
 726                (modified 0)
 727                (cached (cdr-safe (assoc file auth-source-netrc-cache)))
 728                (cached-mtime (plist-get cached :mtime))
 729                (cached-secrets (plist-get cached :secret))
 730                alist elem result pair)
 731
 732           (if (and (functionp cached-secrets)
 733                    (equal cached-mtime
 734                           (nth 5 (file-attributes file))))
 735               (progn
 736                 (auth-source-do-trivia
 737                  "auth-source-netrc-parse: using CACHED file data for %s"
 738                  file)
 739                 (insert (funcall cached-secrets)))
 740             (insert-file-contents file)
 741             ;; cache all netrc files (used to be just .gpg files)
 742             ;; Store the contents of the file heavily encrypted in memory.
 743             ;; (note for the irony-impaired: they are just obfuscated)
 744             (aput 'auth-source-netrc-cache file
 745                   (list :mtime (nth 5 (file-attributes file))
 746                         :secret (lexical-let ((v (rot13-string
 747                                                   (base64-encode-string
 748                                                    (buffer-string)))))
 749                                   (lambda () (base64-decode-string
 750                                          (rot13-string v)))))))
 751           (goto-char (point-min))
 752           ;; Go through the file, line by line.
 753           (while (and (not (eobp))
 754                       (> max 0))
 755
 756             (narrow-to-region (point) (point-at-eol))
 757             ;; For each line, get the tokens and values.
 758             (while (not (eobp))
 759               (skip-chars-forward "\t ")
 760               ;; Skip lines that begin with a "#".
 761               (if (eq (char-after) ?#)
 762                   (goto-char (point-max))
 763                 (unless (eobp)
 764                   (setq elem
 765                         (if (= (following-char) ?\")
 766                             (read (current-buffer))
 767                           (buffer-substring
 768                            (point) (progn (skip-chars-forward "^\t ")
 769                                           (point)))))
 770                   (cond
 771                    ((equal elem "macdef")
 772                     ;; We skip past the macro definition.
 773                     (widen)
 774                     (while (and (zerop (forward-line 1))
 775                                 (looking-at "$")))
 776                     (narrow-to-region (point) (point)))
 777                    ((member elem tokens)
 778                     ;; Tokens that don't have a following value are ignored,
 779                     ;; except "default".
 780                     (when (and pair (or (cdr pair)
 781                                         (equal (car pair) "default")))
 782                       (push pair alist))
 783                     (setq pair (list elem)))
 784                    (t
 785                     ;; Values that haven't got a preceding token are ignored.
 786                     (when pair
 787                       (setcdr pair elem)
 788                       (push pair alist)
 789                       (setq pair nil)))))))
 790
 791             (when (and alist
 792                        (> max 0)
 793                        (auth-source-search-collection
 794                         host
 795                         (or
 796                          (aget alist "machine")
 797                          (aget alist "host")
 798                          t))
 799                        (auth-source-search-collection
 800                         user
 801                         (or
 802                          (aget alist "login")
 803                          (aget alist "account")
 804                          (aget alist "user")
 805                          t))
 806                        (auth-source-search-collection
 807                         port
 808                         (or
 809                          (aget alist "port")
 810                          (aget alist "protocol")
 811                          t)))
 812               (decf max)
 813               (push (nreverse alist) result)
 814               ;; to delete a line, we just comment it out
 815               (when delete
 816                 (goto-char (point-min))
 817                 (insert "#")
 818                 (incf modified)))
 819             (setq alist nil
 820                   pair nil)
 821             (widen)
 822             (forward-line 1))
 823
 824           (when (< 0 modified)
 825             (when auth-source-gpg-encrypt-to
 826               ;; (see bug#7487) making `epa-file-encrypt-to' local to
 827               ;; this buffer lets epa-file skip the key selection query
 828               ;; (see the `local-variable-p' check in
 829               ;; `epa-file-write-region').
 830               (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
 831                 (make-local-variable 'epa-file-encrypt-to))
 832               (if (listp auth-source-gpg-encrypt-to)
 833                   (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
 834
 835             ;; ask AFTER we've successfully opened the file
 836             (when (y-or-n-p (format "Save file %s? (%d modifications)"
 837                                     file modified))
 838               (write-region (point-min) (point-max) file nil 'silent)
 839               (auth-source-do-debug
 840                "auth-source-netrc-parse: modified %d lines in %s"
 841                modified file)))
 842
 843           (nreverse result))))))
 844
 845 (defun auth-source-netrc-normalize (alist)
 846   (mapcar (lambda (entry)
 847             (let (ret item)
 848               (while (setq item (pop entry))
 849                 (let ((k (car item))
 850                       (v (cdr item)))
 851
 852                   ;; apply key aliases
 853                   (setq k (cond ((member k '("machine")) "host")
 854                                 ((member k '("login" "account")) "user")
 855                                 ((member k '("protocol")) "port")
 856                                 ((member k '("password")) "secret")
 857                                 (t k)))
 858
 859                   ;; send back the secret in a function (lexical binding)
 860                   (when (equal k "secret")
 861                     (setq v (lexical-let ((v v))
 862                               (lambda () v))))
 863
 864                   (setq ret (plist-put ret
 865                                        (intern (concat ":" k))
 866                                        v))
 867                   ))
 868               ret))
 869           alist))
 870
 871 ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
 872 ;;; (funcall secret)
 873
 874 (defun* auth-source-netrc-search (&rest
 875                                   spec
 876                                   &key backend create delete
 877                                   type max host user port
 878                                   &allow-other-keys)
 879 "Given a property list SPEC, return search matches from the :backend.
 880 See `auth-source-search' for details on SPEC."
 881   ;; just in case, check that the type is correct (null or same as the backend)
 882   (assert (or (null type) (eq type (oref backend type)))
 883           t "Invalid netrc search: %s %s")
 884
 885   (let ((results (auth-source-netrc-normalize
 886                   (auth-source-netrc-parse
 887                    :max max
 888                    :delete delete
 889                    :file (oref backend source)
 890                    :host (or host t)
 891                    :user (or user t)
 892                    :port (or port t)))))
 893
 894     ;; if we need to create an entry AND none were found to match
 895     (when (and create
 896                (not results))
 897
 898       ;; create based on the spec and record the value
 899       (setq results (or
 900                      ;; if the user did not want to create the entry
 901                      ;; in the file, it will be returned
 902                      (apply (slot-value backend 'create-function) spec)
 903                      ;; if not, we do the search again without :create
 904                      ;; to get the updated data.
 905
 906                      ;; the result will be returned, even if the search fails
 907                      (apply 'auth-source-netrc-search
 908                             (plist-put spec :create nil)))))
 909     results))
 910
 911 (defun auth-source-netrc-element-or-first (v)
 912   (if (listp v)
 913       (nth 0 v)
 914     v))
 915
 916 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
 917 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
 918
 919 (defun* auth-source-netrc-create (&rest spec
 920                                         &key backend
 921                                         secret host user port create
 922                                         &allow-other-keys)
 923   (let* ((base-required '(host user port secret))
 924          ;; we know (because of an assertion in auth-source-search) that the
 925          ;; :create parameter is either t or a list (which includes nil)
 926          (create-extra (if (eq t create) nil create))
 927          (required (append base-required create-extra))
 928          (file (oref backend source))
 929          (add "")
 930          ;; `valist' is an alist
 931          valist
 932          ;; `artificial' will be returned if no creation is needed
 933          artificial)
 934
 935     ;; only for base required elements (defined as function parameters):
 936     ;; fill in the valist with whatever data we may have from the search
 937     ;; we complete the first value if it's a list and use the value otherwise
 938     (dolist (br base-required)
 939       (when (symbol-value br)
 940         (let ((br-choice (cond
 941                           ;; all-accepting choice (predicate is t)
 942                           ((eq t (symbol-value br)) nil)
 943                           ;; just the value otherwise
 944                           (t (symbol-value br)))))
 945           (when br-choice
 946             (aput 'valist br br-choice)))))
 947
 948     ;; for extra required elements, see if the spec includes a value for them
 949     (dolist (er create-extra)
 950       (let ((name (concat ":" (symbol-name er)))
 951             (keys (loop for i below (length spec) by 2
 952                         collect (nth i spec))))
 953         (dolist (k keys)
 954           (when (equal (symbol-name k) name)
 955             (aput 'valist er (plist-get spec k))))))
 956
 957     ;; for each required element
 958     (dolist (r required)
 959       (let* ((data (aget valist r))
 960              ;; take the first element if the data is a list
 961              (data (auth-source-netrc-element-or-first data))
 962              ;; this is the default to be offered
 963              (given-default (aget auth-source-creation-defaults r))
 964              ;; the default supplementals are simple: for the user,
 965              ;; try (user-login-name), otherwise take given-default
 966              (default (cond
 967                        ((and (not given-default) (eq r 'user))
 968                         (user-login-name))
 969                        (t given-default))))
 970
 971         ;; store the data, prompting for the password if needed
 972         (setq data
 973               (cond
 974                ((and (null data) (eq r 'secret))
 975                 ;; special case prompt for passwords
 976                 (read-passwd (format "Password for %s@%s:%s: "
 977                                      (or
 978                                       (auth-source-netrc-element-or-first
 979                                        (aget valist 'user))
 980                                       "[any user]")
 981                                      (or
 982                                       (auth-source-netrc-element-or-first
 983                                        (aget valist 'host))
 984                                       "[any host]")
 985                                      (or
 986                                       (auth-source-netrc-element-or-first
 987                                        (aget valist 'port))
 988                                       "[any port]"))))
 989                (t data)))
 990
 991         (when data
 992           (setq artificial (plist-put artificial
 993                                       (intern (concat ":" (symbol-name r)))
 994                                       (if (eq r 'secret)
 995                                           (lexical-let ((data data))
 996                                             (lambda () data))
 997                                         data))))
 998
 999         ;; when r is not an empty string...
1000         (when (and (stringp data)
1001                    (< 0 (length data)))
1002           ;; this function is not strictly necessary but I think it
1003           ;; makes the code clearer -tzz
1004           (let ((printer (lambda ()
1005                            ;; append the key (the symbol name of r)
1006                            ;; and the value in r
1007                            (format "%s%s %S"
1008                                    ;; prepend a space
1009                                    (if (zerop (length add)) "" " ")
1010                                    ;; remap auth-source tokens to netrc
1011                                    (case r
1012                                      ('user   "login")
1013                                      ('host   "machine")
1014                                      ('secret "password")
1015                                      ('port   "port") ; redundant but clearer
1016                                      (t (symbol-name r)))
1017                                    ;; the value will be printed in %S format
1018                                    data))))
1019             (setq add (concat add (funcall printer)))))))
1020
1021     (with-temp-buffer
1022       (when (file-exists-p file)
1023         (insert-file-contents file))
1024       (when auth-source-gpg-encrypt-to
1025         ;; (see bug#7487) making `epa-file-encrypt-to' local to
1026         ;; this buffer lets epa-file skip the key selection query
1027         ;; (see the `local-variable-p' check in
1028         ;; `epa-file-write-region').
1029         (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
1030           (make-local-variable 'epa-file-encrypt-to))
1031         (if (listp auth-source-gpg-encrypt-to)
1032             (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
1033       (goto-char (point-max))
1034
1035       ;; ask AFTER we've successfully opened the file
1036       (let ((prompt (format "Add to file %s? %s: "
1037                             file
1038                             "(y)es/(n)o but use it/(e)dit line/(s)kip file"))
1039             done k)
1040         (while (not done)
1041           (setq k (read-char prompt))
1042           (case k
1043             (?y (setq done t))
1044             (?n (setq add ""
1045                       done t))
1046             (?s (setq add ""
1047                       done 'skip))
1048             (?e (setq add (read-string "Line to add: " add)))
1049             (t nil)))
1050
1051         (when (< 0 (length add))
1052           (progn
1053             (unless (bolp)
1054               (insert "\n"))
1055             (insert add "\n")
1056             (write-region (point-min) (point-max) file nil 'silent)
1057             (auth-source-do-warn
1058              "auth-source-netrc-create: wrote 1 new line to %s"
1059              file)
1060             nil))
1061
1062         (when (eq done t)
1063           (list artificial))))))
1064
1065 ;;; Backend specific parsing: Secrets API backend
1066
1067 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
1068 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
1069 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
1070 ;;; (let ((auth-sources '(default))) (auth-source-search))
1071 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
1072 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
1073
1074 (defun* auth-source-secrets-search (&rest
1075                                     spec
1076                                     &key backend create delete label
1077                                     type max host user port
1078                                     &allow-other-keys)
1079   "Search the Secrets API; spec is like `auth-source'.
1080
1081 The :label key specifies the item's label.  It is the only key
1082 that can specify a substring.  Any :label value besides a string
1083 will allow any label.
1084
1085 All other search keys must match exactly.  If you need substring
1086 matching, do a wider search and narrow it down yourself.
1087
1088 You'll get back all the properties of the token as a plist.
1089
1090 Here's an example that looks for the first item in the 'Login'
1091 Secrets collection:
1092
1093  \(let ((auth-sources '(\"secrets:Login\")))
1094     (auth-source-search :max 1)
1095
1096 Here's another that looks for the first item in the 'Login'
1097 Secrets collection whose label contains 'gnus':
1098
1099  \(let ((auth-sources '(\"secrets:Login\")))
1100     (auth-source-search :max 1 :label \"gnus\")
1101
1102 And this one looks for the first item in the 'Login' Secrets
1103 collection that's a Google Chrome entry for the git.gnus.org site
1104 authentication tokens:
1105
1106  \(let ((auth-sources '(\"secrets:Login\")))
1107     (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
1108 "
1109
1110   ;; TODO
1111   (assert (not create) nil
1112           "The Secrets API auth-source backend doesn't support creation yet")
1113   ;; TODO
1114   ;; (secrets-delete-item coll elt)
1115   (assert (not delete) nil
1116           "The Secrets API auth-source backend doesn't support deletion yet")
1117
1118   (let* ((coll (oref backend source))
1119          (max (or max 5000))     ; sanity check: default to stop at 5K
1120          (ignored-keys '(:create :delete :max :backend :label))
1121          (search-keys (loop for i below (length spec) by 2
1122                             unless (memq (nth i spec) ignored-keys)
1123                             collect (nth i spec)))
1124          ;; build a search spec without the ignored keys
1125          ;; if a search key is nil or t (match anything), we skip it
1126          (search-spec (apply 'append (mapcar
1127                                       (lambda (k)
1128                                         (if (or (null (plist-get spec k))
1129                                                 (eq t (plist-get spec k)))
1130                                             nil
1131                                           (list k (plist-get spec k))))
1132                               search-keys)))
1133          ;; needed keys (always including host, login, port, and secret)
1134          (returned-keys (mm-delete-duplicates (append
1135                                                '(:host :login :port :secret)
1136                                                search-keys)))
1137          (items (loop for item in (apply 'secrets-search-items coll search-spec)
1138                       unless (and (stringp label)
1139                                   (not (string-match label item)))
1140                       collect item))
1141          ;; TODO: respect max in `secrets-search-items', not after the fact
1142          (items (butlast items (- (length items) max)))
1143          ;; convert the item name to a full plist
1144          (items (mapcar (lambda (item)
1145                           (append
1146                            ;; make an entry for the secret (password) element
1147                            (list
1148                             :secret
1149                             (lexical-let ((v (secrets-get-secret coll item)))
1150                               (lambda () v)))
1151                            ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
1152                            (apply 'append
1153                                   (mapcar (lambda (entry)
1154                                             (list (car entry) (cdr entry)))
1155                                           (secrets-get-attributes coll item)))))
1156                         items))
1157          ;; ensure each item has each key in `returned-keys'
1158          (items (mapcar (lambda (plist)
1159                           (append
1160                            (apply 'append
1161                                   (mapcar (lambda (req)
1162                                             (if (plist-get plist req)
1163                                                 nil
1164                                               (list req nil)))
1165                                           returned-keys))
1166                            plist))
1167                         items)))
1168     items))
1169
1170 (defun* auth-source-secrets-create (&rest
1171                                     spec
1172                                     &key backend type max host user port
1173                                     &allow-other-keys)
1174   ;; TODO
1175   ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
1176   (debug spec))
1177
1178 ;;; older API
1179
1180 ;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
1181
1182 ;; deprecate the old interface
1183 (make-obsolete 'auth-source-user-or-password
1184                'auth-source-search "Emacs 24.1")
1185 (make-obsolete 'auth-source-forget-user-or-password
1186                'auth-source-forget "Emacs 24.1")
1187
1188 (defun auth-source-user-or-password
1189   (mode host port &optional username create-missing delete-existing)
1190   "Find MODE (string or list of strings) matching HOST and PORT.
1191
1192 DEPRECATED in favor of `auth-source-search'!
1193
1194 USERNAME is optional and will be used as \"login\" in a search
1195 across the Secret Service API (see secrets.el) if the resulting
1196 items don't have a username.  This means that if you search for
1197 username \"joe\" and it matches an item but the item doesn't have
1198 a :user attribute, the username \"joe\" will be returned.
1199
1200 A non nil DELETE-EXISTING means deleting any matching password
1201 entry in the respective sources.  This is useful only when
1202 CREATE-MISSING is non nil as well; the intended use case is to
1203 remove wrong password entries.
1204
1205 If no matching entry is found, and CREATE-MISSING is non nil,
1206 the password will be retrieved interactively, and it will be
1207 stored in the password database which matches best (see
1208 `auth-sources').
1209
1210 MODE can be \"login\" or \"password\"."
1211   (auth-source-do-debug
1212    "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
1213    mode host port username)
1214
1215   (let* ((listy (listp mode))
1216          (mode (if listy mode (list mode)))
1217          (cname (if username
1218                     (format "%s %s:%s %s" mode host port username)
1219                   (format "%s %s:%s" mode host port)))
1220          (search (list :host host :port port))
1221          (search (if username (append search (list :user username)) search))
1222          (search (if create-missing
1223                      (append search (list :create t))
1224                    search))
1225          (search (if delete-existing
1226                      (append search (list :delete t))
1227                    search))
1228          ;; (found (if (not delete-existing)
1229          ;;            (gethash cname auth-source-cache)
1230          ;;          (remhash cname auth-source-cache)
1231          ;;          nil)))
1232          (found nil))
1233     (if found
1234         (progn
1235           (auth-source-do-debug
1236            "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
1237            mode
1238            ;; don't show the password
1239            (if (and (member "password" mode) t)
1240                "SECRET"
1241              found)
1242            host port username)
1243           found)                        ; return the found data
1244       ;; else, if not found, search with a max of 1
1245       (let ((choice (nth 0 (apply 'auth-source-search
1246                                   (append '(:max 1) search)))))
1247         (when choice
1248           (dolist (m mode)
1249             (cond
1250              ((equal "password" m)
1251               (push (if (plist-get choice :secret)
1252                       (funcall (plist-get choice :secret))
1253                     nil) found))
1254              ((equal "login" m)
1255               (push (plist-get choice :user) found)))))
1256         (setq found (nreverse found))
1257         (setq found (if listy found (car-safe found)))))
1258
1259         found))
1260
1261 (provide 'auth-source)
1262
1263 ;;; auth-source.el ends here