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