1 ;;; auth-source.el --- authentication sources for Gnus and Emacs
3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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.
30 ;; See the auth.info Info documentation for details.
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
45 (eval-when-compile (require 'cl
))
46 (autoload 'secrets-create-item
"secrets")
47 (autoload 'secrets-delete-item
"secrets")
48 (autoload 'secrets-get-alias
"secrets")
49 (autoload 'secrets-get-attribute
"secrets")
50 (autoload 'secrets-get-secret
"secrets")
51 (autoload 'secrets-list-collections
"secrets")
52 (autoload 'secrets-search-items
"secrets")
54 (defgroup auth-source nil
55 "Authentication sources."
56 :version
"23.1" ;; No Gnus
59 (defcustom auth-source-protocols
'((imap "imap" "imaps" "143" "993")
60 (pop3 "pop3" "pop" "pop3s" "110" "995")
64 "List of authentication protocols and their names"
67 :version
"23.2" ;; No Gnus
68 :type
'(repeat :tag
"Authentication Protocols"
69 (cons :tag
"Protocol Entry"
70 (symbol :tag
"Protocol")
72 (string :tag
"Name")))))
74 ;;; generate all the protocols in a format Customize can use
75 ;;; TODO: generate on the fly from auth-source-protocols
76 (defconst auth-source-protocols-customize
78 (let ((p (car-safe a
)))
80 :tag
(upcase (symbol-name p
))
82 auth-source-protocols
))
84 (defvar auth-source-cache
(make-hash-table :test
'equal
)
85 "Cache for auth-source data")
87 (defcustom auth-source-do-cache t
88 "Whether auth-source should cache information."
90 :version
"23.2" ;; No Gnus
93 (defcustom auth-source-debug nil
94 "Whether auth-source should log debug messages.
95 Also see `auth-source-hide-passwords'.
97 If the value is nil, debug messages are not logged.
98 If the value is t, debug messages are logged with `message'.
99 In that case, your authentication data will be in the
100 clear (except for passwords, which are always stripped out).
101 If the value is a function, debug messages are logged by calling
102 that function using the same arguments as `message'."
104 :version
"23.2" ;; No Gnus
106 :tag
"auth-source debugging mode"
107 (const :tag
"Log using `message' to the *Messages* buffer" t
)
108 (function :tag
"Function that takes arguments like `message'")
109 (const :tag
"Don't log anything" nil
)))
111 (defcustom auth-source-hide-passwords t
112 "Whether auth-source should hide passwords in log messages.
113 Only relevant if `auth-source-debug' is not nil."
115 :version
"23.2" ;; No Gnus
118 (defcustom auth-sources
'((:source
"~/.authinfo.gpg")
119 (:source
"~/.authinfo"))
120 "List of authentication sources.
122 The default will get login and password information from a .gpg
123 file, which you should set up with the EPA/EPG packages to be
124 encrypted. See the auth.info manual for details.
126 Each entry is the authentication type with optional properties.
128 It's best to customize this with `M-x customize-variable' because the choices
129 can get pretty complex."
131 :version
"23.2" ;; No Gnus
132 :type
`(repeat :tag
"Authentication Sources"
133 (list :tag
"Source definition"
134 (const :format
"" :value
:source
)
135 (choice :tag
"Authentication backend choice"
136 (string :tag
"Authentication Source (file)")
137 (list :tag
"secrets.el (Secret Service API/KWallet/GNOME Keyring)"
138 (const :format
"" :value
:secrets
)
139 (choice :tag
"Collection to use"
140 (string :tag
"Collection name")
141 (const :tag
"Default" 'default
)
142 (const :tag
"Login" "login")
143 (const :tag
"Temporary" "session"))))
144 (repeat :tag
"Extra Parameters" :inline t
145 (choice :tag
"Extra parameter"
146 (list :tag
"Host (omit to match as a fallback)"
147 (const :format
"" :value
:host
)
148 (choice :tag
"Host (machine) choice"
150 (regexp :tag
"Host (machine) regular expression")))
151 (list :tag
"Protocol (omit to match as a fallback)"
152 (const :format
"" :value
:protocol
)
153 (choice :tag
"Protocol"
155 ,@auth-source-protocols-customize
))
156 (list :tag
"User (omit to match as a fallback)" :inline t
157 (const :format
"" :value
:user
)
158 (choice :tag
"Personality or username"
160 (string :tag
"Specific user name"))))))))
162 ;; temp for debugging
163 ;; (unintern 'auth-source-protocols)
164 ;; (unintern 'auth-sources)
165 ;; (customize-variable 'auth-sources)
166 ;; (setq auth-sources nil)
167 ;; (format "%S" auth-sources)
168 ;; (customize-variable 'auth-source-protocols)
169 ;; (setq auth-source-protocols nil)
170 ;; (format "%S" auth-source-protocols)
171 ;; (auth-source-pick nil :host "a" :port 'imap)
172 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
173 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
174 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
175 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
176 ;; (auth-source-protocol-defaults 'imap)
178 ;; (let ((auth-source-debug 'debug)) (auth-source-debug "hello"))
179 ;; (let ((auth-source-debug t)) (auth-source-debug "hello"))
180 ;; (let ((auth-source-debug nil)) (auth-source-debug "hello"))
181 (defun auth-source-do-debug (&rest msg
)
182 ;; set logger to either the function in auth-source-debug or 'message
183 ;; note that it will be 'message if auth-source-debug is nil, so
184 ;; we also check the value
185 (when auth-source-debug
186 (let ((logger (if (functionp auth-source-debug
)
189 (apply logger msg
))))
191 ;; (auth-source-pick nil :host "any" :protocol 'imap :user "joe")
192 ;; (auth-source-pick t :host "any" :protocol 'imap :user "joe")
193 ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe")
194 ;; (:source (:secrets "session") :host t :protocol t :user "joe")
195 ;; (:source (:secrets "login") :host t :protocol t)
196 ;; (:source "~/.authinfo.gpg" :host t :protocol t)))
198 ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe")
199 ;; (:source (:secrets "session") :host t :protocol t :user "joe")
200 ;; (:source (:secrets "login") :host t :protocol t)
203 ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
205 (defun auth-get-source (entry)
206 "Return the source string of ENTRY, which is one entry in `auth-sources'.
207 If it is a Secret Service API, return the collection name, otherwise
209 (let ((source (plist-get entry
:source
)))
212 ;; Secret Service API.
213 (setq source
(plist-get source
:secrets
))
214 (when (eq source
'default
)
215 (setq source
(or (secrets-get-alias "default") "login")))
216 (or source
"session"))))
218 (defun auth-source-pick (&rest spec
)
219 "Parse `auth-sources' for matches of the SPEC plist.
221 Common keys are :host, :protocol, and :user. A value of t in
222 SPEC means to always succeed in the match. A string value is
224 (let ((keys (loop for i below
(length spec
) by
2 collect
(nth i spec
)))
226 (dolist (choice (copy-tree auth-sources
) choices
)
227 (let ((source (plist-get choice
:source
))
231 ;; Check existence of source.
233 ;; Secret Service API.
234 (member (auth-get-source choice
) (secrets-list-collections))
236 (file-exists-p source
))
239 (dolist (k keys match
)
240 (let* ((v (plist-get spec k
))
241 (choicev (if (plist-member choice k
)
242 (plist-get choice k
) t
)))
246 ;; source always matches spec key
248 ;; source key gives regex to match against spec
249 (and (stringp choicev
) (string-match choicev v
))
250 ;; source key gives symbol to match against spec
251 (and (symbolp choicev
) (eq choicev v
))))))))
253 (add-to-list 'choices choice
'append
))))))
255 (defun auth-source-retrieve (mode entry
&rest spec
)
256 "Retrieve MODE credentials according to SPEC from ENTRY."
258 (let ((host (plist-get spec
:host
))
259 (user (plist-get spec
:user
))
260 (prot (plist-get spec
:protocol
))
261 (source (plist-get entry
:source
))
264 ;; Secret Service API.
266 (let ((coll (auth-get-source entry
))
268 ;; Loop over candidates with a matching host attribute.
269 (dolist (elt (secrets-search-items coll
:host host
) item
)
270 (when (and (or (not user
)
272 user
(secrets-get-attribute coll elt
:user
)))
275 prot
(secrets-get-attribute coll elt
:protocol
))))
282 (if (string-equal "password" m
)
283 (or (secrets-get-secret coll item
)
284 ;; When we do not find a password,
285 ;; we return nil anyway.
286 (throw 'no-password nil
))
287 (or (secrets-get-attribute coll item
:user
)
289 (if (consp mode
) mode
(list mode
)))))
290 (if (consp mode
) result
(car result
))))
291 ;; Anything else is netrc.
293 (let ((search (list source
(list host
) (list (format "%s" prot
))
294 (auth-source-protocol-defaults prot
))))
297 (if (string-equal "password" m
)
299 'netrc-machine-user-or-password m search
)
300 ;; When we do not find a password, we
301 ;; return nil anyway.
302 (throw 'no-password nil
))
304 'netrc-machine-user-or-password m search
)
306 (if (consp mode
) mode
(list mode
)))))
307 (if (consp mode
) result
(car result
)))))))
309 (defun auth-source-create (mode entry
&rest spec
)
310 "Create interactively credentials according to SPEC in ENTRY.
311 Return structure as specified by MODE."
312 (let* ((host (plist-get spec
:host
))
313 (user (plist-get spec
:user
))
314 (prot (plist-get spec
:protocol
))
315 (source (plist-get entry
:source
))
316 (name (concat (if user
(format "%s@" user
))
318 (if prot
(format ":%s" prot
))))
326 ((equal "password" m
)
327 (let ((passwd (read-passwd
328 (format "Password for %s on %s: " prot host
))))
330 ;; Secret Service API.
334 (auth-get-source entry
) name passwd spec
))
335 (t)) ;; netrc not implemented yes.
340 (format "User name for %s on %s (default %s): " prot host
342 nil nil
(user-login-name))))
345 (if (consp mode
) mode
(list mode
))))
346 ;; Allow the source to save the data.
349 ;; Secret Service API -- not implemented.
353 (when (y-or-n-p (format "Do you want to save this password in %s? "
355 (netrc-store-data source host prot
356 (or user
(cdr (assoc "login" result
)))
357 (cdr (assoc "password" result
))))))
359 (mapcar #'cdr result
)
362 (defun auth-source-delete (entry &rest spec
)
363 "Delete credentials according to SPEC in ENTRY."
364 (let ((host (plist-get spec
:host
))
365 (user (plist-get spec
:user
))
366 (prot (plist-get spec
:protocol
))
367 (source (plist-get entry
:source
)))
369 ;; Secret Service API.
371 (let ((coll (auth-get-source entry
)))
372 ;; Loop over candidates with a matching host attribute.
373 (dolist (elt (secrets-search-items coll
:host host
))
374 (when (and (or (not user
)
376 user
(secrets-get-attribute coll elt
:user
)))
379 prot
(secrets-get-attribute coll elt
:protocol
))))
380 (secrets-delete-item coll elt
)))))
381 (t)))) ;; netrc not implemented yes.
383 (defun auth-source-forget-user-or-password
384 (mode host protocol
&optional username
)
385 "Remove cached authentication token."
386 (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing
389 (format "%s %s:%s %s" mode host protocol username
)
390 (format "%s %s:%s" mode host protocol
))
393 (defun auth-source-forget-all-cached ()
394 "Forget all cached auth-source authentication tokens."
396 (setq auth-source-cache
(make-hash-table :test
'equal
)))
399 ;; (auth-source-forget-all-cached)
401 ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other")
402 ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz")
403 ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe")))
405 (defun auth-source-user-or-password
406 (mode host protocol
&optional username create-missing delete-existing
)
407 "Find MODE (string or list of strings) matching HOST and PROTOCOL.
409 USERNAME is optional and will be used as \"login\" in a search
410 across the Secret Service API (see secrets.el) if the resulting
411 items don't have a username. This means that if you search for
412 username \"joe\" and it matches an item but the item doesn't have
413 a :user attribute, the username \"joe\" will be returned.
415 A non nil DELETE-EXISTING means deleting any matching password
416 entry in the respective sources. This is useful only when
417 CREATE-MISSING is non nil as well; the intended use case is to
418 remove wrong password entries.
420 If no matching entry is found, and CREATE-MISSING is non nil,
421 the password will be retrieved interactively, and it will be
422 stored in the password database which matches best (see
425 MODE can be \"login\" or \"password\"."
426 (auth-source-do-debug
427 "auth-source-user-or-password: get %s for %s (%s) + user=%s"
428 mode host protocol username
)
429 (let* ((listy (listp mode
))
430 (mode (if listy mode
(list mode
)))
432 (format "%s %s:%s %s" mode host protocol username
)
433 (format "%s %s:%s" mode host protocol
)))
434 (search (list :host host
:protocol protocol
))
435 (search (if username
(append search
(list :user username
)) search
))
436 (found (if (not delete-existing
)
437 (gethash cname auth-source-cache
)
438 (remhash cname auth-source-cache
)
442 (auth-source-do-debug
443 "auth-source-user-or-password: cached %s=%s for %s (%s) + %s"
445 ;; don't show the password
446 (if (and (member "password" mode
) auth-source-hide-passwords
)
449 host protocol username
)
450 found
) ; return the found data
451 ;; else, if not found
452 (let ((choices (apply 'auth-source-pick search
)))
453 (dolist (choice choices
)
455 (apply 'auth-source-delete choice search
)
456 (setq found
(apply 'auth-source-retrieve mode choice search
)))
457 (and found
(return found
)))
459 ;; We haven't found something, so we will create it interactively.
460 (when (and (not found
) create-missing
)
461 (setq found
(apply 'auth-source-create
469 (auth-source-do-debug
470 "auth-source-user-or-password: found %s=%s for %s (%s) + %s"
472 ;; don't show the password
473 (if (and (member "password" mode
) auth-source-hide-passwords
)
475 host protocol username
)
476 (setq found
(if listy found
(car-safe found
)))
477 (when auth-source-do-cache
478 (puthash cname found auth-source-cache
)))
482 (defun auth-source-protocol-defaults (protocol)
483 "Return a list of default ports and names for PROTOCOL."
484 (cdr-safe (assoc protocol auth-source-protocols
)))
486 (defun auth-source-user-or-password-imap (mode host
)
487 (auth-source-user-or-password mode host
'imap
))
489 (defun auth-source-user-or-password-pop3 (mode host
)
490 (auth-source-user-or-password mode host
'pop3
))
492 (defun auth-source-user-or-password-ssh (mode host
)
493 (auth-source-user-or-password mode host
'ssh
))
495 (defun auth-source-user-or-password-sftp (mode host
)
496 (auth-source-user-or-password mode host
'sftp
))
498 (defun auth-source-user-or-password-smtp (mode host
)
499 (auth-source-user-or-password mode host
'smtp
))
501 (provide 'auth-source
)
503 ;;; auth-source.el ends here