HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
* src/dired.c: Add comment and code explaining magic number.
[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)))
527 (found (auth-source-recall spec))
4a3988d5 528 filtered-backends accessor-key backend)
b8e0f0cd
G		 529
530 (if (and found auth-source-do-cache)
531 (auth-source-do-debug
532 "auth-source-search: found %d CACHED results matching %S"
533 (length found) spec)
534
535 (assert
536 (or (eq t create) (listp create)) t
4a3988d5 537 "Invalid auth-source :create parameter (must be t or a list): %s %s")
b8e0f0cd 538
6ce6c742 539 (setq filtered-backends (copy-sequence backends))
b8e0f0cd
G		 540 (dolist (backend backends)
541 (dolist (key keys)
542 ;; ignore invalid slots
543 (condition-case signal
544 (unless (eval `(auth-source-search-collection
545 (plist-get spec key)
546 (oref backend ,key)))
547 (setq filtered-backends (delq backend filtered-backends))
548 (return))
549 (invalid-slot-name))))
550
4a3988d5 551 (auth-source-do-trivia
b8e0f0cd
G		 552 "auth-source-search: found %d backends matching %S"
553 (length filtered-backends) spec)
554
555 ;; (debug spec "filtered" filtered-backends)
1d2c4a49
LI		 556 ;; First go through all the backends without :create, so we can
557 ;; query them all.
4a3988d5
G		 558 (setq found (auth-source-search-backends filtered-backends
559 spec
560 ;; to exit early
561 max
562 ;; create and delete
563 nil delete))
564
565 (auth-source-do-debug
566 "auth-source-search: found %d results (max %d) matching %S"
567 (length found) max spec)
568
1d2c4a49
LI		 569 ;; If we didn't find anything, then we allow the backend(s) to
570 ;; create the entries.
38046520 571 (when (and create
4a3988d5
G		 572 (not found))
573 (setq found (auth-source-search-backends filtered-backends
574 spec
575 ;; to exit early
576 max
577 ;; create and delete
578 create delete))
579 (auth-source-do-warn
580 "auth-source-search: CREATED %d results (max %d) matching %S"
581 (length found) max spec))
582
583 (when (and found auth-source-do-cache)
584 (auth-source-remember spec found)))
585
586 found))
587
588(defun auth-source-search-backends (backends spec max create delete)
589 (let (matches)
590 (dolist (backend backends)
591 (when (> max (length matches)) ; when we need more matches...
592 (let ((bmatches (apply
593 (slot-value backend 'search-function)
594 :backend backend
595 ;; note we're overriding whatever the spec
596 ;; has for :create and :delete
597 :create create
598 :delete delete
599 spec)))
600 (when bmatches
601 (auth-source-do-trivia
602 "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
603 (length bmatches) max
604 (slot-value backend :type)
605 (slot-value backend :source)
606 spec)
607 (setq matches (append matches bmatches))))))
608 matches))
b8e0f0cd
G		 609
610;;; (auth-source-search :max 1)
611;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
612;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
613;;; (auth-source-search :host "nonesuch" :type 'secrets)
614
615(defun* auth-source-delete (&rest spec
616 &key delete
617 &allow-other-keys)
618 "Delete entries from the authentication backends according to SPEC.
619Calls `auth-source-search' with the :delete property in SPEC set to t.
620The backend may not actually delete the entries.
621
622Returns the deleted entries."
623 (auth-source-search (plist-put spec :delete t)))
624
625(defun auth-source-search-collection (collection value)
626 "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
627 (when (and (atom collection) (not (eq t collection)))
628 (setq collection (list collection)))
629
630 ;; (debug :collection collection :value value)
631 (or (eq collection t)
632 (eq value t)
633 (equal collection value)
634 (member value collection)))
ed778fad 635
3b36c17e 636(defun auth-source-forget-all-cached ()
b8e0f0cd 637 "Forget all cached auth-source data."
3b36c17e 638 (interactive)
b8e0f0cd
G		 639 (loop for sym being the symbols of password-data
640 ;; when the symbol name starts with auth-source-magic
641 when (string-match (concat "^" auth-source-magic)
642 (symbol-name sym))
643 ;; remove that key
644 do (password-cache-remove (symbol-name sym))))
645
646(defun auth-source-remember (spec found)
647 "Remember FOUND search results for SPEC."
584c9d3f
G		 648 (let ((password-cache-expiry auth-source-cache-expiry))
649 (password-cache-add
650 (concat auth-source-magic (format "%S" spec)) found)))
b8e0f0cd
G		 651
652(defun auth-source-recall (spec)
653 "Recall FOUND search results for SPEC."
654 (password-read-from-cache
655 (concat auth-source-magic (format "%S" spec))))
656
657(defun auth-source-forget (spec)
658 "Forget any cached data matching SPEC exactly.
659
660This is the same SPEC you passed to `auth-source-search'.
661Returns t or nil for forgotten or not found."
662 (password-cache-remove (concat auth-source-magic (format "%S" spec))))
663
664;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
665
666;;; (auth-source-remember '(:host "wedd") '(4 5 6))
667;;; (auth-source-remember '(:host "xedd") '(1 2 3))
668;;; (auth-source-recall '(:host "xedd"))
669;;; (auth-source-recall '(:host t))
670;;; (auth-source-forget+ :host t)
671
672(defun* auth-source-forget+ (&rest spec &allow-other-keys)
673 "Forget any cached data matching SPEC. Returns forgotten count.
674
675This is not a full `auth-source-search' spec but works similarly.
676For instance, \(:host \"myhost\" \"yourhost\") would find all the
677cached data that was found with a search for those two hosts,
678while \(:host t) would find all host entries."
679 (let ((count 0)
680 sname)
681 (loop for sym being the symbols of password-data
682 ;; when the symbol name matches with auth-source-magic
683 when (and (setq sname (symbol-name sym))
684 (string-match (concat "^" auth-source-magic "\\(.+\\)")
685 sname)
686 ;; and the spec matches what was stored in the cache
687 (auth-source-specmatchp spec (read (match-string 1 sname))))
688 ;; remove that key
689 do (progn
690 (password-cache-remove sname)
691 (incf count)))
692 count))
693
694(defun auth-source-specmatchp (spec stored)
695 (let ((keys (loop for i below (length spec) by 2
696 collect (nth i spec))))
697 (not (eq
698 (dolist (key keys)
699 (unless (auth-source-search-collection (plist-get stored key)
700 (plist-get spec key))
701 (return 'no)))
702 'no))))
703
704;;; Backend specific parsing: netrc/authinfo backend
705
8e22bee0
G		 706(defun auth-source-ensure-strings (values)
707 (unless (listp values)
708 (setq values (list values)))
709 (mapcar (lambda (value)
710 (if (numberp value)
711 (format "%s" value)
712 value))
713 values))
714
06b840e0
LI		 715(defvar auth-source-netrc-cache nil)
716
b8e0f0cd
G		 717;;; (auth-source-netrc-parse "~/.authinfo.gpg")
718(defun* auth-source-netrc-parse (&rest
719 spec
35123c04 720 &key file max host user port delete
b8e0f0cd
G		 721 &allow-other-keys)
722 "Parse FILE and return a list of all entries in the file.
723Note that the MAX parameter is used so we can exit the parse early."
724 (if (listp file)
725 ;; We got already parsed contents; just return it.
726 file
727 (when (file-exists-p file)
8e22bee0 728 (setq port (auth-source-ensure-strings port))
b8e0f0cd 729 (with-temp-buffer
4a3988d5
G		 730 (let* ((tokens '("machine" "host" "default" "login" "user"
731 "password" "account" "macdef" "force"
732 "port" "protocol"))
733 (max (or max 5000)) ; sanity check: default to stop at 5K
734 (modified 0)
735 (cached (cdr-safe (assoc file auth-source-netrc-cache)))
736 (cached-mtime (plist-get cached :mtime))
737 (cached-secrets (plist-get cached :secret))
738 alist elem result pair)
739
740 (if (and (functionp cached-secrets)
741 (equal cached-mtime
742 (nth 5 (file-attributes file))))
743 (progn
744 (auth-source-do-trivia
745 "auth-source-netrc-parse: using CACHED file data for %s"
746 file)
747 (insert (funcall cached-secrets)))
748 (insert-file-contents file)
749 ;; cache all netrc files (used to be just .gpg files)
750 ;; Store the contents of the file heavily encrypted in memory.
751 ;; (note for the irony-impaired: they are just obfuscated)
752 (aput 'auth-source-netrc-cache file
753 (list :mtime (nth 5 (file-attributes file))
754 :secret (lexical-let ((v (rot13-string
755 (base64-encode-string
756 (buffer-string)))))
757 (lambda () (base64-decode-string
758 (rot13-string v)))))))
b8e0f0cd
G		 759 (goto-char (point-min))
760 ;; Go through the file, line by line.
761 (while (and (not (eobp))
762 (> max 0))
763
764 (narrow-to-region (point) (point-at-eol))
765 ;; For each line, get the tokens and values.
766 (while (not (eobp))
767 (skip-chars-forward "\t ")
768 ;; Skip lines that begin with a "#".
769 (if (eq (char-after) ?#)
770 (goto-char (point-max))
771 (unless (eobp)
772 (setq elem
773 (if (= (following-char) ?\")
774 (read (current-buffer))
775 (buffer-substring
776 (point) (progn (skip-chars-forward "^\t ")
777 (point)))))
778 (cond
779 ((equal elem "macdef")
780 ;; We skip past the macro definition.
781 (widen)
782 (while (and (zerop (forward-line 1))
783 (looking-at "$")))
784 (narrow-to-region (point) (point)))
785 ((member elem tokens)
786 ;; Tokens that don't have a following value are ignored,
787 ;; except "default".
788 (when (and pair (or (cdr pair)
789 (equal (car pair) "default")))
790 (push pair alist))
791 (setq pair (list elem)))
792 (t
793 ;; Values that haven't got a preceding token are ignored.
794 (when pair
795 (setcdr pair elem)
796 (push pair alist)
797 (setq pair nil)))))))
798
799 (when (and alist
800 (> max 0)
801 (auth-source-search-collection
802 host
803 (or
804 (aget alist "machine")
35123c04
TZ		 805 (aget alist "host")
806 t))
b8e0f0cd
G		 807 (auth-source-search-collection
808 user
809 (or
810 (aget alist "login")
811 (aget alist "account")
35123c04
TZ		 812 (aget alist "user")
813 t))
b8e0f0cd 814 (auth-source-search-collection
35123c04 815 port
b8e0f0cd
G		 816 (or
817 (aget alist "port")
35123c04
TZ		 818 (aget alist "protocol")
819 t)))
b8e0f0cd
G		 820 (decf max)
821 (push (nreverse alist) result)
822 ;; to delete a line, we just comment it out
823 (when delete
824 (goto-char (point-min))
825 (insert "#")
826 (incf modified)))
827 (setq alist nil
828 pair nil)
829 (widen)
830 (forward-line 1))
831
832 (when (< 0 modified)
833 (when auth-source-gpg-encrypt-to
834 ;; (see bug#7487) making `epa-file-encrypt-to' local to
835 ;; this buffer lets epa-file skip the key selection query
836 ;; (see the `local-variable-p' check in
837 ;; `epa-file-write-region').
838 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
839 (make-local-variable 'epa-file-encrypt-to))
840 (if (listp auth-source-gpg-encrypt-to)
841 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
842
843 ;; ask AFTER we've successfully opened the file
844 (when (y-or-n-p (format "Save file %s? (%d modifications)"
845 file modified))
846 (write-region (point-min) (point-max) file nil 'silent)
847 (auth-source-do-debug
848 "auth-source-netrc-parse: modified %d lines in %s"
849 modified file)))
850
851 (nreverse result))))))
852
853(defun auth-source-netrc-normalize (alist)
854 (mapcar (lambda (entry)
855 (let (ret item)
856 (while (setq item (pop entry))
857 (let ((k (car item))
858 (v (cdr item)))
859
860 ;; apply key aliases
861 (setq k (cond ((member k '("machine")) "host")
862 ((member k '("login" "account")) "user")
863 ((member k '("protocol")) "port")
864 ((member k '("password")) "secret")
865 (t k)))
866
867 ;; send back the secret in a function (lexical binding)
868 (when (equal k "secret")
869 (setq v (lexical-let ((v v))
870 (lambda () v))))
871
872 (setq ret (plist-put ret
873 (intern (concat ":" k))
874 v))
875 ))
876 ret))
877 alist))
878
879;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
880;;; (funcall secret)
881
882(defun* auth-source-netrc-search (&rest
883 spec
884 &key backend create delete
35123c04 885 type max host user port
b8e0f0cd
G		 886 &allow-other-keys)
887"Given a property list SPEC, return search matches from the :backend.
888See `auth-source-search' for details on SPEC."
889 ;; just in case, check that the type is correct (null or same as the backend)
890 (assert (or (null type) (eq type (oref backend type)))
d5e9a4e9 891 t "Invalid netrc search: %s %s")
b8e0f0cd
G		 892
893 (let ((results (auth-source-netrc-normalize
894 (auth-source-netrc-parse
895 :max max
896 :delete delete
897 :file (oref backend source)
898 :host (or host t)
899 :user (or user t)
35123c04 900 :port (or port t)))))
b8e0f0cd
G		 901
902 ;; if we need to create an entry AND none were found to match
903 (when (and create
4a3988d5 904 (not results))
b8e0f0cd 905
584c9d3f
G		 906 ;; create based on the spec and record the value
907 (setq results (or
908 ;; if the user did not want to create the entry
909 ;; in the file, it will be returned
910 (apply (slot-value backend 'create-function) spec)
911 ;; if not, we do the search again without :create
912 ;; to get the updated data.
913
914 ;; the result will be returned, even if the search fails
915 (apply 'auth-source-netrc-search
916 (plist-put spec :create nil)))))
b8e0f0cd
G		 917 results))
918
fa41748c
G		 919(defun auth-source-netrc-element-or-first (v)
920 (if (listp v)
921 (nth 0 v)
922 v))
923
003522ce
G		 924;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
925
926(defun auth-source-format-prompt (prompt alist)
927 "Format PROMPT using %x (for any character x) specifiers in ALIST."
928 (dolist (cell alist)
929 (let ((c (nth 0 cell))
930 (v (nth 1 cell)))
931 (when (and c v)
932 (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt)))))
933 prompt)
934
b8e0f0cd
G		 935;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
936;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
937
938(defun* auth-source-netrc-create (&rest spec
939 &key backend
35123c04 940 secret host user port create
b8e0f0cd 941 &allow-other-keys)
35123c04 942 (let* ((base-required '(host user port secret))
b8e0f0cd
G		 943 ;; we know (because of an assertion in auth-source-search) that the
944 ;; :create parameter is either t or a list (which includes nil)
945 (create-extra (if (eq t create) nil create))
946 (required (append base-required create-extra))
947 (file (oref backend source))
948 (add "")
949 ;; `valist' is an alist
584c9d3f
G		 950 valist
951 ;; `artificial' will be returned if no creation is needed
952 artificial)
b8e0f0cd
G		 953
954 ;; only for base required elements (defined as function parameters):
955 ;; fill in the valist with whatever data we may have from the search
7ba93e94 956 ;; we complete the first value if it's a list and use the value otherwise
b8e0f0cd
G		 957 (dolist (br base-required)
958 (when (symbol-value br)
7ba93e94
G		 959 (let ((br-choice (cond
960 ;; all-accepting choice (predicate is t)
961 ((eq t (symbol-value br)) nil)
962 ;; just the value otherwise
963 (t (symbol-value br)))))
964 (when br-choice
965 (aput 'valist br br-choice)))))
b8e0f0cd
G		 966
967 ;; for extra required elements, see if the spec includes a value for them
968 (dolist (er create-extra)
969 (let ((name (concat ":" (symbol-name er)))
970 (keys (loop for i below (length spec) by 2
971 collect (nth i spec))))
972 (dolist (k keys)
973 (when (equal (symbol-name k) name)
974 (aput 'valist er (plist-get spec k))))))
975
976 ;; for each required element
977 (dolist (r required)
978 (let* ((data (aget valist r))
4a3988d5 979 ;; take the first element if the data is a list
fa41748c 980 (data (auth-source-netrc-element-or-first data))
4a3988d5 981 ;; this is the default to be offered
b8e0f0cd 982 (given-default (aget auth-source-creation-defaults r))
4a3988d5
G		 983 ;; the default supplementals are simple: for the user,
984 ;; try (user-login-name), otherwise take given-default
b8e0f0cd 985 (default (cond
003522ce
G		 986 ;; don't default the user name
987 ;; ((and (not given-default) (eq r 'user))
988 ;; (user-login-name))
989 (t given-default)))
990 (printable-defaults (list
991 (cons 'user
992 (or
993 (auth-source-netrc-element-or-first
994 (aget valist 'user))
995 (plist-get artificial :user)
996 "[any user]"))
997 (cons 'host
998 (or
999 (auth-source-netrc-element-or-first
1000 (aget valist 'host))
1001 (plist-get artificial :host)
1002 "[any host]"))
1003 (cons 'port
1004 (or
1005 (auth-source-netrc-element-or-first
1006 (aget valist 'port))
1007 (plist-get artificial :port)
1008 "[any port]"))))
1009 (prompt (or (aget auth-source-creation-prompts r)
1010 (case r
1011 ('secret "%p password for user %u, host %h: ")
1012 ('user "%p user name: ")
1013 ('host "%p host name for user %u: ")
1014 ('port "%p port for user %u and host %h: "))
1015 (format "Enter %s (%%u@%%h:%%p): " r)))
1016 (prompt (auth-source-format-prompt
1017 prompt
1018 `((?u ,(aget printable-defaults 'user))
1019 (?h ,(aget printable-defaults 'host))
1020 (?p ,(aget printable-defaults 'port))))))
4a3988d5
G		 1021
1022 ;; store the data, prompting for the password if needed
1023 (setq data
1024 (cond
1025 ((and (null data) (eq r 'secret))
1026 ;; special case prompt for passwords
003522ce
G		 1027 (read-passwd prompt))
1028 ((null data)
1029 (read-string prompt default))
fa41748c 1030 (t (or data default))))
b8e0f0cd 1031
584c9d3f
G		 1032 (when data
1033 (setq artificial (plist-put artificial
1034 (intern (concat ":" (symbol-name r)))
1035 (if (eq r 'secret)
1036 (lexical-let ((data data))
1037 (lambda () data))
1038 data))))
1039
b8e0f0cd
G		 1040 ;; when r is not an empty string...
1041 (when (and (stringp data)
1042 (< 0 (length data)))
4a3988d5
G		 1043 ;; this function is not strictly necessary but I think it
1044 ;; makes the code clearer -tzz
1045 (let ((printer (lambda ()
7ba93e94
G		 1046 ;; append the key (the symbol name of r)
1047 ;; and the value in r
1048 (format "%s%s %S"
1049 ;; prepend a space
1050 (if (zerop (length add)) "" " ")
1051 ;; remap auth-source tokens to netrc
1052 (case r
4a3988d5
G		 1053 ('user "login")
1054 ('host "machine")
b8e0f0cd 1055 ('secret "password")
4a3988d5 1056 ('port "port") ; redundant but clearer
b8e0f0cd 1057 (t (symbol-name r)))
7ba93e94 1058 ;; the value will be printed in %S format
4a3988d5
G		 1059 data))))
1060 (setq add (concat add (funcall printer)))))))
b8e0f0cd
G		 1061
1062 (with-temp-buffer
1063 (when (file-exists-p file)
1064 (insert-file-contents file))
1065 (when auth-source-gpg-encrypt-to
1066 ;; (see bug#7487) making `epa-file-encrypt-to' local to
1067 ;; this buffer lets epa-file skip the key selection query
1068 ;; (see the `local-variable-p' check in
1069 ;; `epa-file-write-region').
1070 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
1071 (make-local-variable 'epa-file-encrypt-to))
1072 (if (listp auth-source-gpg-encrypt-to)
1073 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
1074 (goto-char (point-max))
1075
1076 ;; ask AFTER we've successfully opened the file
003522ce 1077 (let ((prompt (format "Save auth info to file %s? %s: "
d41d18c0 1078 file
003522ce
G		 1079 "y/n/N/e/?"))
1080 (done (not (eq auth-source-save-behavior 'ask)))
1081 (bufname "*auth-source Help*")
1082 k)
4a3988d5 1083 (while (not done)
003522ce 1084 (message "%s" prompt)
a22e7484 1085 (setq k (read-char))
4a3988d5
G		 1086 (case k
1087 (?y (setq done t))
003522ce
G		 1088 (?? (save-excursion
1089 (with-output-to-temp-buffer bufname
1090 (princ
1091 (concat "(y)es, save\n"
1092 "(n)o but use the info\n"
1093 "(N)o and don't ask to save again\n"
1094 "(e)dit the line\n"
1095 "(?) for help as you can see.\n"))
1096 (set-buffer standard-output)
1097 (help-mode))))
4a3988d5
G		 1098 (?n (setq add ""
1099 done t))
003522ce
G		 1100 (?N (setq add ""
1101 done t
1102 auth-source-save-behavior nil))
4a3988d5
G		 1103 (?e (setq add (read-string "Line to add: " add)))
1104 (t nil)))
1105
003522ce
G		 1106 (when (get-buffer-window bufname)
1107 (delete-window (get-buffer-window bufname)))
1108
1109 ;; make sure the info is not saved
1110 (when (null auth-source-save-behavior)
1111 (setq add ""))
1112
4a3988d5 1113 (when (< 0 (length add))
584c9d3f
G		 1114 (progn
1115 (unless (bolp)
1116 (insert "\n"))
1117 (insert add "\n")
1118 (write-region (point-min) (point-max) file nil 'silent)
4a3988d5 1119 (auth-source-do-warn
584c9d3f
G		 1120 "auth-source-netrc-create: wrote 1 new line to %s"
1121 file)
4a3988d5
G		 1122 nil))
1123
1124 (when (eq done t)
1125 (list artificial))))))
b8e0f0cd
G		 1126
1127;;; Backend specific parsing: Secrets API backend
1128
1129;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
1130;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
1131;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
1132;;; (let ((auth-sources '(default))) (auth-source-search))
5415d076
G		 1133;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
1134;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
b8e0f0cd
G		 1135
1136(defun* auth-source-secrets-search (&rest
1137 spec
1138 &key backend create delete label
35123c04 1139 type max host user port
b8e0f0cd
G		 1140 &allow-other-keys)
1141 "Search the Secrets API; spec is like `auth-source'.
1142
1143The :label key specifies the item's label. It is the only key
1144that can specify a substring. Any :label value besides a string
1145will allow any label.
1146
1147All other search keys must match exactly. If you need substring
1148matching, do a wider search and narrow it down yourself.
1149
1150You'll get back all the properties of the token as a plist.
1151
5415d076 1152Here's an example that looks for the first item in the 'Login'
b8e0f0cd
G		 1153Secrets collection:
1154
5415d076 1155 \(let ((auth-sources '(\"secrets:Login\")))
b8e0f0cd
G		 1156 (auth-source-search :max 1)
1157
5415d076 1158Here's another that looks for the first item in the 'Login'
b8e0f0cd
G		 1159Secrets collection whose label contains 'gnus':
1160
5415d076 1161 \(let ((auth-sources '(\"secrets:Login\")))
b8e0f0cd
G		 1162 (auth-source-search :max 1 :label \"gnus\")
1163
5415d076 1164And this one looks for the first item in the 'Login' Secrets
b8e0f0cd 1165collection that's a Google Chrome entry for the git.gnus.org site
5415d076 1166authentication tokens:
b8e0f0cd 1167
5415d076 1168 \(let ((auth-sources '(\"secrets:Login\")))
b8e0f0cd
G		 1169 (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
1170"
1171
1172 ;; TODO
1173 (assert (not create) nil
1174 "The Secrets API auth-source backend doesn't support creation yet")
1175 ;; TODO
1176 ;; (secrets-delete-item coll elt)
1177 (assert (not delete) nil
1178 "The Secrets API auth-source backend doesn't support deletion yet")
1179
1180 (let* ((coll (oref backend source))
1181 (max (or max 5000)) ; sanity check: default to stop at 5K
1182 (ignored-keys '(:create :delete :max :backend :label))
1183 (search-keys (loop for i below (length spec) by 2
1184 unless (memq (nth i spec) ignored-keys)
1185 collect (nth i spec)))
1186 ;; build a search spec without the ignored keys
1187 ;; if a search key is nil or t (match anything), we skip it
5415d076
G		 1188 (search-spec (apply 'append (mapcar
1189 (lambda (k)
1190 (if (or (null (plist-get spec k))
1191 (eq t (plist-get spec k)))
1192 nil
1193 (list k (plist-get spec k))))
1194 search-keys)))
35123c04 1195 ;; needed keys (always including host, login, port, and secret)
d638ac9e 1196 (returned-keys (mm-delete-duplicates (append
35123c04 1197 '(:host :login :port :secret)
d638ac9e 1198 search-keys)))
b8e0f0cd
G		 1199 (items (loop for item in (apply 'secrets-search-items coll search-spec)
1200 unless (and (stringp label)
1201 (not (string-match label item)))
1202 collect item))
1203 ;; TODO: respect max in `secrets-search-items', not after the fact
5415d076 1204 (items (butlast items (- (length items) max)))
b8e0f0cd
G		 1205 ;; convert the item name to a full plist
1206 (items (mapcar (lambda (item)
1207 (append
1208 ;; make an entry for the secret (password) element
1209 (list
1210 :secret
1211 (lexical-let ((v (secrets-get-secret coll item)))
1212 (lambda () v)))
1213 ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
5415d076
G		 1214 (apply 'append
1215 (mapcar (lambda (entry)
1216 (list (car entry) (cdr entry)))
1217 (secrets-get-attributes coll item)))))
b8e0f0cd
G		 1218 items))
1219 ;; ensure each item has each key in `returned-keys'
1220 (items (mapcar (lambda (plist)
1221 (append
5415d076
G		 1222 (apply 'append
1223 (mapcar (lambda (req)
1224 (if (plist-get plist req)
1225 nil
1226 (list req nil)))
1227 returned-keys))
b8e0f0cd
G		 1228 plist))
1229 items)))
1230 items))
1231
1232(defun* auth-source-secrets-create (&rest
1233 spec
35123c04 1234 &key backend type max host user port
b8e0f0cd
G		 1235 &allow-other-keys)
1236 ;; TODO
1237 ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
1238 (debug spec))
1239
1240;;; older API
1241
1242;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
1243
1244;; deprecate the old interface
1245(make-obsolete 'auth-source-user-or-password
1246 'auth-source-search "Emacs 24.1")
1247(make-obsolete 'auth-source-forget-user-or-password
1248 'auth-source-forget "Emacs 24.1")
fb178e4c 1249
0e4966fb 1250(defun auth-source-user-or-password
35123c04
TZ		 1251 (mode host port &optional username create-missing delete-existing)
1252 "Find MODE (string or list of strings) matching HOST and PORT.
fb178e4c 1253
b8e0f0cd
G		 1254DEPRECATED in favor of `auth-source-search'!
1255
fb178e4c
KY		 1256USERNAME is optional and will be used as \"login\" in a search
1257across the Secret Service API (see secrets.el) if the resulting
1258items don't have a username. This means that if you search for
1259username \"joe\" and it matches an item but the item doesn't have
1260a :user attribute, the username \"joe\" will be returned.
1261
0e4966fb
MA		 1262A non nil DELETE-EXISTING means deleting any matching password
1263entry in the respective sources. This is useful only when
1264CREATE-MISSING is non nil as well; the intended use case is to
1265remove wrong password entries.
1266
1267If no matching entry is found, and CREATE-MISSING is non nil,
1268the password will be retrieved interactively, and it will be
1269stored in the password database which matches best (see
1270`auth-sources').
1271
1272MODE can be \"login\" or \"password\"."
554a69b8 1273 (auth-source-do-debug
b8e0f0cd 1274 "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
35123c04 1275 mode host port username)
b8e0f0cd 1276
3b36c17e 1277 (let* ((listy (listp mode))
cbabe91f
TZ		 1278 (mode (if listy mode (list mode)))
1279 (cname (if username
35123c04
TZ		 1280 (format "%s %s:%s %s" mode host port username)
1281 (format "%s %s:%s" mode host port)))
1282 (search (list :host host :port port))
cbabe91f 1283 (search (if username (append search (list :user username)) search))
b8e0f0cd
G		 1284 (search (if create-missing
1285 (append search (list :create t))
1286 search))
1287 (search (if delete-existing
1288 (append search (list :delete t))
1289 search))
1290 ;; (found (if (not delete-existing)
1291 ;; (gethash cname auth-source-cache)
1292 ;; (remhash cname auth-source-cache)
1293 ;; nil)))
1294 (found nil))
ed778fad 1295 (if found
cbabe91f
TZ		 1296 (progn
1297 (auth-source-do-debug
b8e0f0cd 1298 "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
cbabe91f
TZ		 1299 mode
1300 ;; don't show the password
b8e0f0cd 1301 (if (and (member "password" mode) t)
cbabe91f
TZ		 1302 "SECRET"
1303 found)
35123c04 1304 host port username)
cbabe91f 1305 found) ; return the found data
b8e0f0cd
G		 1306 ;; else, if not found, search with a max of 1
1307 (let ((choice (nth 0 (apply 'auth-source-search
1308 (append '(:max 1) search)))))
1309 (when choice
1310 (dolist (m mode)
1311 (cond
1312 ((equal "password" m)
1313 (push (if (plist-get choice :secret)
1314 (funcall (plist-get choice :secret))
1315 nil) found))
1316 ((equal "login" m)
1317 (push (plist-get choice :user) found)))))
1318 (setq found (nreverse found))
1319 (setq found (if listy found (car-safe found)))))
9b3ebcb6 1320
b8e0f0cd 1321 found))
8f7abae3
MB		 1322
1323(provide 'auth-source)
1324
8f7abae3 1325;;; auth-source.el ends here
Unnamed repository; edit this file 'description' to name the repository.