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