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

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

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

;; This file is part of GNU Emacs.

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

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

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

;;; Commentary:

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

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

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

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

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

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

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

57 58
(defvar secrets-enabled)

Miles Bader's avatar
Miles Bader committed
59 60
(defgroup auth-source nil
  "Authentication sources."
Miles Bader's avatar
Miles Bader committed
61
  :version "23.1" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
62 63
  :group 'gnus)

64 65 66 67 68 69 70 71 72 73 74 75
;;;###autoload
(defcustom auth-source-cache-expiry 7200
  "How many seconds passwords are cached, or nil to disable
expiring.  Overrides `password-cache-expiry' through a
let-binding."
  :group 'auth-source
  :type '(choice (const :tag "Never" nil)
                 (const :tag "All Day" 86400)
                 (const :tag "2 Hours" 7200)
                 (const :tag "30 Minutes" 1800)
                 (integer :tag "Seconds")))

76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
(defclass auth-source-backend ()
  ((type :initarg :type
         :initform 'netrc
         :type symbol
         :custom symbol
         :documentation "The backend type.")
   (source :initarg :source
           :type string
           :custom string
           :documentation "The backend source.")
   (host :initarg :host
         :initform t
         :type t
         :custom string
         :documentation "The backend host.")
   (user :initarg :user
         :initform t
         :type t
         :custom string
         :documentation "The backend user.")
96 97 98 99 100
   (port :initarg :port
         :initform t
         :type t
         :custom string
         :documentation "The backend protocol.")
101 102 103 104 105 106 107 108 109 110 111
   (create-function :initarg :create-function
                    :initform ignore
                    :type function
                    :custom function
                    :documentation "The create function.")
   (search-function :initarg :search-function
                    :initform ignore
                    :type function
                    :custom function
                    :documentation "The search function.")))

Miles Bader's avatar
Miles Bader committed
112
(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
113 114 115 116
                                   (pop3 "pop3" "pop" "pop3s" "110" "995")
                                   (ssh  "ssh" "22")
                                   (sftp "sftp" "115")
                                   (smtp "smtp" "25"))
Miles Bader's avatar
Miles Bader committed
117 118 119
  "List of authentication protocols and their names"

  :group 'auth-source
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
120
  :version "23.2" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
121
  :type '(repeat :tag "Authentication Protocols"
122 123 124 125
                 (cons :tag "Protocol Entry"
                       (symbol :tag "Protocol")
                       (repeat :tag "Names"
                               (string :tag "Name")))))
Miles Bader's avatar
Miles Bader committed
126 127

;;; generate all the protocols in a format Customize can use
128
;;; TODO: generate on the fly from auth-source-protocols
Miles Bader's avatar
Miles Bader committed
129 130
(defconst auth-source-protocols-customize
  (mapcar (lambda (a)
131 132 133 134 135
            (let ((p (car-safe a)))
              (list 'const
                    :tag (upcase (symbol-name p))
                    p)))
          auth-source-protocols))
Miles Bader's avatar
Miles Bader committed
136

137 138 139 140 141 142
(defvar auth-source-creation-defaults nil
  "Defaults for creating token values.  Usually let-bound.")

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

(defvar auth-source-magic "auth-source-magic ")
Miles Bader's avatar
Miles Bader committed
143 144

(defcustom auth-source-do-cache t
145
  "Whether auth-source should cache information with `password-cache'."
Miles Bader's avatar
Miles Bader committed
146
  :group 'auth-source
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
147
  :version "23.2" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
148 149
  :type `boolean)

150
(defcustom auth-source-debug nil
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
151 152 153
  "Whether auth-source should log debug messages.

If the value is nil, debug messages are not logged.
154 155 156 157 158

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

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
159 160 161
If the value is a function, debug messages are logged by calling
 that function using the same arguments as `message'."
  :group 'auth-source
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
162
  :version "23.2" ;; No Gnus
163 164 165
  :type `(choice
          :tag "auth-source debugging mode"
          (const :tag "Log using `message' to the *Messages* buffer" t)
166 167
          (const :tag "Log all trivia with `message' to the *Messages* buffer"
                 trivia)
168 169
          (function :tag "Function that takes arguments like `message'")
          (const :tag "Don't log anything" nil)))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
170

