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