Prevent Gnus from loading PGG.
[bpt/emacs.git] / lisp / gnus / auth-source.el
CommitLineData
8f7abae3
MB
1;;; auth-source.el --- authentication sources for Gnus and Emacs
2
73b0cd50 3;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
8f7abae3
MB
4
5;; Author: Ted Zlatanov <tzz@lifelogs.com>
6;; Keywords: news
7
8;; This file is part of GNU Emacs.
9
5e809f55 10;; GNU Emacs is free software: you can redistribute it and/or modify
8f7abae3 11;; it under the terms of the GNU General Public License as published by
5e809f55
GM
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
8f7abae3
MB
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
5e809f55 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
8f7abae3
MB
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
5e809f55 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
8f7abae3
MB
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.
d55fe5bb 29
554a69b8 30;; See the auth.info Info documentation for details.
4079589f 31
cbabe91f
TZ
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
8f7abae3
MB
40;;; Code:
41
b8e0f0cd 42(require 'password-cache)
d638ac9e 43(require 'mm-util)
e952b711 44(require 'gnus-util)
b8e0f0cd 45(require 'assoc)
936d08bb
G
46(require 'epa)
47(require 'epg)
48
8f7abae3 49(eval-when-compile (require 'cl))
f3b54b0e 50(require 'eieio)
b8e0f0cd 51
0e4966fb
MA
52(autoload 'secrets-create-item "secrets")
53(autoload 'secrets-delete-item "secrets")
ec7995fa 54(autoload 'secrets-get-alias "secrets")
b8e0f0cd 55(autoload 'secrets-get-attributes "secrets")
fb178e4c 56(autoload 'secrets-get-secret "secrets")
0e4966fb
MA
57(autoload 'secrets-list-collections "secrets")
58(autoload 'secrets-search-items "secrets")
8f7abae3 59
4248cca2
TZ
60(autoload 'rfc2104-hash "rfc2104")
61
8977de27
DU
62(autoload 'plstore-open "plstore")
63(autoload 'plstore-find "plstore")
64(autoload 'plstore-put "plstore")
65(autoload 'plstore-save "plstore")
c302199d 66(autoload 'plstore-get-file "plstore")
8977de27 67
b8e0f0cd
G
68(defvar secrets-enabled)
69
8f7abae3
MB
70(defgroup auth-source nil
71 "Authentication sources."
9b3ebcb6 72 :version "23.1" ;; No Gnus
8f7abae3
MB
73 :group 'gnus)
74
584c9d3f
G
75;;;###autoload
76(defcustom auth-source-cache-expiry 7200
77 "How many seconds passwords are cached, or nil to disable
78expiring. Overrides `password-cache-expiry' through a
79let-binding."
80 :group 'auth-source
81 :type '(choice (const :tag "Never" nil)
82 (const :tag "All Day" 86400)
83 (const :tag "2 Hours" 7200)
84 (const :tag "30 Minutes" 1800)
85 (integer :tag "Seconds")))
86
b8e0f0cd
G
87(defclass auth-source-backend ()
88 ((type :initarg :type
89 :initform 'netrc
90 :type symbol
91 :custom symbol
92 :documentation "The backend type.")
93 (source :initarg :source
94 :type string
95 :custom string
96 :documentation "The backend source.")
97 (host :initarg :host
98 :initform t
99 :type t
100 :custom string
101 :documentation "The backend host.")
102 (user :initarg :user
103 :initform t
104 :type t
105 :custom string
106 :documentation "The backend user.")
35123c04
TZ
107 (port :initarg :port
108 :initform t
109 :type t
110 :custom string
111 :documentation "The backend protocol.")
8977de27
DU
112 (arg :initarg :arg
113 :initform nil
114 :documentation "The backend arg.")
b8e0f0cd
G
115 (create-function :initarg :create-function
116 :initform ignore
117 :type function
118 :custom function
119 :documentation "The create function.")
120 (search-function :initarg :search-function
121 :initform ignore
122 :type function
123 :custom function
124 :documentation "The search function.")))
125
9b3ebcb6 126(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
cbabe91f
TZ
127 (pop3 "pop3" "pop" "pop3s" "110" "995")
128 (ssh "ssh" "22")
129 (sftp "sftp" "115")
130 (smtp "smtp" "25"))
9b3ebcb6
MB
131 "List of authentication protocols and their names"
132
133 :group 'auth-source
ec7995fa 134 :version "23.2" ;; No Gnus
9b3ebcb6 135 :type '(repeat :tag "Authentication Protocols"
cbabe91f
TZ
136 (cons :tag "Protocol Entry"
137 (symbol :tag "Protocol")
138 (repeat :tag "Names"
139 (string :tag "Name")))))
9b3ebcb6
MB
140
141;;; generate all the protocols in a format Customize can use
fb178e4c 142;;; TODO: generate on the fly from auth-source-protocols
9b3ebcb6
MB
143(defconst auth-source-protocols-customize
144 (mapcar (lambda (a)
cbabe91f
TZ
145 (let ((p (car-safe a)))
146 (list 'const
147 :tag (upcase (symbol-name p))
148 p)))
149 auth-source-protocols))
9b3ebcb6 150
b8e0f0cd
G
151(defvar auth-source-creation-defaults nil
152 "Defaults for creating token values. Usually let-bound.")
153
003522ce
G
154(defvar auth-source-creation-prompts nil
155 "Default prompts for token values. Usually let-bound.")
156
b8e0f0cd
G
157(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
158
003522ce
G
159(defcustom auth-source-save-behavior 'ask
160 "If set, auth-source will respect it for save behavior."
161 :group 'auth-source
162 :version "23.2" ;; No Gnus
163 :type `(choice
164 :tag "auth-source new token save behavior"
165 (const :tag "Always save" t)
166 (const :tag "Never save" nil)
167 (const :tag "Ask" ask)))
168
61e6a0ac
TZ
169;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
170;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
171
172(defcustom auth-source-netrc-use-gpg-tokens 'never
173 "Set this to tell auth-source when to create GPG password
174tokens in netrc files. It's either an alist or `never'."
2b8c5660
TZ
175 :group 'auth-source
176 :version "23.2" ;; No Gnus
177 :type `(choice
61e6a0ac
TZ
178 (const :tag "Always use GPG password tokens" (t gpg))
179 (const :tag "Never use GPG password tokens" never)
180 (repeat :tag "Use a lookup list"
181 (list
182 (choice :tag "Matcher"
183 (const :tag "Match anything" t)
184 (const :tag "The EPA encrypted file extensions"
185 ,(if (boundp 'epa-file-auto-mode-alist-entry)
186 (car (symbol-value
187 'epa-file-auto-mode-alist-entry))
188 "\\.gpg\\'"))
189 (regexp :tag "Regular expression"))
190 (choice :tag "What to do"
191 (const :tag "Save GPG-encrypted password tokens" gpg)
192 (const :tag "Don't encrypt tokens" never))))))
2b8c5660 193
b8e0f0cd 194(defvar auth-source-magic "auth-source-magic ")
ed778fad
MB
195
196(defcustom auth-source-do-cache t
b8e0f0cd 197 "Whether auth-source should cache information with `password-cache'."
ed778fad 198 :group 'auth-source
ec7995fa 199 :version "23.2" ;; No Gnus
ed778fad
MB
200 :type `boolean)
201
a202ff49 202(defcustom auth-source-debug nil
554a69b8 203 "Whether auth-source should log debug messages.
554a69b8
KY
204
205If the value is nil, debug messages are not logged.
ca6ddb88
TZ
206
207If the value is t, debug messages are logged with `message'. In
208that case, your authentication data will be in the clear (except
209for passwords).
210
554a69b8
KY
211If the value is a function, debug messages are logged by calling
212 that function using the same arguments as `message'."
213 :group 'auth-source
ec7995fa 214 :version "23.2" ;; No Gnus
cbabe91f
TZ
215 :type `(choice
216 :tag "auth-source debugging mode"
217 (const :tag "Log using `message' to the *Messages* buffer" t)
4a3988d5
G
218 (const :tag "Log all trivia with `message' to the *Messages* buffer"
219 trivia)
cbabe91f
TZ
220 (function :tag "Function that takes arguments like `message'")
221 (const :tag "Don't log anything" nil)))
554a69b8 222
6a6e4d93 223(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
8f7abae3
MB
224 "List of authentication sources.
225
b8e0f0cd
G
226The default will get login and password information from
227\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
228packages to be encrypted. If that file doesn't exist, it will
4a3988d5
G
229try the unencrypted version \"~/.authinfo\" and the famous
230\"~/.netrc\" file.
b8e0f0cd
G
231
232See the auth.info manual for details.
fb178e4c 233
ec7995fa
KY
234Each entry is the authentication type with optional properties.
235
236It's best to customize this with `M-x customize-variable' because the choices
237can get pretty complex."
8f7abae3 238 :group 'auth-source
b8e0f0cd 239 :version "24.1" ;; No Gnus
9b3ebcb6 240 :type `(repeat :tag "Authentication Sources"
b8e0f0cd
G
241 (choice
242 (string :tag "Just a file")
243 (const :tag "Default Secrets API Collection" 'default)
5415d076 244 (const :tag "Login Secrets API Collection" "secrets:Login")
b8e0f0cd
G
245 (const :tag "Temp Secrets API Collection" "secrets:session")
246 (list :tag "Source definition"
247 (const :format "" :value :source)
248 (choice :tag "Authentication backend choice"
249 (string :tag "Authentication Source (file)")
250 (list
251 :tag "Secret Service API/KWallet/GNOME Keyring"
252 (const :format "" :value :secrets)
253 (choice :tag "Collection to use"
254 (string :tag "Collection name")
255 (const :tag "Default" 'default)
5415d076 256 (const :tag "Login" "Login")
b8e0f0cd
G
257 (const
258 :tag "Temporary" "session"))))
259 (repeat :tag "Extra Parameters" :inline t
260 (choice :tag "Extra parameter"
261 (list
262 :tag "Host"
263 (const :format "" :value :host)
264 (choice :tag "Host (machine) choice"
265 (const :tag "Any" t)
266 (regexp
267 :tag "Regular expression")))
268 (list
269 :tag "Protocol"
35123c04 270 (const :format "" :value :port)
b8e0f0cd
G
271 (choice
272 :tag "Protocol"
273 (const :tag "Any" t)
274 ,@auth-source-protocols-customize))
275 (list :tag "User" :inline t
276 (const :format "" :value :user)
61e6a0ac
TZ
277 (choice
278 :tag "Personality/Username"
b8e0f0cd 279 (const :tag "Any" t)
61e6a0ac
TZ
280 (string
281 :tag "Name")))))))))
8f7abae3 282
549c9aed
G
283(defcustom auth-source-gpg-encrypt-to t
284 "List of recipient keys that `authinfo.gpg' encrypted to.
285If the value is not a list, symmetric encryption will be used."
286 :group 'auth-source
b8e0f0cd 287 :version "24.1" ;; No Gnus
549c9aed 288 :type '(choice (const :tag "Symmetric encryption" t)
b8e0f0cd
G
289 (repeat :tag "Recipient public keys"
290 (string :tag "Recipient public key"))))
549c9aed 291
8f7abae3 292;; temp for debugging
9b3ebcb6
MB
293;; (unintern 'auth-source-protocols)
294;; (unintern 'auth-sources)
295;; (customize-variable 'auth-sources)
296;; (setq auth-sources nil)
297;; (format "%S" auth-sources)
298;; (customize-variable 'auth-source-protocols)
299;; (setq auth-source-protocols nil)
300;; (format "%S" auth-source-protocols)
fb178e4c 301;; (auth-source-pick nil :host "a" :port 'imap)
9b3ebcb6
MB
302;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
303;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
304;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
305;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
306;; (auth-source-protocol-defaults 'imap)
307
ca6ddb88
TZ
308;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
309;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
310;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
554a69b8 311(defun auth-source-do-debug (&rest msg)
554a69b8 312 (when auth-source-debug
ca6ddb88
TZ
313 (apply 'auth-source-do-warn msg)))
314
4a3988d5
G
315(defun auth-source-do-trivia (&rest msg)
316 (when (or (eq auth-source-debug 'trivia)
317 (functionp auth-source-debug))
318 (apply 'auth-source-do-warn msg)))
319
ca6ddb88
TZ
320(defun auth-source-do-warn (&rest msg)
321 (apply
322 ;; set logger to either the function in auth-source-debug or 'message
323 ;; note that it will be 'message if auth-source-debug is nil
324 (if (functionp auth-source-debug)
325 auth-source-debug
326 'message)
327 msg))
328
554a69b8 329
733afdf4
TZ
330;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
331(defun auth-source-read-char-choice (prompt choices)
332 "Read one of CHOICES by `read-char-choice', or `read-char'.
333`dropdown-list' support is disabled because it doesn't work reliably.
334Only one of CHOICES will be returned. The PROMPT is augmented
335with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
336 (when choices
337 (let* ((prompt-choices
338 (apply 'concat (loop for c in choices
339 collect (format "%c/" c))))
340 (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
341 (full-prompt (concat prompt prompt-choices))
342 k)
343
344 (while (not (memq k choices))
345 (setq k (cond
733afdf4
TZ
346 ((fboundp 'read-char-choice)
347 (read-char-choice full-prompt choices))
348 (t (message "%s" full-prompt)
349 (setq k (read-char))))))
350 k)))
351
35123c04
TZ
352;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
353;; (auth-source-pick t :host "any" :port 'imap :user "joe")
354;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
355;; (:source (:secrets "session") :host t :port t :user "joe")
356;; (:source (:secrets "Login") :host t :port t)
357;; (:source "~/.authinfo.gpg" :host t :port t)))
fb178e4c 358
35123c04
TZ
359;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
360;; (:source (:secrets "session") :host t :port t :user "joe")
361;; (:source (:secrets "Login") :host t :port t)
cbabe91f 362;; ))
fb178e4c 363
35123c04 364;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
fb178e4c 365
b8e0f0cd
G
366;; (auth-source-backend-parse "myfile.gpg")
367;; (auth-source-backend-parse 'default)
5415d076 368;; (auth-source-backend-parse "secrets:Login")
b8e0f0cd
G
369
370(defun auth-source-backend-parse (entry)
371 "Creates an auth-source-backend from an ENTRY in `auth-sources'."
372 (auth-source-backend-parse-parameters
373 entry
374 (cond
375 ;; take 'default and recurse to get it as a Secrets API default collection
376 ;; matching any user, host, and protocol
377 ((eq entry 'default)
378 (auth-source-backend-parse '(:source (:secrets default))))
379 ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
380 ;; matching any user, host, and protocol
381 ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
382 (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
383 ;; take just a file name and recurse to get it as a netrc file
384 ;; matching any user, host, and protocol
385 ((stringp entry)
386 (auth-source-backend-parse `(:source ,entry)))
387
388 ;; a file name with parameters
389 ((stringp (plist-get entry :source))
8977de27
DU
390 (if (equal (file-name-extension (plist-get entry :source)) "plist")
391 (auth-source-backend
392 (plist-get entry :source)
393 :source (plist-get entry :source)
394 :type 'plstore
395 :search-function 'auth-source-plstore-search
396 :create-function 'auth-source-plstore-create
397 :arg (plstore-open (plist-get entry :source)))
398 (auth-source-backend
399 (plist-get entry :source)
400 :source (plist-get entry :source)
401 :type 'netrc
402 :search-function 'auth-source-netrc-search
403 :create-function 'auth-source-netrc-create)))
b8e0f0cd
G
404
405 ;; the Secrets API. We require the package, in order to have a
406 ;; defined value for `secrets-enabled'.
407 ((and
408 (not (null (plist-get entry :source))) ; the source must not be nil
409 (listp (plist-get entry :source)) ; and it must be a list
410 (require 'secrets nil t) ; and we must load the Secrets API
411 secrets-enabled) ; and that API must be enabled
412
413 ;; the source is either the :secrets key in ENTRY or
414 ;; if that's missing or nil, it's "session"
415 (let ((source (or (plist-get (plist-get entry :source) :secrets)
416 "session")))
417
418 ;; if the source is a symbol, we look for the alias named so,
5415d076 419 ;; and if that alias is missing, we use "Login"
b8e0f0cd
G
420 (when (symbolp source)
421 (setq source (or (secrets-get-alias (symbol-name source))
5415d076 422 "Login")))
b8e0f0cd 423
ca6ddb88
TZ
424 (if (featurep 'secrets)
425 (auth-source-backend
426 (format "Secrets API (%s)" source)
427 :source source
428 :type 'secrets
429 :search-function 'auth-source-secrets-search
430 :create-function 'auth-source-secrets-create)
431 (auth-source-do-warn
432 "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
433 (auth-source-backend
434 (format "Ignored Secrets API (%s)" source)
435 :source ""
436 :type 'ignore))))
b8e0f0cd
G
437
438 ;; none of them
439 (t
ca6ddb88 440 (auth-source-do-warn
b8e0f0cd
G
441 "auth-source-backend-parse: invalid backend spec: %S" entry)
442 (auth-source-backend
443 "Empty"
444 :source ""
445 :type 'ignore)))))
446
447(defun auth-source-backend-parse-parameters (entry backend)
448 "Fills in the extra auth-source-backend parameters of ENTRY.
35123c04
TZ
449Using the plist ENTRY, get the :host, :port, and :user search
450parameters."
e45de620
TZ
451 (let ((entry (if (stringp entry)
452 nil
453 entry))
454 val)
b8e0f0cd
G
455 (when (setq val (plist-get entry :host))
456 (oset backend host val))
457 (when (setq val (plist-get entry :user))
458 (oset backend user val))
35123c04
TZ
459 (when (setq val (plist-get entry :port))
460 (oset backend port val)))
b8e0f0cd
G
461 backend)
462
463;; (mapcar 'auth-source-backend-parse auth-sources)
464
465(defun* auth-source-search (&rest spec
35123c04 466 &key type max host user port secret
733afdf4 467 require create delete
b8e0f0cd
G
468 &allow-other-keys)
469 "Search or modify authentication backends according to SPEC.
470
471This function parses `auth-sources' for matches of the SPEC
472plist. It can optionally create or update an authentication
473token if requested. A token is just a standard Emacs property
474list with a :secret property that can be a function; all the
475other properties will always hold scalar values.
476
477Typically the :secret property, if present, contains a password.
478
35123c04 479Common search keys are :max, :host, :port, and :user. In
b8e0f0cd
G
480addition, :create specifies how tokens will be or created.
481Finally, :type can specify which backend types you want to check.
482
483A string value is always matched literally. A symbol is matched
484as its string value, literally. All the SPEC values can be
485single values (symbol or string) or lists thereof (in which case
486any of the search terms matches).
487
488:create t means to create a token if possible.
489
490A new token will be created if no matching tokens were found.
491The new token will have only the keys the backend requires. For
492the netrc backend, for instance, that's the user, host, and
35123c04 493port keys.
b8e0f0cd
G
494
495Here's an example:
496
497\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
498 (A . \"default A\"))))
499 (auth-source-search :host \"mine\" :type 'netrc :max 1
500 :P \"pppp\" :Q \"qqqq\"
501 :create t))
502
503which says:
504
505\"Search for any entry matching host 'mine' in backends of type
506 'netrc', maximum one result.
507
508 Create a new entry if you found none. The netrc backend will
35123c04 509 automatically require host, user, and port. The host will be
b8e0f0cd 510 'mine'. We prompt for the user with default 'defaultUser' and
35123c04 511 for the port without a default. We will not prompt for A, Q,
b8e0f0cd 512 or P. The resulting token will only have keys user, host, and
35123c04 513 port.\"
b8e0f0cd
G
514
515:create '(A B C) also means to create a token if possible.
516
517The behavior is like :create t but if the list contains any
518parameter, that parameter will be required in the resulting
519token. The value for that parameter will be obtained from the
520search parameters or from user input. If any queries are needed,
521the alist `auth-source-creation-defaults' will be checked for the
003522ce
G
522default value. If the user, host, or port are missing, the alist
523`auth-source-creation-prompts' will be used to look up the
524prompts IN THAT ORDER (so the 'user prompt will be queried first,
525then 'host, then 'port, and finally 'secret). Each prompt string
526can use %u, %h, and %p to show the user, host, and port.
b8e0f0cd
G
527
528Here's an example:
529
530\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
003522ce
G
531 (A . \"default A\")))
532 (auth-source-creation-prompts
533 '((password . \"Enter IMAP password for %h:%p: \"))))
b8e0f0cd
G
534 (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
535 :P \"pppp\" :Q \"qqqq\"
536 :create '(A B Q)))
537
538which says:
539
540\"Search for any entry matching host 'nonesuch'
541 or 'twosuch' in backends of type 'netrc', maximum one result.
542
543 Create a new entry if you found none. The netrc backend will
35123c04 544 automatically require host, user, and port. The host will be
003522ce
G
545 'nonesuch' and Q will be 'qqqq'. We prompt for the password
546 with the shown prompt. We will not prompt for Q. The resulting
547 token will have keys user, host, port, A, B, and Q. It will not
548 have P with any value, even though P is used in the search to
549 find only entries that have P set to 'pppp'.\"
b8e0f0cd
G
550
551When multiple values are specified in the search parameter, the
7ba93e94
G
552user is prompted for which one. So :host (X Y Z) would ask the
553user to choose between X, Y, and Z.
b8e0f0cd
G
554
555This creation can fail if the search was not specific enough to
556create a new token (it's up to the backend to decide that). You
557should `catch' the backend-specific error as usual. Some
558backends (netrc, at least) will prompt the user rather than throw
559an error.
560
733afdf4
TZ
561:require (A B C) means that only results that contain those
562tokens will be returned. Thus for instance requiring :secret
563will ensure that any results will actually have a :secret
564property.
565
b8e0f0cd
G
566:delete t means to delete any found entries. nil by default.
567Use `auth-source-delete' in ELisp code instead of calling
568`auth-source-search' directly with this parameter.
569
570:type (X Y Z) will check only those backend types. 'netrc and
571'secrets are the only ones supported right now.
572
573:max N means to try to return at most N items (defaults to 1).
574When 0 the function will return just t or nil to indicate if any
575matches were found. More than N items may be returned, depending
576on the search and the backend.
577
578:host (X Y Z) means to match only hosts X, Y, or Z according to
579the match rules above. Defaults to t.
580
581:user (X Y Z) means to match only users X, Y, or Z according to
582the match rules above. Defaults to t.
583
35123c04 584:port (P Q R) means to match only protocols P, Q, or R.
b8e0f0cd
G
585Defaults to t.
586
587:K (V1 V2 V3) for any other key K will match values V1, V2, or
588V3 (note the match rules above).
589
590The return value is a list with at most :max tokens. Each token
35123c04 591is a plist with keys :backend :host :port :user, plus any other
b8e0f0cd
G
592keys provided by the backend (notably :secret). But note the
593exception for :max 0, which see above.
594
733afdf4
TZ
595The token can hold a :save-function key. If you call that, the
596user will be prompted to save the data to the backend. You can't
597request that this should happen right after creation, because
598`auth-source-search' has no way of knowing if the token is
599actually useful. So the caller must arrange to call this function.
600
b8e0f0cd
G
601The token's :secret key can hold a function. In that case you
602must call it to obtain the actual value."
603 (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
604 (max (or max 1))
733afdf4 605 (ignored-keys '(:require :create :delete :max))
b8e0f0cd
G
606 (keys (loop for i below (length spec) by 2
607 unless (memq (nth i spec) ignored-keys)
608 collect (nth i spec)))
61e9662e
TZ
609 (cached (auth-source-remembered-p spec))
610 ;; note that we may have cached results but found is still nil
611 ;; (there were no results from the search)
b8e0f0cd 612 (found (auth-source-recall spec))
4a3988d5 613 filtered-backends accessor-key backend)
b8e0f0cd 614
61e9662e 615 (if (and cached auth-source-do-cache)
b8e0f0cd
G
616 (auth-source-do-debug
617 "auth-source-search: found %d CACHED results matching %S"
618 (length found) spec)
619
620 (assert
621 (or (eq t create) (listp create)) t
4a3988d5 622 "Invalid auth-source :create parameter (must be t or a list): %s %s")
b8e0f0cd 623
733afdf4
TZ
624 (assert
625 (listp require) t
626 "Invalid auth-source :require parameter (must be a list): %s")
627
6ce6c742 628 (setq filtered-backends (copy-sequence backends))
b8e0f0cd
G
629 (dolist (backend backends)
630 (dolist (key keys)
631 ;; ignore invalid slots
632 (condition-case signal
633 (unless (eval `(auth-source-search-collection
634 (plist-get spec key)
635 (oref backend ,key)))
636 (setq filtered-backends (delq backend filtered-backends))
637 (return))
638 (invalid-slot-name))))
639
4a3988d5 640 (auth-source-do-trivia
b8e0f0cd
G
641 "auth-source-search: found %d backends matching %S"
642 (length filtered-backends) spec)
643
644 ;; (debug spec "filtered" filtered-backends)
1d2c4a49
LI
645 ;; First go through all the backends without :create, so we can
646 ;; query them all.
4a3988d5
G
647 (setq found (auth-source-search-backends filtered-backends
648 spec
649 ;; to exit early
650 max
733afdf4
TZ
651 ;; create is always nil here
652 nil delete
653 require))
4a3988d5
G
654
655 (auth-source-do-debug
656 "auth-source-search: found %d results (max %d) matching %S"
657 (length found) max spec)
658
1d2c4a49
LI
659 ;; If we didn't find anything, then we allow the backend(s) to
660 ;; create the entries.
38046520 661 (when (and create
4a3988d5
G
662 (not found))
663 (setq found (auth-source-search-backends filtered-backends
664 spec
665 ;; to exit early
666 max
733afdf4
TZ
667 create delete
668 require))
669 (auth-source-do-debug
4a3988d5
G
670 "auth-source-search: CREATED %d results (max %d) matching %S"
671 (length found) max spec))
672
61e9662e
TZ
673 ;; note we remember the lack of result too, if it's applicable
674 (when auth-source-do-cache
4a3988d5
G
675 (auth-source-remember spec found)))
676
677 found))
678
733afdf4 679(defun auth-source-search-backends (backends spec max create delete require)
4a3988d5
G
680 (let (matches)
681 (dolist (backend backends)
682 (when (> max (length matches)) ; when we need more matches...
733afdf4
TZ
683 (let* ((bmatches (apply
684 (slot-value backend 'search-function)
685 :backend backend
686 ;; note we're overriding whatever the spec
687 ;; has for :require, :create, and :delete
688 :require require
689 :create create
690 :delete delete
691 spec)))
4a3988d5
G
692 (when bmatches
693 (auth-source-do-trivia
694 "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
695 (length bmatches) max
696 (slot-value backend :type)
697 (slot-value backend :source)
698 spec)
699 (setq matches (append matches bmatches))))))
700 matches))
b8e0f0cd
G
701
702;;; (auth-source-search :max 1)
703;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
704;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
705;;; (auth-source-search :host "nonesuch" :type 'secrets)
706
707(defun* auth-source-delete (&rest spec
708 &key delete
709 &allow-other-keys)
710 "Delete entries from the authentication backends according to SPEC.
711Calls `auth-source-search' with the :delete property in SPEC set to t.
712The backend may not actually delete the entries.
713
714Returns the deleted entries."
715 (auth-source-search (plist-put spec :delete t)))
716
717(defun auth-source-search-collection (collection value)
718 "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
719 (when (and (atom collection) (not (eq t collection)))
720 (setq collection (list collection)))
721
722 ;; (debug :collection collection :value value)
723 (or (eq collection t)
724 (eq value t)
725 (equal collection value)
726 (member value collection)))
ed778fad 727
74e8193b
KY
728(defvar auth-source-netrc-cache nil)
729
3b36c17e 730(defun auth-source-forget-all-cached ()
b8e0f0cd 731 "Forget all cached auth-source data."
3b36c17e 732 (interactive)
b8e0f0cd
G
733 (loop for sym being the symbols of password-data
734 ;; when the symbol name starts with auth-source-magic
735 when (string-match (concat "^" auth-source-magic)
736 (symbol-name sym))
737 ;; remove that key
ddb7ffee
LMI
738 do (password-cache-remove (symbol-name sym)))
739 (setq auth-source-netrc-cache nil))
b8e0f0cd
G
740
741(defun auth-source-remember (spec found)
742 "Remember FOUND search results for SPEC."
584c9d3f
G
743 (let ((password-cache-expiry auth-source-cache-expiry))
744 (password-cache-add
745 (concat auth-source-magic (format "%S" spec)) found)))
b8e0f0cd
G
746
747(defun auth-source-recall (spec)
748 "Recall FOUND search results for SPEC."
749 (password-read-from-cache
750 (concat auth-source-magic (format "%S" spec))))
751
61e9662e
TZ
752(defun auth-source-remembered-p (spec)
753 "Check if SPEC is remembered."
754 (password-in-cache-p
755 (concat auth-source-magic (format "%S" spec))))
756
b8e0f0cd
G
757(defun auth-source-forget (spec)
758 "Forget any cached data matching SPEC exactly.
759
760This is the same SPEC you passed to `auth-source-search'.
761Returns t or nil for forgotten or not found."
762 (password-cache-remove (concat auth-source-magic (format "%S" spec))))
763
764;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
765
766;;; (auth-source-remember '(:host "wedd") '(4 5 6))
61e9662e 767;;; (auth-source-remembered-p '(:host "wedd"))
b8e0f0cd 768;;; (auth-source-remember '(:host "xedd") '(1 2 3))
61e9662e
TZ
769;;; (auth-source-remembered-p '(:host "xedd"))
770;;; (auth-source-remembered-p '(:host "zedd"))
b8e0f0cd
G
771;;; (auth-source-recall '(:host "xedd"))
772;;; (auth-source-recall '(:host t))
773;;; (auth-source-forget+ :host t)
774
775(defun* auth-source-forget+ (&rest spec &allow-other-keys)
776 "Forget any cached data matching SPEC. Returns forgotten count.
777
778This is not a full `auth-source-search' spec but works similarly.
779For instance, \(:host \"myhost\" \"yourhost\") would find all the
780cached data that was found with a search for those two hosts,
781while \(:host t) would find all host entries."
782 (let ((count 0)
783 sname)
784 (loop for sym being the symbols of password-data
785 ;; when the symbol name matches with auth-source-magic
786 when (and (setq sname (symbol-name sym))
787 (string-match (concat "^" auth-source-magic "\\(.+\\)")
788 sname)
789 ;; and the spec matches what was stored in the cache
790 (auth-source-specmatchp spec (read (match-string 1 sname))))
791 ;; remove that key
792 do (progn
793 (password-cache-remove sname)
794 (incf count)))
795 count))
796
797(defun auth-source-specmatchp (spec stored)
798 (let ((keys (loop for i below (length spec) by 2
799 collect (nth i spec))))
800 (not (eq
801 (dolist (key keys)
802 (unless (auth-source-search-collection (plist-get stored key)
803 (plist-get spec key))
804 (return 'no)))
805 'no))))
806
f3b54b0e
TZ
807;;; (auth-source-pick-first-password :host "z.lifelogs.com")
808;;; (auth-source-pick-first-password :port "imap")
809(defun auth-source-pick-first-password (&rest spec)
810 "Pick the first secret found from applying SPEC to `auth-source-search'."
811 (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
812 (secret (plist-get result :secret)))
813
814 (if (functionp secret)
815 (funcall secret)
816 secret)))
817
818;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
819(defun auth-source-format-prompt (prompt alist)
820 "Format PROMPT using %x (for any character x) specifiers in ALIST."
821 (dolist (cell alist)
822 (let ((c (nth 0 cell))
823 (v (nth 1 cell)))
824 (when (and c v)
4248cca2
TZ
825 (setq prompt (replace-regexp-in-string (format "%%%c" c)
826 (format "%s" v)
827 prompt)))))
f3b54b0e 828 prompt)
b8e0f0cd 829
8e22bee0
G
830(defun auth-source-ensure-strings (values)
831 (unless (listp values)
832 (setq values (list values)))
833 (mapcar (lambda (value)
834 (if (numberp value)
835 (format "%s" value)
836 value))
837 values))
838
f3b54b0e
TZ
839;;; Backend specific parsing: netrc/authinfo backend
840
b8e0f0cd
G
841;;; (auth-source-netrc-parse "~/.authinfo.gpg")
842(defun* auth-source-netrc-parse (&rest
843 spec
733afdf4 844 &key file max host user port delete require
b8e0f0cd
G
845 &allow-other-keys)
846 "Parse FILE and return a list of all entries in the file.
847Note that the MAX parameter is used so we can exit the parse early."
848 (if (listp file)
849 ;; We got already parsed contents; just return it.
850 file
851 (when (file-exists-p file)
8e22bee0 852 (setq port (auth-source-ensure-strings port))
b8e0f0cd 853 (with-temp-buffer
4a3988d5
G
854 (let* ((tokens '("machine" "host" "default" "login" "user"
855 "password" "account" "macdef" "force"
856 "port" "protocol"))
857 (max (or max 5000)) ; sanity check: default to stop at 5K
858 (modified 0)
859 (cached (cdr-safe (assoc file auth-source-netrc-cache)))
860 (cached-mtime (plist-get cached :mtime))
861 (cached-secrets (plist-get cached :secret))
862 alist elem result pair)
863
864 (if (and (functionp cached-secrets)
865 (equal cached-mtime
866 (nth 5 (file-attributes file))))
867 (progn
868 (auth-source-do-trivia
869 "auth-source-netrc-parse: using CACHED file data for %s"
870 file)
871 (insert (funcall cached-secrets)))
872 (insert-file-contents file)
873 ;; cache all netrc files (used to be just .gpg files)
874 ;; Store the contents of the file heavily encrypted in memory.
875 ;; (note for the irony-impaired: they are just obfuscated)
876 (aput 'auth-source-netrc-cache file
877 (list :mtime (nth 5 (file-attributes file))
878 :secret (lexical-let ((v (rot13-string
879 (base64-encode-string
880 (buffer-string)))))
881 (lambda () (base64-decode-string
882 (rot13-string v)))))))
b8e0f0cd
G
883 (goto-char (point-min))
884 ;; Go through the file, line by line.
885 (while (and (not (eobp))
886 (> max 0))
887
888 (narrow-to-region (point) (point-at-eol))
889 ;; For each line, get the tokens and values.
890 (while (not (eobp))
891 (skip-chars-forward "\t ")
892 ;; Skip lines that begin with a "#".
893 (if (eq (char-after) ?#)
894 (goto-char (point-max))
895 (unless (eobp)
896 (setq elem
897 (if (= (following-char) ?\")
898 (read (current-buffer))
899 (buffer-substring
900 (point) (progn (skip-chars-forward "^\t ")
901 (point)))))
902 (cond
903 ((equal elem "macdef")
904 ;; We skip past the macro definition.
905 (widen)
906 (while (and (zerop (forward-line 1))
907 (looking-at "$")))
908 (narrow-to-region (point) (point)))
909 ((member elem tokens)
910 ;; Tokens that don't have a following value are ignored,
911 ;; except "default".
912 (when (and pair (or (cdr pair)
913 (equal (car pair) "default")))
914 (push pair alist))
915 (setq pair (list elem)))
916 (t
917 ;; Values that haven't got a preceding token are ignored.
918 (when pair
919 (setcdr pair elem)
920 (push pair alist)
921 (setq pair nil)))))))
922
923 (when (and alist
924 (> max 0)
925 (auth-source-search-collection
926 host
927 (or
928 (aget alist "machine")
35123c04
TZ
929 (aget alist "host")
930 t))
b8e0f0cd
G
931 (auth-source-search-collection
932 user
933 (or
934 (aget alist "login")
935 (aget alist "account")
35123c04
TZ
936 (aget alist "user")
937 t))
b8e0f0cd 938 (auth-source-search-collection
35123c04 939 port
b8e0f0cd
G
940 (or
941 (aget alist "port")
35123c04 942 (aget alist "protocol")
733afdf4
TZ
943 t))
944 (or
945 ;; the required list of keys is nil, or
946 (null require)
947 ;; every element of require is in the normalized list
948 (let ((normalized (nth 0 (auth-source-netrc-normalize
2b8c5660 949 (list alist) file))))
733afdf4
TZ
950 (loop for req in require
951 always (plist-get normalized req)))))
b8e0f0cd
G
952 (decf max)
953 (push (nreverse alist) result)
954 ;; to delete a line, we just comment it out
955 (when delete
956 (goto-char (point-min))
957 (insert "#")
958 (incf modified)))
959 (setq alist nil
960 pair nil)
961 (widen)
962 (forward-line 1))
963
964 (when (< 0 modified)
965 (when auth-source-gpg-encrypt-to
966 ;; (see bug#7487) making `epa-file-encrypt-to' local to
967 ;; this buffer lets epa-file skip the key selection query
968 ;; (see the `local-variable-p' check in
969 ;; `epa-file-write-region').
970 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
971 (make-local-variable 'epa-file-encrypt-to))
972 (if (listp auth-source-gpg-encrypt-to)
973 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
974
975 ;; ask AFTER we've successfully opened the file
733afdf4 976 (when (y-or-n-p (format "Save file %s? (%d deletions)"
b8e0f0cd
G
977 file modified))
978 (write-region (point-min) (point-max) file nil 'silent)
979 (auth-source-do-debug
980 "auth-source-netrc-parse: modified %d lines in %s"
981 modified file)))
982
983 (nreverse result))))))
984
936d08bb
G
985(defvar auth-source-passphrase-alist nil)
986
987(defun auth-source-passphrase-callback-function (context key-id handback
988 &optional sym-detail)
989 "Exactly like `epa-passphrase-callback-function' but takes an
990extra SYM-DETAIL parameter which will be printed at the end of
991the symmetric passphrase prompt, and assumes symmetric
992encryption."
993 (read-passwd
994 (format "Passphrase for symmetric encryption%s%s: "
995 ;; Add the file name to the prompt, if any.
996 (if (stringp handback)
997 (format " for %s" handback)
998 "")
999 (if (stringp sym-detail)
1000 sym-detail
1001 ""))
1002 (eq (epg-context-operation context) 'encrypt)))
1003
1004(defun auth-source-token-passphrase-callback-function (context key-id file)
1005 (if (eq key-id 'SYM)
1006 (let* ((file (file-truename file))
1007 (entry (assoc file auth-source-passphrase-alist))
1008 passphrase)
1009 ;; return the saved passphrase, calling a function if needed
1010 (or (copy-sequence (if (functionp (cdr entry))
1011 (funcall (cdr entry))
1012 (cdr entry)))
1013 (progn
1014 (unless entry
1015 (setq entry (list file))
1016 (push entry auth-source-passphrase-alist))
1017 (setq passphrase (auth-source-passphrase-callback-function context
1018 key-id
1019 file
1020 " tokens"))
1021 (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
1022 (lambda () p)))
1023 passphrase)))
1024 (epa-passphrase-callback-function context key-id file)))
1025
1026;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc")
1027(defun auth-source-epa-extract-gpg-token (secret file)
1028 "Pass either the decoded SECRET or the gpg:BASE64DATA version.
1029FILE is the file from which we obtained this token."
1030 (when (string-match "^gpg:\\(.+\\)" secret)
1031 (setq secret (base64-decode-string (match-string 1 secret))))
1032 (let ((context (epg-make-context 'OpenPGP))
1033 plain)
1034 (epg-context-set-passphrase-callback
1035 context
1036 (cons #'auth-source-token-passphrase-callback-function
1037 file))
1038 (epg-decrypt-string context secret)))
1039
1040;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc"))
2b8c5660 1041(defun auth-source-epa-make-gpg-token (secret file)
936d08bb
G
1042 (let ((context (epg-make-context 'OpenPGP))
1043 (pp-escape-newlines nil)
1044 cipher)
1045 (epg-context-set-armor context t)
1046 (epg-context-set-passphrase-callback
1047 context
1048 (cons #'auth-source-token-passphrase-callback-function
1049 file))
1050 (setq cipher (epg-encrypt-string context secret nil))
1051 (with-temp-buffer
1052 (insert cipher)
1053 (base64-encode-region (point-min) (point-max) t)
1054 (concat "gpg:" (buffer-substring-no-properties
1055 (point-min)
1056 (point-max))))))
2b8c5660
TZ
1057
1058(defun auth-source-netrc-normalize (alist filename)
b8e0f0cd
G
1059 (mapcar (lambda (entry)
1060 (let (ret item)
1061 (while (setq item (pop entry))
1062 (let ((k (car item))
1063 (v (cdr item)))
1064
1065 ;; apply key aliases
1066 (setq k (cond ((member k '("machine")) "host")
1067 ((member k '("login" "account")) "user")
1068 ((member k '("protocol")) "port")
1069 ((member k '("password")) "secret")
1070 (t k)))
1071
1072 ;; send back the secret in a function (lexical binding)
1073 (when (equal k "secret")
936d08bb
G
1074 (setq v (lexical-let ((lexv v)
1075 (token-decoder nil))
1076 (when (string-match "^gpg:" lexv)
1077 ;; it's a GPG token: create a token decoder
1078 ;; which unsets itself once
1079 (setq token-decoder
1080 (lambda (val)
1081 (prog1
1082 (auth-source-epa-extract-gpg-token
1083 val
1084 filename)
1085 (setq token-decoder nil)))))
1086 (lambda ()
1087 (when token-decoder
1088 (setq lexv (funcall token-decoder lexv)))
1089 lexv))))
2b8c5660
TZ
1090 (setq ret (plist-put ret
1091 (intern (concat ":" k))
1092 v))))
1093 ret))
1094 alist))
b8e0f0cd
G
1095
1096;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
1097;;; (funcall secret)
1098
1099(defun* auth-source-netrc-search (&rest
1100 spec
733afdf4 1101 &key backend require create delete
35123c04 1102 type max host user port
b8e0f0cd
G
1103 &allow-other-keys)
1104"Given a property list SPEC, return search matches from the :backend.
1105See `auth-source-search' for details on SPEC."
1106 ;; just in case, check that the type is correct (null or same as the backend)
1107 (assert (or (null type) (eq type (oref backend type)))
d5e9a4e9 1108 t "Invalid netrc search: %s %s")
b8e0f0cd
G
1109
1110 (let ((results (auth-source-netrc-normalize
1111 (auth-source-netrc-parse
1112 :max max
733afdf4 1113 :require require
b8e0f0cd
G
1114 :delete delete
1115 :file (oref backend source)
1116 :host (or host t)
1117 :user (or user t)
2b8c5660
TZ
1118 :port (or port t))
1119 (oref backend source))))
b8e0f0cd
G
1120
1121 ;; if we need to create an entry AND none were found to match
1122 (when (and create
4a3988d5 1123 (not results))
b8e0f0cd 1124
584c9d3f
G
1125 ;; create based on the spec and record the value
1126 (setq results (or
1127 ;; if the user did not want to create the entry
1128 ;; in the file, it will be returned
1129 (apply (slot-value backend 'create-function) spec)
1130 ;; if not, we do the search again without :create
1131 ;; to get the updated data.
1132
1133 ;; the result will be returned, even if the search fails
1134 (apply 'auth-source-netrc-search
1135 (plist-put spec :create nil)))))
b8e0f0cd
G
1136 results))
1137
fa41748c
G
1138(defun auth-source-netrc-element-or-first (v)
1139 (if (listp v)
1140 (nth 0 v)
1141 v))
1142
b8e0f0cd
G
1143;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
1144;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
1145
1146(defun* auth-source-netrc-create (&rest spec
1147 &key backend
35123c04 1148 secret host user port create
b8e0f0cd 1149 &allow-other-keys)
35123c04 1150 (let* ((base-required '(host user port secret))
b8e0f0cd
G
1151 ;; we know (because of an assertion in auth-source-search) that the
1152 ;; :create parameter is either t or a list (which includes nil)
1153 (create-extra (if (eq t create) nil create))
ddb7ffee
LMI
1154 (current-data (car (auth-source-search :max 1
1155 :host host
1156 :port port)))
b8e0f0cd
G
1157 (required (append base-required create-extra))
1158 (file (oref backend source))
1159 (add "")
1160 ;; `valist' is an alist
584c9d3f
G
1161 valist
1162 ;; `artificial' will be returned if no creation is needed
1163 artificial)
b8e0f0cd
G
1164
1165 ;; only for base required elements (defined as function parameters):
1166 ;; fill in the valist with whatever data we may have from the search
7ba93e94 1167 ;; we complete the first value if it's a list and use the value otherwise
b8e0f0cd
G
1168 (dolist (br base-required)
1169 (when (symbol-value br)
7ba93e94
G
1170 (let ((br-choice (cond
1171 ;; all-accepting choice (predicate is t)
1172 ((eq t (symbol-value br)) nil)
1173 ;; just the value otherwise
1174 (t (symbol-value br)))))
1175 (when br-choice
1176 (aput 'valist br br-choice)))))
b8e0f0cd
G
1177
1178 ;; for extra required elements, see if the spec includes a value for them
1179 (dolist (er create-extra)
1180 (let ((name (concat ":" (symbol-name er)))
1181 (keys (loop for i below (length spec) by 2
1182 collect (nth i spec))))
1183 (dolist (k keys)
1184 (when (equal (symbol-name k) name)
1185 (aput 'valist er (plist-get spec k))))))
1186
1187 ;; for each required element
1188 (dolist (r required)
1189 (let* ((data (aget valist r))
4a3988d5 1190 ;; take the first element if the data is a list
ddb7ffee
LMI
1191 (data (or (auth-source-netrc-element-or-first data)
1192 (plist-get current-data
1193 (intern (format ":%s" r) obarray))))
4a3988d5 1194 ;; this is the default to be offered
b8e0f0cd 1195 (given-default (aget auth-source-creation-defaults r))
733afdf4
TZ
1196 ;; the default supplementals are simple:
1197 ;; for the user, try `given-default' and then (user-login-name);
1198 ;; otherwise take `given-default'
b8e0f0cd 1199 (default (cond
733afdf4
TZ
1200 ((and (not given-default) (eq r 'user))
1201 (user-login-name))
003522ce
G
1202 (t given-default)))
1203 (printable-defaults (list
1204 (cons 'user
1205 (or
1206 (auth-source-netrc-element-or-first
1207 (aget valist 'user))
1208 (plist-get artificial :user)
1209 "[any user]"))
1210 (cons 'host
1211 (or
1212 (auth-source-netrc-element-or-first
1213 (aget valist 'host))
1214 (plist-get artificial :host)
1215 "[any host]"))
1216 (cons 'port
1217 (or
1218 (auth-source-netrc-element-or-first
1219 (aget valist 'port))
1220 (plist-get artificial :port)
1221 "[any port]"))))
1222 (prompt (or (aget auth-source-creation-prompts r)
1223 (case r
733afdf4
TZ
1224 (secret "%p password for %u@%h: ")
1225 (user "%p user name for %h: ")
1226 (host "%p host name for user %u: ")
1227 (port "%p port for %u@%h: "))
003522ce
G
1228 (format "Enter %s (%%u@%%h:%%p): " r)))
1229 (prompt (auth-source-format-prompt
1230 prompt
1231 `((?u ,(aget printable-defaults 'user))
1232 (?h ,(aget printable-defaults 'host))
1233 (?p ,(aget printable-defaults 'port))))))
4a3988d5 1234
aa2ebce9 1235 ;; Store the data, prompting for the password if needed.
4a3988d5
G
1236 (setq data
1237 (cond
1238 ((and (null data) (eq r 'secret))
aa2ebce9 1239 ;; Special case prompt for passwords.
61e6a0ac
TZ
1240;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
1241;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
1242 (let* ((ep (format "Use GPG password tokens in %s?" file))
2b8c5660 1243 (gpg-encrypt
61e6a0ac
TZ
1244 (cond
1245 ((eq auth-source-netrc-use-gpg-tokens 'never)
1246 'never)
1247 ((listp auth-source-netrc-use-gpg-tokens)
1248 (let ((check (copy-sequence
1249 auth-source-netrc-use-gpg-tokens))
1250 item ret)
1251 (while check
1252 (setq item (pop check))
1253 (when (or (eq (car item) t)
1254 (string-match (car item) file))
1255 (setq ret (cdr item))
1256 (setq check nil)))))
1257 (t 'never)))
2b8c5660 1258 (plain (read-passwd prompt)))
61e6a0ac
TZ
1259 ;; ask if we don't know what to do (in which case
1260 ;; auth-source-netrc-use-gpg-tokens must be a list)
1261 (unless gpg-encrypt
1262 (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never))
1263 ;; TODO: save the defcustom now? or ask?
1264 (setq auth-source-netrc-use-gpg-tokens
1265 (cons `(,file ,gpg-encrypt)
1266 auth-source-netrc-use-gpg-tokens)))
1267 (if (eq gpg-encrypt 'gpg)
2b8c5660
TZ
1268 (auth-source-epa-make-gpg-token plain file)
1269 plain)))
003522ce 1270 ((null data)
67613d31 1271 (when default
aa2ebce9
SM
1272 (setq prompt
1273 (if (string-match ": *\\'" prompt)
1274 (concat (substring prompt 0 (match-beginning 0))
1275 " (default " default "): ")
1276 (concat prompt "(default " default ") "))))
4248cca2 1277 (read-string prompt nil nil default))
fa41748c 1278 (t (or data default))))
b8e0f0cd 1279
584c9d3f
G
1280 (when data
1281 (setq artificial (plist-put artificial
1282 (intern (concat ":" (symbol-name r)))
1283 (if (eq r 'secret)
1284 (lexical-let ((data data))
1285 (lambda () data))
1286 data))))
1287
aa2ebce9 1288 ;; When r is not an empty string...
b8e0f0cd
G
1289 (when (and (stringp data)
1290 (< 0 (length data)))
4a3988d5
G
1291 ;; this function is not strictly necessary but I think it
1292 ;; makes the code clearer -tzz
1293 (let ((printer (lambda ()
7ba93e94
G
1294 ;; append the key (the symbol name of r)
1295 ;; and the value in r
6a6e4d93 1296 (format "%s%s %s"
7ba93e94
G
1297 ;; prepend a space
1298 (if (zerop (length add)) "" " ")
1299 ;; remap auth-source tokens to netrc
1300 (case r
0adf5618
SM
1301 (user "login")
1302 (host "machine")
1303 (secret "password")
1304 (port "port") ; redundant but clearer
b8e0f0cd 1305 (t (symbol-name r)))
6a6e4d93
LMI
1306 (if (string-match "[\" ]" data)
1307 (format "%S" data)
1308 data)))))
4a3988d5 1309 (setq add (concat add (funcall printer)))))))
b8e0f0cd 1310
733afdf4
TZ
1311 (plist-put
1312 artificial
1313 :save-function
1314 (lexical-let ((file file)
1315 (add add))
1316 (lambda () (auth-source-netrc-saver file add))))
1317
1318 (list artificial)))
1319
4248cca2 1320;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch2") :user "tzz" :port "imap" :create t :max 1)) :save-function))
733afdf4
TZ
1321(defun auth-source-netrc-saver (file add)
1322 "Save a line ADD in FILE, prompting along the way.
4248cca2
TZ
1323Respects `auth-source-save-behavior'. Uses
1324`auth-source-netrc-cache' to avoid prompting more than once."
1325 (let* ((key (format "%s %s" file (rfc2104-hash 'md5 64 16 file add)))
1326 (cached (assoc key auth-source-netrc-cache)))
1327
1328 (if cached
1329 (auth-source-do-trivia
1330 "auth-source-netrc-saver: found previous run for key %s, returning"
1331 key)
1332 (with-temp-buffer
1333 (when (file-exists-p file)
1334 (insert-file-contents file))
1335 (when auth-source-gpg-encrypt-to
1336 ;; (see bug#7487) making `epa-file-encrypt-to' local to
1337 ;; this buffer lets epa-file skip the key selection query
1338 ;; (see the `local-variable-p' check in
1339 ;; `epa-file-write-region').
1340 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
1341 (make-local-variable 'epa-file-encrypt-to))
1342 (if (listp auth-source-gpg-encrypt-to)
1343 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
1344 ;; we want the new data to be found first, so insert at beginning
1345 (goto-char (point-min))
1346
aa2ebce9 1347 ;; Ask AFTER we've successfully opened the file.
4248cca2
TZ
1348 (let ((prompt (format "Save auth info to file %s? " file))
1349 (done (not (eq auth-source-save-behavior 'ask)))
1350 (bufname "*auth-source Help*")
1351 k)
1352 (while (not done)
1353 (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
1354 (case k
1355 (?y (setq done t))
1356 (?? (save-excursion
1357 (with-output-to-temp-buffer bufname
1358 (princ
1359 (concat "(y)es, save\n"
1360 "(n)o but use the info\n"
1361 "(N)o and don't ask to save again\n"
1362 "(e)dit the line\n"
1363 "(?) for help as you can see.\n"))
aa2ebce9
SM
1364 ;; Why? Doesn't with-output-to-temp-buffer already do
1365 ;; the exact same thing anyway? --Stef
4248cca2
TZ
1366 (set-buffer standard-output)
1367 (help-mode))))
1368 (?n (setq add ""
1369 done t))
3451795c
LMI
1370 (?N
1371 (setq add ""
1372 done t)
1373 (customize-save-variable 'auth-source-save-behavior nil))
4248cca2
TZ
1374 (?e (setq add (read-string "Line to add: " add)))
1375 (t nil)))
1376
1377 (when (get-buffer-window bufname)
1378 (delete-window (get-buffer-window bufname)))
1379
aa2ebce9 1380 ;; Make sure the info is not saved.
4248cca2
TZ
1381 (when (null auth-source-save-behavior)
1382 (setq add ""))
1383
1384 (when (< 0 (length add))
1385 (progn
1386 (unless (bolp)
1387 (insert "\n"))
1388 (insert add "\n")
1389 (write-region (point-min) (point-max) file nil 'silent)
1390 (auth-source-do-debug
1391 "auth-source-netrc-create: wrote 1 new line to %s"
1392 file)
1393 (message "Saved new authentication information to %s" file)
1394 nil))))
1395 (aput 'auth-source-netrc-cache key "ran"))))
b8e0f0cd
G
1396
1397;;; Backend specific parsing: Secrets API backend
1398
1399;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
1400;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
1401;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
1402;;; (let ((auth-sources '(default))) (auth-source-search))
5415d076
G
1403;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
1404;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
b8e0f0cd
G
1405
1406(defun* auth-source-secrets-search (&rest
1407 spec
1408 &key backend create delete label
35123c04 1409 type max host user port
b8e0f0cd
G
1410 &allow-other-keys)
1411 "Search the Secrets API; spec is like `auth-source'.
1412
1413The :label key specifies the item's label. It is the only key
1414that can specify a substring. Any :label value besides a string
1415will allow any label.
1416
1417All other search keys must match exactly. If you need substring
1418matching, do a wider search and narrow it down yourself.
1419
1420You'll get back all the properties of the token as a plist.
1421
5415d076 1422Here's an example that looks for the first item in the 'Login'
b8e0f0cd
G
1423Secrets collection:
1424
5415d076 1425 \(let ((auth-sources '(\"secrets:Login\")))
b8e0f0cd
G
1426 (auth-source-search :max 1)
1427
5415d076 1428Here's another that looks for the first item in the 'Login'
b8e0f0cd
G
1429Secrets collection whose label contains 'gnus':
1430
5415d076 1431 \(let ((auth-sources '(\"secrets:Login\")))
b8e0f0cd
G
1432 (auth-source-search :max 1 :label \"gnus\")
1433
5415d076 1434And this one looks for the first item in the 'Login' Secrets
b8e0f0cd 1435collection that's a Google Chrome entry for the git.gnus.org site
5415d076 1436authentication tokens:
b8e0f0cd 1437
5415d076 1438 \(let ((auth-sources '(\"secrets:Login\")))
b8e0f0cd
G
1439 (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
1440"
1441
1442 ;; TODO
1443 (assert (not create) nil
1444 "The Secrets API auth-source backend doesn't support creation yet")
1445 ;; TODO
1446 ;; (secrets-delete-item coll elt)
1447 (assert (not delete) nil
1448 "The Secrets API auth-source backend doesn't support deletion yet")
1449
1450 (let* ((coll (oref backend source))
1451 (max (or max 5000)) ; sanity check: default to stop at 5K
1452 (ignored-keys '(:create :delete :max :backend :label))
1453 (search-keys (loop for i below (length spec) by 2
1454 unless (memq (nth i spec) ignored-keys)
1455 collect (nth i spec)))
1456 ;; build a search spec without the ignored keys
1457 ;; if a search key is nil or t (match anything), we skip it
5415d076
G
1458 (search-spec (apply 'append (mapcar
1459 (lambda (k)
1460 (if (or (null (plist-get spec k))
1461 (eq t (plist-get spec k)))
1462 nil
1463 (list k (plist-get spec k))))
1464 search-keys)))
35123c04 1465 ;; needed keys (always including host, login, port, and secret)
d638ac9e 1466 (returned-keys (mm-delete-duplicates (append
35123c04 1467 '(:host :login :port :secret)
d638ac9e 1468 search-keys)))
b8e0f0cd
G
1469 (items (loop for item in (apply 'secrets-search-items coll search-spec)
1470 unless (and (stringp label)
1471 (not (string-match label item)))
1472 collect item))
1473 ;; TODO: respect max in `secrets-search-items', not after the fact
5415d076 1474 (items (butlast items (- (length items) max)))
b8e0f0cd
G
1475 ;; convert the item name to a full plist
1476 (items (mapcar (lambda (item)
1477 (append
1478 ;; make an entry for the secret (password) element
1479 (list
1480 :secret
1481 (lexical-let ((v (secrets-get-secret coll item)))
1482 (lambda () v)))
1483 ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
5415d076
G
1484 (apply 'append
1485 (mapcar (lambda (entry)
1486 (list (car entry) (cdr entry)))
1487 (secrets-get-attributes coll item)))))
b8e0f0cd
G
1488 items))
1489 ;; ensure each item has each key in `returned-keys'
1490 (items (mapcar (lambda (plist)
1491 (append
5415d076
G
1492 (apply 'append
1493 (mapcar (lambda (req)
1494 (if (plist-get plist req)
1495 nil
1496 (list req nil)))
1497 returned-keys))
b8e0f0cd
G
1498 plist))
1499 items)))
1500 items))
1501
1502(defun* auth-source-secrets-create (&rest
1503 spec
35123c04 1504 &key backend type max host user port
b8e0f0cd
G
1505 &allow-other-keys)
1506 ;; TODO
1507 ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
1508 (debug spec))
1509
8977de27
DU
1510;;; Backend specific parsing: PLSTORE backend
1511
1512(defun* auth-source-plstore-search (&rest
1513 spec
1514 &key backend create delete label
1515 type max host user port
1516 &allow-other-keys)
1517 "Search the PLSTORE; spec is like `auth-source'."
1518
1519 ;; TODO
1520 (assert (not delete) nil
1521 "The PLSTORE auth-source backend doesn't support deletion yet")
1522
1523 (let* ((store (oref backend arg))
1524 (max (or max 5000)) ; sanity check: default to stop at 5K
1525 (ignored-keys '(:create :delete :max :backend :require))
1526 (search-keys (loop for i below (length spec) by 2
1527 unless (memq (nth i spec) ignored-keys)
1528 collect (nth i spec)))
1529 ;; build a search spec without the ignored keys
1530 ;; if a search key is nil or t (match anything), we skip it
1531 (search-spec (apply 'append (mapcar
1532 (lambda (k)
1533 (let ((v (plist-get spec k)))
1534 (if (or (null v)
1535 (eq t v))
1536 nil
1537 (if (stringp v)
1538 (setq v (list v)))
1539 (list k v))))
1540 search-keys)))
1541 ;; needed keys (always including host, login, port, and secret)
1542 (returned-keys (mm-delete-duplicates (append
1543 '(:host :login :port :secret)
1544 search-keys)))
1545 (items (plstore-find store search-spec))
1546 (items (butlast items (- (length items) max)))
1547 ;; convert the item to a full plist
1548 (items (mapcar (lambda (item)
1549 (let* ((plist (copy-tree (cdr item)))
1550 (secret (plist-member plist :secret)))
1551 (if secret
1552 (setcar
1553 (cdr secret)
1554 (lexical-let ((v (car (cdr secret))))
1555 (lambda () v))))
1556 plist))
1557 items))
1558 ;; ensure each item has each key in `returned-keys'
1559 (items (mapcar (lambda (plist)
1560 (append
1561 (apply 'append
1562 (mapcar (lambda (req)
1563 (if (plist-get plist req)
1564 nil
1565 (list req nil)))
1566 returned-keys))
1567 plist))
1568 items)))
1569 ;; if we need to create an entry AND none were found to match
1570 (when (and create
1571 (not items))
1572
1573 ;; create based on the spec and record the value
1574 (setq items (or
1575 ;; if the user did not want to create the entry
1576 ;; in the file, it will be returned
1577 (apply (slot-value backend 'create-function) spec)
1578 ;; if not, we do the search again without :create
1579 ;; to get the updated data.
1580
1581 ;; the result will be returned, even if the search fails
1582 (apply 'auth-source-plstore-search
1583 (plist-put spec :create nil)))))
1584 items))
1585
1586(defun* auth-source-plstore-create (&rest spec
1587 &key backend
1588 secret host user port create
1589 &allow-other-keys)
1590 (let* ((base-required '(host user port secret))
1591 (base-secret '(secret))
1592 ;; we know (because of an assertion in auth-source-search) that the
1593 ;; :create parameter is either t or a list (which includes nil)
1594 (create-extra (if (eq t create) nil create))
1595 (current-data (car (auth-source-search :max 1
1596 :host host
1597 :port port)))
1598 (required (append base-required create-extra))
1599 (file (oref backend source))
1600 (add "")
1601 ;; `valist' is an alist
1602 valist
1603 ;; `artificial' will be returned if no creation is needed
1604 artificial
1605 secret-artificial)
1606
1607 ;; only for base required elements (defined as function parameters):
1608 ;; fill in the valist with whatever data we may have from the search
1609 ;; we complete the first value if it's a list and use the value otherwise
1610 (dolist (br base-required)
1611 (when (symbol-value br)
1612 (let ((br-choice (cond
1613 ;; all-accepting choice (predicate is t)
1614 ((eq t (symbol-value br)) nil)
1615 ;; just the value otherwise
1616 (t (symbol-value br)))))
1617 (when br-choice
1618 (aput 'valist br br-choice)))))
1619
1620 ;; for extra required elements, see if the spec includes a value for them
1621 (dolist (er create-extra)
1622 (let ((name (concat ":" (symbol-name er)))
1623 (keys (loop for i below (length spec) by 2
1624 collect (nth i spec))))
1625 (dolist (k keys)
1626 (when (equal (symbol-name k) name)
1627 (aput 'valist er (plist-get spec k))))))
1628
1629 ;; for each required element
1630 (dolist (r required)
1631 (let* ((data (aget valist r))
1632 ;; take the first element if the data is a list
1633 (data (or (auth-source-netrc-element-or-first data)
1634 (plist-get current-data
1635 (intern (format ":%s" r) obarray))))
1636 ;; this is the default to be offered
1637 (given-default (aget auth-source-creation-defaults r))
1638 ;; the default supplementals are simple:
1639 ;; for the user, try `given-default' and then (user-login-name);
1640 ;; otherwise take `given-default'
1641 (default (cond
1642 ((and (not given-default) (eq r 'user))
1643 (user-login-name))
1644 (t given-default)))
1645 (printable-defaults (list
1646 (cons 'user
1647 (or
1648 (auth-source-netrc-element-or-first
1649 (aget valist 'user))
1650 (plist-get artificial :user)
1651 "[any user]"))
1652 (cons 'host
1653 (or
1654 (auth-source-netrc-element-or-first
1655 (aget valist 'host))
1656 (plist-get artificial :host)
1657 "[any host]"))
1658 (cons 'port
1659 (or
1660 (auth-source-netrc-element-or-first
1661 (aget valist 'port))
1662 (plist-get artificial :port)
1663 "[any port]"))))
1664 (prompt (or (aget auth-source-creation-prompts r)
1665 (case r
1666 (secret "%p password for %u@%h: ")
1667 (user "%p user name for %h: ")
1668 (host "%p host name for user %u: ")
1669 (port "%p port for %u@%h: "))
1670 (format "Enter %s (%%u@%%h:%%p): " r)))
1671 (prompt (auth-source-format-prompt
1672 prompt
1673 `((?u ,(aget printable-defaults 'user))
1674 (?h ,(aget printable-defaults 'host))
1675 (?p ,(aget printable-defaults 'port))))))
1676
1677 ;; Store the data, prompting for the password if needed.
1678 (setq data
1679 (cond
1680 ((and (null data) (eq r 'secret))
1681 ;; Special case prompt for passwords.
1682 (read-passwd prompt))
1683 ((null data)
1684 (when default
1685 (setq prompt
1686 (if (string-match ": *\\'" prompt)
1687 (concat (substring prompt 0 (match-beginning 0))
1688 " (default " default "): ")
1689 (concat prompt "(default " default ") "))))
1690 (read-string prompt nil nil default))
1691 (t (or data default))))
1692
1693 (when data
1694 (if (member r base-secret)
1695 (setq secret-artificial
1696 (plist-put secret-artificial
1697 (intern (concat ":" (symbol-name r)))
1698 data))
1699 (setq artificial (plist-put artificial
1700 (intern (concat ":" (symbol-name r)))
1701 data))))))
1702 (plstore-put (oref backend arg)
1703 (sha1 (format "%s@%s:%s"
1704 (plist-get artificial :user)
1705 (plist-get artificial :host)
1706 (plist-get artificial :port)))
1707 artificial secret-artificial)
1708 (if (y-or-n-p (format "Save auth info to file %s? "
1709 (plstore-get-file (oref backend arg))))
1710 (plstore-save (oref backend arg)))))
1711
b8e0f0cd
G
1712;;; older API
1713
1714;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
1715
1716;; deprecate the old interface
1717(make-obsolete 'auth-source-user-or-password
1718 'auth-source-search "Emacs 24.1")
1719(make-obsolete 'auth-source-forget-user-or-password
1720 'auth-source-forget "Emacs 24.1")
fb178e4c 1721
0e4966fb 1722(defun auth-source-user-or-password
35123c04
TZ
1723 (mode host port &optional username create-missing delete-existing)
1724 "Find MODE (string or list of strings) matching HOST and PORT.
fb178e4c 1725
b8e0f0cd
G
1726DEPRECATED in favor of `auth-source-search'!
1727
fb178e4c
KY
1728USERNAME is optional and will be used as \"login\" in a search
1729across the Secret Service API (see secrets.el) if the resulting
1730items don't have a username. This means that if you search for
1731username \"joe\" and it matches an item but the item doesn't have
1732a :user attribute, the username \"joe\" will be returned.
1733
0e4966fb
MA
1734A non nil DELETE-EXISTING means deleting any matching password
1735entry in the respective sources. This is useful only when
1736CREATE-MISSING is non nil as well; the intended use case is to
1737remove wrong password entries.
1738
1739If no matching entry is found, and CREATE-MISSING is non nil,
1740the password will be retrieved interactively, and it will be
1741stored in the password database which matches best (see
1742`auth-sources').
1743
1744MODE can be \"login\" or \"password\"."
554a69b8 1745 (auth-source-do-debug
b8e0f0cd 1746 "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
35123c04 1747 mode host port username)
b8e0f0cd 1748
3b36c17e 1749 (let* ((listy (listp mode))
cbabe91f
TZ
1750 (mode (if listy mode (list mode)))
1751 (cname (if username
35123c04
TZ
1752 (format "%s %s:%s %s" mode host port username)
1753 (format "%s %s:%s" mode host port)))
1754 (search (list :host host :port port))
cbabe91f 1755 (search (if username (append search (list :user username)) search))
b8e0f0cd
G
1756 (search (if create-missing
1757 (append search (list :create t))
1758 search))
1759 (search (if delete-existing
1760 (append search (list :delete t))
1761 search))
1762 ;; (found (if (not delete-existing)
1763 ;; (gethash cname auth-source-cache)
1764 ;; (remhash cname auth-source-cache)
1765 ;; nil)))
1766 (found nil))
ed778fad 1767 (if found
cbabe91f
TZ
1768 (progn
1769 (auth-source-do-debug
b8e0f0cd 1770 "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
cbabe91f
TZ
1771 mode
1772 ;; don't show the password
b8e0f0cd 1773 (if (and (member "password" mode) t)
cbabe91f
TZ
1774 "SECRET"
1775 found)
35123c04 1776 host port username)
cbabe91f 1777 found) ; return the found data
b8e0f0cd
G
1778 ;; else, if not found, search with a max of 1
1779 (let ((choice (nth 0 (apply 'auth-source-search
1780 (append '(:max 1) search)))))
1781 (when choice
1782 (dolist (m mode)
1783 (cond
1784 ((equal "password" m)
1785 (push (if (plist-get choice :secret)
1786 (funcall (plist-get choice :secret))
1787 nil) found))
1788 ((equal "login" m)
1789 (push (plist-get choice :user) found)))))
1790 (setq found (nreverse found))
1791 (setq found (if listy found (car-safe found)))))
9b3ebcb6 1792
b8e0f0cd 1793 found))
8f7abae3
MB
1794
1795(provide 'auth-source)
1796
8f7abae3 1797;;; auth-source.el ends here