171
(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
Miles Bader's avatar
Miles Bader committed
172 173
  "List of authentication sources.

174 175 176
The default will get login and password information from
\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
packages to be encrypted.  If that file doesn't exist, it will
177 178
try the unencrypted version \"~/.authinfo\" and the famous
\"~/.netrc\" file.
179 180

See the auth.info manual for details.
181

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
182 183 184 185
Each entry is the authentication type with optional properties.

It's best to customize this with `M-x customize-variable' because the choices
can get pretty complex."
Miles Bader's avatar
Miles Bader committed
186
  :group 'auth-source
187
  :version "24.1" ;; No Gnus
Miles Bader's avatar
Miles Bader committed
188
  :type `(repeat :tag "Authentication Sources"
189 190 191
                 (choice
                  (string :tag "Just a file")
                  (const :tag "Default Secrets API Collection" 'default)
192
                  (const :tag "Login Secrets API Collection" "secrets:Login")
193 194 195 196 197 198 199 200 201 202 203
                  (const :tag "Temp Secrets API Collection" "secrets:session")
                  (list :tag "Source definition"
                        (const :format "" :value :source)
                        (choice :tag "Authentication backend choice"
                                (string :tag "Authentication Source (file)")
                                (list
                                 :tag "Secret Service API/KWallet/GNOME Keyring"
                                 (const :format "" :value :secrets)
                                 (choice :tag "Collection to use"
                                         (string :tag "Collection name")
                                         (const :tag "Default" 'default)
204
                                         (const :tag "Login" "Login")
205 206 207 208 209 210 211 212 213 214 215 216 217
                                         (const
                                          :tag "Temporary" "session"))))
                        (repeat :tag "Extra Parameters" :inline t
                                (choice :tag "Extra parameter"
                                        (list
                                         :tag "Host"
                                         (const :format "" :value :host)
                                         (choice :tag "Host (machine) choice"
                                                 (const :tag "Any" t)
                                                 (regexp
                                                  :tag "Regular expression")))
                                        (list
                                         :tag "Protocol"
218
                                         (const :format "" :value :port)
219 220 221 222 223 224 225 226 227
                                         (choice
                                          :tag "Protocol"
                                          (const :tag "Any" t)
                                          ,@auth-source-protocols-customize))
                                        (list :tag "User" :inline t
                                              (const :format "" :value :user)
                                              (choice :tag "Personality/Username"
                                                      (const :tag "Any" t)
                                                      (string :tag "Name")))))))))
Miles Bader's avatar
Miles Bader committed
228

229 230 231 232
(defcustom auth-source-gpg-encrypt-to t
  "List of recipient keys that `authinfo.gpg' encrypted to.
If the value is not a list, symmetric encryption will be used."
  :group 'auth-source
233
  :version "24.1" ;; No Gnus
234
  :type '(choice (const :tag "Symmetric encryption" t)
235 236
                 (repeat :tag "Recipient public keys"
                         (string :tag "Recipient public key"))))
237

