Commit | Line | Data |
---|---|---|
8f7abae3 MB |
1 | ;;; auth-source.el --- authentication sources for Gnus and Emacs |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 2008, 2009, 2010 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 | |
8f7abae3 MB |
32 | ;;; Code: |
33 | ||
e952b711 MB |
34 | (require 'gnus-util) |
35 | ||
8f7abae3 | 36 | (eval-when-compile (require 'cl)) |
7d1a9163 | 37 | (autoload 'netrc-machine-user-or-password "netrc") |
ec7995fa KY |
38 | (autoload 'secrets-search-items "secrets") |
39 | (autoload 'secrets-get-alias "secrets") | |
40 | (autoload 'secrets-get-attribute "secrets") | |
fb178e4c | 41 | (autoload 'secrets-get-secret "secrets") |
8f7abae3 MB |
42 | |
43 | (defgroup auth-source nil | |
44 | "Authentication sources." | |
9b3ebcb6 | 45 | :version "23.1" ;; No Gnus |
8f7abae3 MB |
46 | :group 'gnus) |
47 | ||
9b3ebcb6 MB |
48 | (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") |
49 | (pop3 "pop3" "pop" "pop3s" "110" "995") | |
50 | (ssh "ssh" "22") | |
51 | (sftp "sftp" "115") | |
52 | (smtp "smtp" "25")) | |
53 | "List of authentication protocols and their names" | |
54 | ||
55 | :group 'auth-source | |
ec7995fa | 56 | :version "23.2" ;; No Gnus |
9b3ebcb6 MB |
57 | :type '(repeat :tag "Authentication Protocols" |
58 | (cons :tag "Protocol Entry" | |
59 | (symbol :tag "Protocol") | |
60 | (repeat :tag "Names" | |
61 | (string :tag "Name"))))) | |
62 | ||
63 | ;;; generate all the protocols in a format Customize can use | |
fb178e4c | 64 | ;;; TODO: generate on the fly from auth-source-protocols |
9b3ebcb6 MB |
65 | (defconst auth-source-protocols-customize |
66 | (mapcar (lambda (a) | |
67 | (let ((p (car-safe a))) | |
43d28dcd | 68 | (list 'const |
9b3ebcb6 MB |
69 | :tag (upcase (symbol-name p)) |
70 | p))) | |
71 | auth-source-protocols)) | |
72 | ||
ed778fad MB |
73 | (defvar auth-source-cache (make-hash-table :test 'equal) |
74 | "Cache for auth-source data") | |
75 | ||
76 | (defcustom auth-source-do-cache t | |
77 | "Whether auth-source should cache information." | |
78 | :group 'auth-source | |
ec7995fa | 79 | :version "23.2" ;; No Gnus |
ed778fad MB |
80 | :type `boolean) |
81 | ||
554a69b8 KY |
82 | (defcustom auth-source-debug nil |
83 | "Whether auth-source should log debug messages. | |
84 | Also see `auth-source-hide-passwords'. | |
85 | ||
86 | If the value is nil, debug messages are not logged. | |
87 | If the value is t, debug messages are logged with `message'. | |
88 | In that case, your authentication data will be in the | |
89 | clear (except for passwords, which are always stripped out). | |
90 | If the value is a function, debug messages are logged by calling | |
91 | that function using the same arguments as `message'." | |
92 | :group 'auth-source | |
ec7995fa | 93 | :version "23.2" ;; No Gnus |
7d1a9163 | 94 | :type `(choice |
554a69b8 KY |
95 | :tag "auth-source debugging mode" |
96 | (const :tag "Log using `message' to the *Messages* buffer" t) | |
97 | (function :tag "Function that takes arguments like `message'") | |
98 | (const :tag "Don't log anything" nil))) | |
99 | ||
100 | (defcustom auth-source-hide-passwords t | |
101 | "Whether auth-source should hide passwords in log messages. | |
102 | Only relevant if `auth-source-debug' is not nil." | |
103 | :group 'auth-source | |
ec7995fa | 104 | :version "23.2" ;; No Gnus |
554a69b8 KY |
105 | :type `boolean) |
106 | ||
fb178e4c | 107 | (defcustom auth-sources '((:source "~/.authinfo.gpg")) |
8f7abae3 MB |
108 | "List of authentication sources. |
109 | ||
fb178e4c KY |
110 | The default will get login and password information from a .gpg |
111 | file, which you should set up with the EPA/EPG packages to be | |
112 | encrypted. See the auth.info manual for details. | |
113 | ||
ec7995fa KY |
114 | Each entry is the authentication type with optional properties. |
115 | ||
116 | It's best to customize this with `M-x customize-variable' because the choices | |
117 | can get pretty complex." | |
8f7abae3 | 118 | :group 'auth-source |
ec7995fa | 119 | :version "23.2" ;; No Gnus |
9b3ebcb6 MB |
120 | :type `(repeat :tag "Authentication Sources" |
121 | (list :tag "Source definition" | |
122 | (const :format "" :value :source) | |
ec7995fa KY |
123 | (choice :tag "Authentication backend choice" |
124 | (string :tag "Authentication Source (file)") | |
125 | (list :tag "secrets.el (Secret Service API/KWallet/GNOME KeyRing)" | |
126 | (const :format "" :value :secrets) | |
127 | (choice :tag "Collection to use" | |
128 | (string :tag "Collection name") | |
129 | (const :tag "Default" 'default) | |
fb178e4c KY |
130 | (const :tag "Login" "login") |
131 | (const :tag "Temporary" "session")))) | |
ec7995fa KY |
132 | (repeat :tag "Extra Parameters" :inline t |
133 | (choice :tag "Extra parameter" | |
fb178e4c KY |
134 | (list :tag "Host (omit to match as a fallback)" |
135 | (const :format "" :value :host) | |
136 | (choice :tag "Host (machine) choice" | |
137 | (const :tag "Any" t) | |
138 | (regexp :tag "Host (machine) regular expression"))) | |
139 | (list :tag "Protocol (omit to match as a fallback)" | |
140 | (const :format "" :value :protocol) | |
141 | (choice :tag "Protocol" | |
142 | (const :tag "Any" t) | |
143 | ,@auth-source-protocols-customize)) | |
144 | (list :tag "User (omit to match as a fallback)" :inline t | |
145 | (const :format "" :value :user) | |
ec7995fa KY |
146 | (choice :tag "Personality or username" |
147 | (const :tag "Any" t) | |
ec7995fa | 148 | (string :tag "Specific user name")))))))) |
8f7abae3 MB |
149 | |
150 | ;; temp for debugging | |
9b3ebcb6 MB |
151 | ;; (unintern 'auth-source-protocols) |
152 | ;; (unintern 'auth-sources) | |
153 | ;; (customize-variable 'auth-sources) | |
154 | ;; (setq auth-sources nil) | |
155 | ;; (format "%S" auth-sources) | |
156 | ;; (customize-variable 'auth-source-protocols) | |
157 | ;; (setq auth-source-protocols nil) | |
158 | ;; (format "%S" auth-source-protocols) | |
fb178e4c | 159 | ;; (auth-source-pick nil :host "a" :port 'imap) |
9b3ebcb6 MB |
160 | ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap) |
161 | ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap) | |
162 | ;; (auth-source-user-or-password-imap "login" "imap.myhost.com") | |
163 | ;; (auth-source-user-or-password-imap "password" "imap.myhost.com") | |
164 | ;; (auth-source-protocol-defaults 'imap) | |
165 | ||
554a69b8 KY |
166 | ;; (let ((auth-source-debug 'debug)) (auth-source-debug "hello")) |
167 | ;; (let ((auth-source-debug t)) (auth-source-debug "hello")) | |
168 | ;; (let ((auth-source-debug nil)) (auth-source-debug "hello")) | |
169 | (defun auth-source-do-debug (&rest msg) | |
170 | ;; set logger to either the function in auth-source-debug or 'message | |
171 | ;; note that it will be 'message if auth-source-debug is nil, so | |
172 | ;; we also check the value | |
173 | (when auth-source-debug | |
174 | (let ((logger (if (functionp auth-source-debug) | |
7d1a9163 | 175 | auth-source-debug |
554a69b8 KY |
176 | 'message))) |
177 | (apply logger msg)))) | |
178 | ||
fb178e4c KY |
179 | ;; (auth-source-pick nil :host "any" :protocol 'imap :user "joe") |
180 | ;; (auth-source-pick t :host "any" :protocol 'imap :user "joe") | |
181 | ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") | |
182 | ;; (:source (:secrets "session") :host t :protocol t :user "joe") | |
183 | ;; (:source (:secrets "login") :host t :protocol t) | |
184 | ;; (:source "~/.authinfo.gpg" :host t :protocol t))) | |
185 | ||
186 | ;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") | |
187 | ;; (:source (:secrets "session") :host t :protocol t :user "joe") | |
188 | ;; (:source (:secrets "login") :host t :protocol t) | |
189 | ;; )) | |
190 | ||
191 | ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) | |
192 | ||
193 | (defun auth-source-pick (&rest spec) | |
194 | "Parse `auth-sources' for matches of the SPEC plist. | |
195 | ||
196 | Common keys are :host, :protocol, and :user. A value of t in | |
197 | SPEC means to always succeed in the match. A string value is | |
198 | matched as a regex. | |
9b3ebcb6 | 199 | |
fb178e4c KY |
200 | The first pass skips fallback choices. If no choices are found |
201 | on the first pass, a second pass is made including the fallback | |
202 | choices. | |
203 | ||
204 | For string (filename) sources, fallback choices are those where | |
205 | PROTOCOL or HOST are nil. | |
206 | ||
207 | For secrets.el collections, the :host and :protocol keys are not | |
208 | checked for fallback choices." | |
9b3ebcb6 | 209 | (let (choices) |
fb178e4c KY |
210 | (dolist (fallback '(nil t)) |
211 | (let ((keys (loop for i below (length spec) by 2 | |
212 | collect (nth i spec))) | |
213 | (default-session-fallback "login")) | |
214 | (dolist (choice auth-sources) | |
215 | (let* ((s (plist-get choice :source)) | |
216 | ;; this is only set for Secret Service API specs (see secrets.el) | |
afae6cd4 | 217 | (coll (and (consp s) (plist-get s :secrets))) |
fb178e4c KY |
218 | (score 0)) |
219 | (cond | |
220 | (coll ; use secrets.el here | |
221 | (when (eq coll 'default) | |
222 | (setq coll (secrets-get-alias "default")) | |
223 | (unless coll | |
224 | (auth-source-do-debug | |
225 | "No 'default' alias. Trying collection '%s'." | |
226 | default-session-fallback) | |
227 | (setq coll default-session-fallback))) | |
228 | (let* ((coll-search (cond | |
229 | ((stringp coll) coll) | |
230 | ||
231 | ;; when the collection is nil: | |
232 | ;; in fallback mode, accept it as any | |
233 | ;; otherwise, hope to fail | |
234 | ((null coll) (if fallback | |
235 | nil | |
236 | " *fallback-fail*")))) | |
237 | ;; assemble a search query for secrets-search-items | |
238 | ;; in fallback mode, host and protocol are not checked | |
239 | (other-search (loop for k | |
240 | in (if fallback | |
241 | (remove :host | |
242 | (remove :protocol keys)) | |
243 | keys) | |
244 | append (list | |
245 | k | |
246 | ;; convert symbols to a string | |
247 | (let ((v (plist-get spec k))) | |
248 | (if (stringp v) | |
249 | v | |
250 | (prin1-to-string v)))))) | |
251 | ;; the score is based on how exact the search was, | |
252 | ;; plus base score = 1 for any match | |
253 | (score (1+ (length other-search))) | |
254 | (results (apply 'secrets-search-items | |
255 | coll-search | |
256 | other-search))) | |
257 | (auth-source-do-debug | |
258 | "auth-source-pick: got items %s in collection '%s' + %s" | |
259 | results coll-search other-search) | |
260 | ;; put the results in the choices variable | |
261 | (dolist (result results) | |
262 | (setq choices (cons (list score | |
263 | `(:source secrets | |
264 | :item ,result | |
265 | :collection ,coll | |
266 | :search ,coll-search | |
267 | ,@other-search)) | |
268 | choices))))) | |
269 | ;; this is any non-secrets spec (currently means a string filename) | |
270 | (t | |
271 | (let ((match t)) | |
272 | (dolist (k keys) | |
273 | (let* ((v (plist-get spec k)) | |
274 | (choicev (plist-get choice k))) | |
275 | (setq match | |
276 | (and match | |
277 | (or (eq t choicev) ; source always matches spec key | |
278 | ;; source key gives regex to match against spec | |
279 | (and (stringp choicev) (string-match choicev v)) | |
280 | ;; source key gives symbol to match against spec | |
281 | (and (symbolp choicev) (eq choicev v)) | |
282 | ;; in fallback mode, missing source key is OK | |
283 | fallback))) | |
284 | (when match (incf score)))) ; increment the score for each match | |
285 | ||
286 | ;; now if the whole iteration resulted in a match: | |
287 | (when match | |
288 | (setq choices (cons (list score choice) choices)))))))) | |
289 | ;; when there were matches, skip the second pass | |
290 | (when choices (return choices)))) | |
291 | ||
292 | ;; return the results sorted by score | |
293 | (mapcar 'cadr (sort choices (lambda (x y) (> (car x) (car y))))))) | |
9b3ebcb6 | 294 | |
ed778fad MB |
295 | (defun auth-source-forget-user-or-password (mode host protocol) |
296 | (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing | |
297 | (remhash (format "%s %s:%s" mode host protocol) auth-source-cache)) | |
298 | ||
3b36c17e MB |
299 | (defun auth-source-forget-all-cached () |
300 | "Forget all cached auth-source authentication tokens." | |
301 | (interactive) | |
302 | (setq auth-source-cache (make-hash-table :test 'equal))) | |
303 | ||
fb178e4c KY |
304 | ;; (progn |
305 | ;; (auth-source-forget-all-cached) | |
306 | ;; (list | |
307 | ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other") | |
308 | ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz") | |
309 | ;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe"))) | |
310 | ||
311 | (defun auth-source-user-or-password (mode host protocol &optional username) | |
3b36c17e | 312 | "Find MODE (string or list of strings) matching HOST and PROTOCOL. |
fb178e4c KY |
313 | |
314 | USERNAME is optional and will be used as \"login\" in a search | |
315 | across the Secret Service API (see secrets.el) if the resulting | |
316 | items don't have a username. This means that if you search for | |
317 | username \"joe\" and it matches an item but the item doesn't have | |
318 | a :user attribute, the username \"joe\" will be returned. | |
319 | ||
3b36c17e | 320 | MODE can be \"login\" or \"password\" for example." |
554a69b8 | 321 | (auth-source-do-debug |
fb178e4c KY |
322 | "auth-source-user-or-password: get %s for %s (%s) + user=%s" |
323 | mode host protocol username) | |
3b36c17e MB |
324 | (let* ((listy (listp mode)) |
325 | (mode (if listy mode (list mode))) | |
fb178e4c KY |
326 | (extras (when username `(:user ,username))) |
327 | (cname (format "%s %s:%s %s" mode host protocol extras)) | |
328 | (search (list :host host :protocol protocol)) | |
329 | (search (if username (append search (list :user username)) search)) | |
ed778fad MB |
330 | (found (gethash cname auth-source-cache))) |
331 | (if found | |
332 | (progn | |
554a69b8 | 333 | (auth-source-do-debug |
fb178e4c | 334 | "auth-source-user-or-password: cached %s=%s for %s (%s) + %s" |
554a69b8 KY |
335 | mode |
336 | ;; don't show the password | |
fb178e4c KY |
337 | (if (and (member "password" mode) auth-source-hide-passwords) |
338 | "SECRET" | |
339 | found) | |
340 | host protocol extras) | |
341 | found) ; return the found data | |
342 | ;; else, if not found | |
343 | (dolist (choice (apply 'auth-source-pick search)) | |
344 | (setq found (cond | |
345 | ;; the secrets.el spec | |
346 | ((eq (plist-get choice :source) 'secrets) | |
347 | (let ((coll (plist-get choice :search)) | |
348 | (item (plist-get choice :item))) | |
349 | (mapcar (lambda (m) | |
350 | (if (equal "password" m) | |
351 | (secrets-get-secret coll item) | |
352 | ;; the user name is either | |
353 | (or | |
354 | ;; the secret's attribute :user, or | |
355 | (secrets-get-attribute coll item :user) | |
356 | ;; the originally requested :user | |
357 | username | |
358 | "unknown-user"))) | |
359 | mode))) | |
360 | (t ; anything else is netrc | |
361 | (netrc-machine-user-or-password | |
362 | mode | |
363 | (plist-get choice :source) | |
364 | (list host) | |
365 | (list (format "%s" protocol)) | |
366 | (auth-source-protocol-defaults protocol))))) | |
ed778fad | 367 | (when found |
554a69b8 | 368 | (auth-source-do-debug |
fb178e4c | 369 | "auth-source-user-or-password: found %s=%s for %s (%s) + %s" |
554a69b8 KY |
370 | mode |
371 | ;; don't show the password | |
372 | (if (and (member "password" mode) auth-source-hide-passwords) "SECRET" found) | |
fb178e4c | 373 | host protocol extras) |
3b36c17e | 374 | (setq found (if listy found (car-safe found))) |
ed778fad MB |
375 | (when auth-source-do-cache |
376 | (puthash cname found auth-source-cache))) | |
9b3ebcb6 | 377 | (return found))))) |
fb178e4c | 378 | |
9b3ebcb6 MB |
379 | (defun auth-source-protocol-defaults (protocol) |
380 | "Return a list of default ports and names for PROTOCOL." | |
381 | (cdr-safe (assoc protocol auth-source-protocols))) | |
382 | ||
58a67d68 MB |
383 | (defun auth-source-user-or-password-imap (mode host) |
384 | (auth-source-user-or-password mode host 'imap)) | |
9b3ebcb6 | 385 | |
58a67d68 MB |
386 | (defun auth-source-user-or-password-pop3 (mode host) |
387 | (auth-source-user-or-password mode host 'pop3)) | |
9b3ebcb6 | 388 | |
58a67d68 MB |
389 | (defun auth-source-user-or-password-ssh (mode host) |
390 | (auth-source-user-or-password mode host 'ssh)) | |
9b3ebcb6 | 391 | |
58a67d68 MB |
392 | (defun auth-source-user-or-password-sftp (mode host) |
393 | (auth-source-user-or-password mode host 'sftp)) | |
9b3ebcb6 | 394 | |
58a67d68 MB |
395 | (defun auth-source-user-or-password-smtp (mode host) |
396 | (auth-source-user-or-password mode host 'smtp)) | |
8f7abae3 MB |
397 | |
398 | (provide 'auth-source) | |
399 | ||
400 | ;; arch-tag: ff1afe78-06e9-42c2-b693-e9f922cbe4ab | |
401 | ;;; auth-source.el ends here |