Miles Bader's avatar
Miles Bader committed
238
;; temp for debugging
Miles Bader's avatar
Miles Bader committed
239 240 241 242 243 244 245 246
;; (unintern 'auth-source-protocols)
;; (unintern 'auth-sources)
;; (customize-variable 'auth-sources)
;; (setq auth-sources nil)
;; (format "%S" auth-sources)
;; (customize-variable 'auth-source-protocols)
;; (setq auth-source-protocols nil)
;; (format "%S" auth-source-protocols)
247
;; (auth-source-pick nil :host "a" :port 'imap)
Miles Bader's avatar
Miles Bader committed
248 249 250 251 252 253
;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
;; (auth-source-protocol-defaults 'imap)

254 255 256
;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
257 258
(defun auth-source-do-debug (&rest msg)
  (when auth-source-debug
259 260
    (apply 'auth-source-do-warn msg)))

261 262 263 264 265
(defun auth-source-do-trivia (&rest msg)
  (when (or (eq auth-source-debug 'trivia)
            (functionp auth-source-debug))
    (apply 'auth-source-do-warn msg)))

266 267 268 269 270 271 272 273 274
(defun auth-source-do-warn (&rest msg)
  (apply
    ;; set logger to either the function in auth-source-debug or 'message
    ;; note that it will be 'message if auth-source-debug is nil
   (if (functionp auth-source-debug)
       auth-source-debug
     'message)
   msg))

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
275

276 277 278 279 280 281
;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
;; (auth-source-pick t :host "any" :port 'imap :user "joe")
;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
;;                   (:source (:secrets "session") :host t :port t :user "joe")
;;                   (:source (:secrets "Login") :host t :port t)
;;                   (:source "~/.authinfo.gpg" :host t :port t)))
282

283 284 285
;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
;;                   (:source (:secrets "session") :host t :port t :user "joe")
;;                   (:source (:secrets "Login") :host t :port t)
286
;;                   ))
287

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

290 291
;; (auth-source-backend-parse "myfile.gpg")
;; (auth-source-backend-parse 'default)
292
;; (auth-source-backend-parse "secrets:Login")
293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334

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

    ;; a file name with parameters
    ((stringp (plist-get entry :source))
     (auth-source-backend
      (plist-get entry :source)
      :source (plist-get entry :source)
      :type 'netrc
      :search-function 'auth-source-netrc-search
      :create-function 'auth-source-netrc-create))

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

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

       ;; if the source is a symbol, we look for the alias named so,
335
       ;; and if that alias is missing, we use "Login"
336 337
       (when (symbolp source)
         (setq source (or (secrets-get-alias (symbol-name source))
338
                          "Login")))
339

340 341 342 343 344 345 346 347 348 349 350 351 352
       (if (featurep 'secrets)
           (auth-source-backend
            (format "Secrets API (%s)" source)
            :source source
            :type 'secrets
            :search-function 'auth-source-secrets-search
            :create-function 'auth-source-secrets-create)
         (auth-source-do-warn
          "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
         (auth-source-backend
          (format "Ignored Secrets API (%s)" source)
          :source ""
          :type 'ignore))))
353 354 355

    ;; none of them
    (t
356
     (auth-source-do-warn
357 358 359 360 361 362 363 364
      "auth-source-backend-parse: invalid backend spec: %S" entry)
     (auth-source-backend
      "Empty"
      :source ""
      :type 'ignore)))))

(defun auth-source-backend-parse-parameters (entry backend)
  "Fills in the extra auth-source-backend parameters of ENTRY.
365 366
Using the plist ENTRY, get the :host, :port, and :user search
parameters."
367 368 369 370
  (let ((entry (if (stringp entry)
                   nil
                 entry))
        val)
371 372 373 374
    (when (setq val (plist-get entry :host))
      (oset backend host val))
    (when (setq val (plist-get entry :user))
      (oset backend user val))
375 376
    (when (setq val (plist-get entry :port))
      (oset backend port val)))
377 378 379 380 381
  backend)

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

(defun* auth-source-search (&rest spec
382
                                  &key type max host user port secret
383 384 385 386 387 388 389 390 391 392 393 394
                                  create delete
                                  &allow-other-keys)
  "Search or modify authentication backends according to SPEC.

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

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

395
Common search keys are :max, :host, :port, and :user.  In
396 397 398 399 400 401 402 403 404 405 406 407 408
addition, :create specifies how tokens will be or created.
Finally, :type can specify which backend types you want to check.

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

:create t means to create a token if possible.

A new token will be created if no matching tokens were found.
The new token will have only the keys the backend requires.  For
the netrc backend, for instance, that's the user, host, and
409
port keys.
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424

Here's an example:

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

which says:

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

 Create a new entry if you found none.  The netrc backend will
425
 automatically require host, user, and port.  The host will be
426
 'mine'.  We prompt for the user with default 'defaultUser' and
427
 for the port without a default.  We will not prompt for A, Q,
428
 or P.  The resulting token will only have keys user, host, and
429
 port.\"
430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453

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

The behavior is like :create t but if the list contains any
parameter, that parameter will be required in the resulting
token.  The value for that parameter will be obtained from the
search parameters or from user input.  If any queries are needed,
the alist `auth-source-creation-defaults' will be checked for the
default prompt.

Here's an example:

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

which says:

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

 Create a new entry if you found none.  The netrc backend will
454
 automatically require host, user, and port.  The host will be
455
 'nonesuch' and Q will be 'qqqq'.  We prompt for A with default
456
 'default A', for B and port with default nil, and for the
457
 user with default 'defaultUser'.  We will not prompt for Q.  The
458
 resulting token will have keys user, host, port, A, B, and Q.
459 460 461 462
 It will not have P with any value, even though P is used in the
 search to find only entries that have P set to 'pppp'.\"

When multiple values are specified in the search parameter, the
463 464
user is prompted for which one.  So :host (X Y Z) would ask the
user to choose between X, Y, and Z.
465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489

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

:delete t means to delete any found entries.  nil by default.
Use `auth-source-delete' in ELisp code instead of calling
`auth-source-search' directly with this parameter.

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

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

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

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

490
:port (P Q R) means to match only protocols P, Q, or R.
491 492 493 494 495 496
Defaults to t.

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

The return value is a list with at most :max tokens.  Each token
497
is a plist with keys :backend :host :port :user, plus any other
498 499 500 501 502 503 504 505 506 507 508 509
keys provided by the backend (notably :secret).  But note the
exception for :max 0, which see above.

The token's :secret key can hold a function.  In that case you
must call it to obtain the actual value."
  (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
         (max (or max 1))
         (ignored-keys '(:create :delete :max))
         (keys (loop for i below (length spec) by 2
                     unless (memq (nth i spec) ignored-keys)
                     collect (nth i spec)))
         (found (auth-source-recall spec))
510
         filtered-backends accessor-key backend)
511 512 513 514 515 516 517 518

    (if (and found auth-source-do-cache)
        (auth-source-do-debug
         "auth-source-search: found %d CACHED results matching %S"
         (length found) spec)

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

521
      (setq filtered-backends (copy-sequence backends))
522 523 524 525 526 527 528 529 530 531 532
      (dolist (backend backends)
        (dolist (key keys)
          ;; ignore invalid slots
          (condition-case signal
              (unless (eval `(auth-source-search-collection
                              (plist-get spec key)
                              (oref backend ,key)))
                (setq filtered-backends (delq backend filtered-backends))
                (return))
            (invalid-slot-name))))

533
      (auth-source-do-trivia
534 535 536 537
       "auth-source-search: found %d backends matching %S"
       (length filtered-backends) spec)

      ;; (debug spec "filtered" filtered-backends)
538 539
      ;; First go through all the backends without :create, so we can
      ;; query them all.
540 541 542 543 544 545 546 547 548 549 550
      (setq found (auth-source-search-backends filtered-backends
                                               spec
                                               ;; to exit early
                                               max
                                               ;; create and delete
                                               nil delete))

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

551 552
      ;; If we didn't find anything, then we allow the backend(s) to
      ;; create the entries.
553
      (when (and create
554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590
                 (not found))
        (setq found (auth-source-search-backends filtered-backends
                                                 spec
                                                 ;; to exit early
                                                 max
                                                 ;; create and delete
                                                 create delete))
        (auth-source-do-warn
         "auth-source-search: CREATED %d results (max %d) matching %S"
         (length found) max spec))

      (when (and found auth-source-do-cache)
        (auth-source-remember spec found)))

      found))

(defun auth-source-search-backends (backends spec max create delete)
  (let (matches)
    (dolist (backend backends)
      (when (> max (length matches))   ; when we need more matches...
        (let ((bmatches (apply
                         (slot-value backend 'search-function)
                         :backend backend
                         ;; note we're overriding whatever the spec
                         ;; has for :create and :delete
                         :create create
                         :delete delete
                         spec)))
          (when bmatches
            (auth-source-do-trivia
             "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
             (length bmatches) max
             (slot-value backend :type)
             (slot-value backend :source)
             spec)
            (setq matches (append matches bmatches))))))
    matches))
591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616

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

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

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

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

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

Miles Bader's avatar
Miles Bader committed
618
(defun auth-source-forget-all-cached ()
619
  "Forget all cached auth-source data."
Miles Bader's avatar
Miles Bader committed
620
  (interactive)
621 622 623 624 625 626 627 628 629
  (loop for sym being the symbols of password-data
        ;; when the symbol name starts with auth-source-magic
        when (string-match (concat "^" auth-source-magic)
                           (symbol-name sym))
        ;; remove that key
        do (password-cache-remove (symbol-name sym))))

(defun auth-source-remember (spec found)
  "Remember FOUND search results for SPEC."
630 631 632
  (let ((password-cache-expiry auth-source-cache-expiry))
    (password-cache-add
     (concat auth-source-magic (format "%S" spec)) found)))
633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687

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

(defun auth-source-forget (spec)
  "Forget any cached data matching SPEC exactly.

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

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

;;; (auth-source-remember '(:host "wedd") '(4 5 6))
;;; (auth-source-remember '(:host "xedd") '(1 2 3))
;;; (auth-source-recall '(:host "xedd"))
;;; (auth-source-recall '(:host t))
;;; (auth-source-forget+ :host t)

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

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

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

;;; Backend specific parsing: netrc/authinfo backend

688 689 690 691 692 693 694 695 696
(defun auth-source-ensure-strings (values)
  (unless (listp values)
    (setq values (list values)))
  (mapcar (lambda (value)
	    (if (numberp value)
		(format "%s" value)
	      value))
	  values))

697 698
(defvar auth-source-netrc-cache nil)

699 700 701
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
                                 spec
702
                                 &key file max host user port delete
703 704 705 706 707 708 709
                                 &allow-other-keys)
  "Parse FILE and return a list of all entries in the file.
Note that the MAX parameter is used so we can exit the parse early."
  (if (listp file)
      ;; We got already parsed contents; just return it.
      file
    (when (file-exists-p file)
710
      (setq port (auth-source-ensure-strings port))
711
      (with-temp-buffer
712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740
        (let* ((tokens '("machine" "host" "default" "login" "user"
                         "password" "account" "macdef" "force"
                         "port" "protocol"))
               (max (or max 5000))       ; sanity check: default to stop at 5K
               (modified 0)
               (cached (cdr-safe (assoc file auth-source-netrc-cache)))
               (cached-mtime (plist-get cached :mtime))
               (cached-secrets (plist-get cached :secret))
               alist elem result pair)

          (if (and (functionp cached-secrets)
                   (equal cached-mtime
                          (nth 5 (file-attributes file))))
              (progn
                (auth-source-do-trivia
                 "auth-source-netrc-parse: using CACHED file data for %s"
                 file)
                (insert (funcall cached-secrets)))
            (insert-file-contents file)
            ;; cache all netrc files (used to be just .gpg files)
            ;; Store the contents of the file heavily encrypted in memory.
            ;; (note for the irony-impaired: they are just obfuscated)
            (aput 'auth-source-netrc-cache file
                  (list :mtime (nth 5 (file-attributes file))
                        :secret (lexical-let ((v (rot13-string
                                                  (base64-encode-string
                                                   (buffer-string)))))
                                  (lambda () (base64-decode-string
                                         (rot13-string v)))))))
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786
          (goto-char (point-min))
          ;; Go through the file, line by line.
          (while (and (not (eobp))
                      (> max 0))

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

            (when (and alist
                       (> max 0)
                       (auth-source-search-collection
                        host
                        (or
                         (aget alist "machine")
787 788
                         (aget alist "host")
                         t))
789 790 791 792 793
                       (auth-source-search-collection
                        user
                        (or
                         (aget alist "login")
                         (aget alist "account")
794 795
                         (aget alist "user")
                         t))
796
                       (auth-source-search-collection
797
                        port
798 799
                        (or
                         (aget alist "port")
800 801
                         (aget alist "protocol")
                         t)))
802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866
              (decf max)
              (push (nreverse alist) result)
              ;; to delete a line, we just comment it out
              (when delete
                (goto-char (point-min))
                (insert "#")
                (incf modified)))
            (setq alist nil
                  pair nil)
            (widen)
            (forward-line 1))

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

            ;; ask AFTER we've successfully opened the file
            (when (y-or-n-p (format "Save file %s? (%d modifications)"
                                    file modified))
              (write-region (point-min) (point-max) file nil 'silent)
              (auth-source-do-debug
               "auth-source-netrc-parse: modified %d lines in %s"
               modified file)))

          (nreverse result))))))

(defun auth-source-netrc-normalize (alist)
  (mapcar (lambda (entry)
            (let (ret item)
              (while (setq item (pop entry))
                (let ((k (car item))
                      (v (cdr item)))

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

                  ;; send back the secret in a function (lexical binding)
                  (when (equal k "secret")
                    (setq v (lexical-let ((v v))
                              (lambda () v))))

                  (setq ret (plist-put ret
                                       (intern (concat ":" k))
                                       v))
                  ))
              ret))
          alist))

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

(defun* auth-source-netrc-search (&rest
                                  spec
                                  &key backend create delete
867
                                  type max host user port
868 869 870 871 872
                                  &allow-other-keys)
"Given a property list SPEC, return search matches from the :backend.
See `auth-source-search' for details on SPEC."
  ;; just in case, check that the type is correct (null or same as the backend)
  (assert (or (null type) (eq type (oref backend type)))
873
          t "Invalid netrc search: %s %s")
874 875 876 877 878 879 880 881

  (let ((results (auth-source-netrc-normalize
                  (auth-source-netrc-parse
                   :max max
                   :delete delete
                   :file (oref backend source)
                   :host (or host t)
                   :user (or user t)
882
                   :port (or port t)))))
883 884 885

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

888 889 890 891 892 893 894 895 896 897 898
      ;; create based on the spec and record the value
      (setq results (or
                     ;; if the user did not want to create the entry
                     ;; in the file, it will be returned
                     (apply (slot-value backend 'create-function) spec)
                     ;; if not, we do the search again without :create
                     ;; to get the updated data.

                     ;; the result will be returned, even if the search fails
                     (apply 'auth-source-netrc-search
                            (plist-put spec :create nil)))))
899 900 901 902 903 904 905
    results))

;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))

(defun* auth-source-netrc-create (&rest spec
                                        &key backend
906
                                        secret host user port create
907
                                        &allow-other-keys)
908
  (let* ((base-required '(host user port secret))
909 910 911 912 913 914 915
         ;; we know (because of an assertion in auth-source-search) that the
         ;; :create parameter is either t or a list (which includes nil)
         (create-extra (if (eq t create) nil create))
         (required (append base-required create-extra))
         (file (oref backend source))
         (add "")
         ;; `valist' is an alist
916 917 918
         valist
         ;; `artificial' will be returned if no creation is needed
         artificial)
919 920 921

    ;; only for base required elements (defined as function parameters):
    ;; fill in the valist with whatever data we may have from the search
922
    ;; we complete the first value if it's a list and use the value otherwise
923 924
    (dolist (br base-required)
      (when (symbol-value br)
925 926 927 928 929 930 931
        (let ((br-choice (cond
                          ;; all-accepting choice (predicate is t)
                          ((eq t (symbol-value br)) nil)
                          ;; just the value otherwise
                          (t (symbol-value br)))))
          (when br-choice
            (aput 'valist br br-choice)))))
932 933 934 935 936 937 938 939 940 941 942 943 944

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

    ;; for each required element
    (dolist (r required)
      (let* ((data (aget valist r))
945 946 947 948 949
             ;; take the first element if the data is a list
             (data (if (listp data)
                       (nth 0 data)
                     data))
             ;; this is the default to be offered
950
             (given-default (aget auth-source-creation-defaults r))
951 952
             ;; the default supplementals are simple: for the user,
             ;; try (user-login-name), otherwise take given-default
953 954 955
             (default (cond
                       ((and (not given-default) (eq r 'user))
                        (user-login-name))
956 957 958 959 960 961 962 963 964 965 966 967
                       (t given-default))))

        ;; store the data, prompting for the password if needed
        (setq data
              (cond
               ((and (null data) (eq r 'secret))
                ;; special case prompt for passwords
                (read-passwd (format "Password for %s@%s:%s: "
                                     (or (aget valist 'user) "[any user]")
                                     (or (aget valist 'host) "[any host]")
                                     (or (aget valist 'port) "[any port]"))))
               (t data)))
968

969 970 971 972 973 974 975 976
        (when data
          (setq artificial (plist-put artificial
                                      (intern (concat ":" (symbol-name r)))
                                      (if (eq r 'secret)
                                          (lexical-let ((data data))
                                            (lambda () data))
                                        data))))

977 978 979
        ;; when r is not an empty string...
        (when (and (stringp data)
                   (< 0 (length data)))
980 981 982
          ;; this function is not strictly necessary but I think it
          ;; makes the code clearer -tzz
          (let ((printer (lambda ()
983 984 985 986 987 988 989
                           ;; append the key (the symbol name of r)
                           ;; and the value in r
                           (format "%s%s %S"
                                   ;; prepend a space
                                   (if (zerop (length add)) "" " ")
                                   ;; remap auth-source tokens to netrc
                                   (case r
990 991
                                     ('user   "login")
                                     ('host   "machine")
992
                                     ('secret "password")
993
                                     ('port   "port") ; redundant but clearer
994
                                     (t (symbol-name r)))
995
                                   ;; the value will be printed in %S format
996 997
                                   data))))
            (setq add (concat add (funcall printer)))))))
998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013

    (with-temp-buffer
      (when (file-exists-p file)
        (insert-file-contents file))
      (when auth-source-gpg-encrypt-to
        ;; (see bug#7487) making `epa-file-encrypt-to' local to
        ;; this buffer lets epa-file skip the key selection query
        ;; (see the `local-variable-p' check in
        ;; `epa-file-write-region').
        (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
          (make-local-variable 'epa-file-encrypt-to))
        (if (listp auth-source-gpg-encrypt-to)
            (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
      (goto-char (point-max))

      ;; ask AFTER we've successfully opened the file
1014 1015 1016 1017
      (let ((prompt (format "Add to file %s? %s: "
                            file
                            "(y)es/(n)o but use it/(e)dit line/(s)kip file"))
            done k)
1018
        (while (not done)
1019
          (setq k (read-char prompt))
1020 1021 1022 1023 1024 1025 1026 1027 1028 1029
          (case k
            (?y (setq done t))
            (?n (setq add ""
                      done t))
            (?s (setq add ""
                      done 'skip))
            (?e (setq add (read-string "Line to add: " add)))
            (t nil)))

        (when (< 0 (length add))
1030 1031 1032 1033 1034
          (progn
            (unless (bolp)
              (insert "\n"))
            (insert add "\n")
            (write-region (point-min) (point-max) file nil 'silent)
1035
            (auth-source-do-warn
1036 1037
             "auth-source-netrc-create: wrote 1 new line to %s"
             file)
1038 1039 1040 1041
            nil))

        (when (eq done t)
          (list artificial))))))
1042 1043 1044 1045 1046 1047 1048

;;; Backend specific parsing: Secrets API backend

;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
;;; (let ((auth-sources '(default))) (auth-source-search))
1049 1050
;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
1051 1052 1053 1054

(defun* auth-source-secrets-search (&rest
                                    spec
                                    &key backend create delete label
1055
                                    type max host user port
1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067
                                    &allow-other-keys)
  "Search the Secrets API; spec is like `auth-source'.

The :label key specifies the item's label.  It is the only key
that can specify a substring.  Any :label value besides a string
will allow any label.

All other search keys must match exactly.  If you need substring
matching, do a wider search and narrow it down yourself.

You'll get back all the properties of the token as a plist.

1068
Here's an example that looks for the first item in the 'Login'
1069 1070
Secrets collection:

1071
 \(let ((auth-sources '(\"secrets:Login\")))
1072 1073
    (auth-source-search :max 1)

1074
Here's another that looks for the first item in the 'Login'
1075 1076
Secrets collection whose label contains 'gnus':

1077
 \(let ((auth-sources '(\"secrets:Login\")))
1078 1079
    (auth-source-search :max 1 :label \"gnus\")

1080
And this one looks for the first item in the 'Login' Secrets
1081
collection that's a Google Chrome entry for the git.gnus.org site
1082
authentication tokens:
1083

1084
 \(let ((auth-sources '(\"secrets:Login\")))
1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103
    (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
"

  ;; TODO
  (assert (not create) nil
          "The Secrets API auth-source backend doesn't support creation yet")
  ;; TODO
  ;; (secrets-delete-item coll elt)
  (assert (not delete) nil
          "The Secrets API auth-source backend doesn't support deletion yet")

  (let* ((coll (oref backend source))
         (max (or max 5000))     ; sanity check: default to stop at 5K
         (ignored-keys '(:create :delete :max :backend :label))
         (search-keys (loop for i below (length spec) by 2
                            unless (memq (nth i spec) ignored-keys)
                            collect (nth i spec)))
         ;; build a search spec without the ignored keys
         ;; if a search key is nil or t (match anything), we skip it
1104 1105 1106 1107 1108 1109 1110
         (search-spec (apply 'append (mapcar
                                      (lambda (k)
                                        (if (or (null (plist-get spec k))
                                                (eq t (plist-get spec k)))
                                            nil
                                          (list k (plist-get spec k))))
                              search-keys)))
1111
         ;; needed keys (always including host, login, port, and secret)
1112
         (returned-keys (mm-delete-duplicates (append
1113
					       '(:host :login :port :secret)
1114
					       search-keys)))
1115 1116 1117 1118 1119
         (items (loop for item in (apply 'secrets-search-items coll search-spec)
                      unless (and (stringp label)
                                  (not (string-match label item)))
                      collect item))
         ;; TODO: respect max in `secrets-search-items', not after the fact
1120
         (items (butlast items (- (length items) max)))
1121 1122 1123 1124 1125 1126 1127 1128 1129
         ;; convert the item name to a full plist
         (items (mapcar (lambda (item)
                          (append
                           ;; make an entry for the secret (password) element
                           (list
                            :secret
                            (lexical-let ((v (secrets-get-secret coll item)))
                              (lambda () v)))
                           ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
1130 1131 1132 1133
                           (apply 'append
                                  (mapcar (lambda (entry)
                                            (list (car entry) (cdr entry)))
                                          (secrets-get-attributes coll item)))))
1134 1135 1136 1137
                        items))
         ;; ensure each item has each key in `returned-keys'
         (items (mapcar (lambda (plist)
                          (append
1138 1139 1140 1141 1142 1143
                           (apply 'append
                                  (mapcar (lambda (req)
                                            (if (plist-get plist req)
                                                nil
                                              (list req nil)))
                                          returned-keys))
1144 1145 1146 1147 1148 1149
                           plist))
                        items)))
    items))

(defun* auth-source-secrets-create (&rest
                                    spec
1150
                                    &key backend type max host user port
1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164
                                    &allow-other-keys)
  ;; TODO
  ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
  (debug spec))

;;; older API

;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")

;; deprecate the old interface
(make-obsolete 'auth-source-user-or-password
               'auth-source-search "Emacs 24.1")
(make-obsolete 'auth-source-forget-user-or-password
               'auth-source-forget "Emacs 24.1")
1165

1166
(defun auth-source-user-or-password
1167 1168
  (mode host port &optional username create-missing delete-existing)
  "Find MODE (string or list of strings) matching HOST and PORT.
1169

1170 1171
DEPRECATED in favor of `auth-source-search'!

1172 1173 1174 1175 1176 1177
USERNAME is optional and will be used as \"login\" in a search
across the Secret Service API (see secrets.el) if the resulting
items don't have a username.  This means that if you search for
username \"joe\" and it matches an item but the item doesn't have
a :user attribute, the username \"joe\" will be returned.

1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188
A non nil DELETE-EXISTING means deleting any matching password
entry in the respective sources.  This is useful only when
CREATE-MISSING is non nil as well; the intended use case is to
remove wrong password entries.

If no matching entry is found, and CREATE-MISSING is non nil,
the password will be retrieved interactively, and it will be
stored in the password database which matches best (see
`auth-sources').

MODE can be \"login\" or \"password\"."
Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
1189
  (auth-source-do-debug
1190
   "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
1191
   mode host port username)
1192

Miles Bader's avatar
Miles Bader committed
1193
  (let* ((listy (listp mode))
1194 1195
         (mode (if listy mode (list mode)))
         (cname (if username
1196 1197 1198
                    (format "%s %s:%s %s" mode host port username)
                  (format "%s %s:%s" mode host port)))
         (search (list :host host :port port))
1199
         (search (if username (append search (list :user username)) search))
1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210
         (search (if create-missing
                     (append search (list :create t))
                   search))
         (search (if delete-existing
                     (append search (list :delete t))
                   search))
         ;; (found (if (not delete-existing)
         ;;            (gethash cname auth-source-cache)
         ;;          (remhash cname auth-source-cache)
         ;;          nil)))
         (found nil))
Miles Bader's avatar
Miles Bader committed
1211
    (if found
1212 1213
        (progn
          (auth-source-do-debug
1214
           "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
1215 1216
           mode
           ;; don't show the password
1217
           (if (and (member "password" mode) t)
1218 1219
               "SECRET"
             found)
1220
           host port username)
1221
          found)                        ; return the found data
1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235
      ;; else, if not found, search with a max of 1
      (let ((choice (nth 0 (apply 'auth-source-search
                                  (append '(:max 1) search)))))
        (when choice
          (dolist (m mode)
            (cond
             ((equal "password" m)
              (push (if (plist-get choice :secret)
                      (funcall (plist-get choice :secret))
                    nil) found))
             ((equal "login" m)
              (push (plist-get choice :user) found)))))
        (setq found (nreverse found))
        (setq found (if listy found (car-safe found)))))
Miles Bader's avatar