1 ;;; auth-source.el --- authentication sources for Gnus and Emacs
3 ;; Copyright (C) 2008-2011 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
42 (require 'password-cache)
46 (eval-when-compile (require 'cl))
48 (or (ignore-errors (require 'eieio))
49 ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
51 (let ((load-path (cons (expand-file-name
52 "gnus-fallback-lib/eieio"
53 (file-name-directory (locate-library "gnus")))
57 "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
59 (autoload 'secrets-create-item "secrets")
60 (autoload 'secrets-delete-item "secrets")
61 (autoload 'secrets-get-alias "secrets")
62 (autoload 'secrets-get-attributes "secrets")
63 (autoload 'secrets-get-secret "secrets")
64 (autoload 'secrets-list-collections "secrets")
65 (autoload 'secrets-search-items "secrets")
67 (defvar secrets-enabled)
69 (defgroup auth-source nil
70 "Authentication sources."
71 :version "23.1" ;; No Gnus
75 (defcustom auth-source-cache-expiry 7200
76 "How many seconds passwords are cached, or nil to disable
77 expiring. Overrides `password-cache-expiry' through a
80 :type '(choice (const :tag "Never" nil)
81 (const :tag "All Day" 86400)
82 (const :tag "2 Hours" 7200)
83 (const :tag "30 Minutes" 1800)
84 (integer :tag "Seconds")))
86 (defclass auth-source-backend ()
91 :documentation "The backend type.")
92 (source :initarg :source
95 :documentation "The backend source.")
100 :documentation "The backend host.")
105 :documentation "The backend user.")
110 :documentation "The backend protocol.")
111 (create-function :initarg :create-function
115 :documentation "The create function.")
116 (search-function :initarg :search-function
120 :documentation "The search function.")))
122 (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
123 (pop3 "pop3" "pop" "pop3s" "110" "995")
127 "List of authentication protocols and their names"
130 :version "23.2" ;; No Gnus
131 :type '(repeat :tag "Authentication Protocols"
132 (cons :tag "Protocol Entry"
133 (symbol :tag "Protocol")
135 (string :tag "Name")))))
137 ;;; generate all the protocols in a format Customize can use
138 ;;; TODO: generate on the fly from auth-source-protocols
139 (defconst auth-source-protocols-customize
141 (let ((p (car-safe a)))
143 :tag (upcase (symbol-name p))
145 auth-source-protocols))
147 (defvar auth-source-creation-defaults nil
148 "Defaults for creating token values. Usually let-bound.")
150 (defvar auth-source-creation-prompts nil
151 "Default prompts for token values. Usually let-bound.")
153 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
155 (defcustom auth-source-save-behavior 'ask
156 "If set, auth-source will respect it for save behavior."
158 :version "23.2" ;; No Gnus
160 :tag "auth-source new token save behavior"
161 (const :tag "Always save" t)
162 (const :tag "Never save" nil)
163 (const :tag "Ask" ask)))
165 (defvar auth-source-magic "auth-source-magic ")
167 (defcustom auth-source-do-cache t
168 "Whether auth-source should cache information with `password-cache'."
170 :version "23.2" ;; No Gnus
173 (defcustom auth-source-debug nil
174 "Whether auth-source should log debug messages.
176 If the value is nil, debug messages are not logged.
178 If the value is t, debug messages are logged with `message'. In
179 that case, your authentication data will be in the clear (except
182 If the value is a function, debug messages are logged by calling
183 that function using the same arguments as `message'."
185 :version "23.2" ;; No Gnus
187 :tag "auth-source debugging mode"
188 (const :tag "Log using `message' to the *Messages* buffer" t)
189 (const :tag "Log all trivia with `message' to the *Messages* buffer"
191 (function :tag "Function that takes arguments like `message'")
192 (const :tag "Don't log anything" nil)))
194 (defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
195 "List of authentication sources.
197 The default will get login and password information from
198 \"~/.authinfo.gpg\", which you should set up with the EPA/EPG
199 packages to be encrypted. If that file doesn't exist, it will
200 try the unencrypted version \"~/.authinfo\" and the famous
203 See the auth.info manual for details.
205 Each entry is the authentication type with optional properties.
207 It's best to customize this with `M-x customize-variable' because the choices
208 can get pretty complex."
210 :version "24.1" ;; No Gnus
211 :type `(repeat :tag "Authentication Sources"
213 (string :tag "Just a file")
214 (const :tag "Default Secrets API Collection" 'default)
215 (const :tag "Login Secrets API Collection" "secrets:Login")
216 (const :tag "Temp Secrets API Collection" "secrets:session")
217 (list :tag "Source definition"
218 (const :format "" :value :source)
219 (choice :tag "Authentication backend choice"
220 (string :tag "Authentication Source (file)")
222 :tag "Secret Service API/KWallet/GNOME Keyring"
223 (const :format "" :value :secrets)
224 (choice :tag "Collection to use"
225 (string :tag "Collection name")
226 (const :tag "Default" 'default)
227 (const :tag "Login" "Login")
229 :tag "Temporary" "session"))))
230 (repeat :tag "Extra Parameters" :inline t
231 (choice :tag "Extra parameter"
234 (const :format "" :value :host)
235 (choice :tag "Host (machine) choice"
238 :tag "Regular expression")))
241 (const :format "" :value :port)
245 ,@auth-source-protocols-customize))
246 (list :tag "User" :inline t
247 (const :format "" :value :user)
248 (choice :tag "Personality/Username"
250 (string :tag "Name")))))))))
252 (defcustom auth-source-gpg-encrypt-to t
253 "List of recipient keys that `authinfo.gpg' encrypted to.
254 If the value is not a list, symmetric encryption will be used."
256 :version "24.1" ;; No Gnus
257 :type '(choice (const :tag "Symmetric encryption" t)
258 (repeat :tag "Recipient public keys"
259 (string :tag "Recipient public key"))))
261 ;; temp for debugging
262 ;; (unintern 'auth-source-protocols)
263 ;; (unintern 'auth-sources)
264 ;; (customize-variable 'auth-sources)
265 ;; (setq auth-sources nil)
266 ;; (format "%S" auth-sources)
267 ;; (customize-variable 'auth-source-protocols)
268 ;; (setq auth-source-protocols nil)
269 ;; (format "%S" auth-source-protocols)
270 ;; (auth-source-pick nil :host "a" :port 'imap)
271 ;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
272 ;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
273 ;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
274 ;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
275 ;; (auth-source-protocol-defaults 'imap)
277 ;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
278 ;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
279 ;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
280 (defun auth-source-do-debug (&rest msg)
281 (when auth-source-debug
282 (apply 'auth-source-do-warn msg)))
284 (defun auth-source-do-trivia (&rest msg)
285 (when (or (eq auth-source-debug 'trivia)
286 (functionp auth-source-debug))
287 (apply 'auth-source-do-warn msg)))
289 (defun auth-source-do-warn (&rest msg)
291 ;; set logger to either the function in auth-source-debug or 'message
292 ;; note that it will be 'message if auth-source-debug is nil
293 (if (functionp auth-source-debug)
299 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
300 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
301 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
302 ;; (:source (:secrets "session") :host t :port t :user "joe")
303 ;; (:source (:secrets "Login") :host t :port t)
304 ;; (:source "~/.authinfo.gpg" :host t :port t)))
306 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
307 ;; (:source (:secrets "session") :host t :port t :user "joe")
308 ;; (:source (:secrets "Login") :host t :port t)
311 ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
313 ;; (auth-source-backend-parse "myfile.gpg")
314 ;; (auth-source-backend-parse 'default)
315 ;; (auth-source-backend-parse "secrets:Login")
317 (defun auth-source-backend-parse (entry)
318 "Creates an auth-source-backend from an ENTRY in `auth-sources'."
319 (auth-source-backend-parse-parameters
322 ;; take 'default and recurse to get it as a Secrets API default collection
323 ;; matching any user, host, and protocol
325 (auth-source-backend-parse '(:source (:secrets default))))
326 ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
327 ;; matching any user, host, and protocol
328 ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
329 (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
330 ;; take just a file name and recurse to get it as a netrc file
331 ;; matching any user, host, and protocol
333 (auth-source-backend-parse `(:source ,entry)))
335 ;; a file name with parameters
336 ((stringp (plist-get entry :source))
338 (plist-get entry :source)
339 :source (plist-get entry :source)
341 :search-function 'auth-source-netrc-search
342 :create-function 'auth-source-netrc-create))
344 ;; the Secrets API. We require the package, in order to have a
345 ;; defined value for `secrets-enabled'.
347 (not (null (plist-get entry :source))) ; the source must not be nil
348 (listp (plist-get entry :source)) ; and it must be a list
349 (require 'secrets nil t) ; and we must load the Secrets API
350 secrets-enabled) ; and that API must be enabled
352 ;; the source is either the :secrets key in ENTRY or
353 ;; if that's missing or nil, it's "session"
354 (let ((source (or (plist-get (plist-get entry :source) :secrets)
357 ;; if the source is a symbol, we look for the alias named so,
358 ;; and if that alias is missing, we use "Login"
359 (when (symbolp source)
360 (setq source (or (secrets-get-alias (symbol-name source))
363 (if (featurep 'secrets)
365 (format "Secrets API (%s)" source)
368 :search-function 'auth-source-secrets-search
369 :create-function 'auth-source-secrets-create)
371 "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
373 (format "Ignored Secrets API (%s)" source)
380 "auth-source-backend-parse: invalid backend spec: %S" entry)
386 (defun auth-source-backend-parse-parameters (entry backend)
387 "Fills in the extra auth-source-backend parameters of ENTRY.
388 Using the plist ENTRY, get the :host, :port, and :user search
390 (let ((entry (if (stringp entry)
394 (when (setq val (plist-get entry :host))
395 (oset backend host val))
396 (when (setq val (plist-get entry :user))
397 (oset backend user val))
398 (when (setq val (plist-get entry :port))
399 (oset backend port val)))
402 ;; (mapcar 'auth-source-backend-parse auth-sources)
404 (defun* auth-source-search (&rest spec
405 &key type max host user port secret
406 require create delete
408 "Search or modify authentication backends according to SPEC.
410 This function parses `auth-sources' for matches of the SPEC
411 plist. It can optionally create or update an authentication
412 token if requested. A token is just a standard Emacs property
413 list with a :secret property that can be a function; all the
414 other properties will always hold scalar values.
416 Typically the :secret property, if present, contains a password.
418 Common search keys are :max, :host, :port, and :user. In
419 addition, :create specifies how tokens will be or created.
420 Finally, :type can specify which backend types you want to check.
422 A string value is always matched literally. A symbol is matched
423 as its string value, literally. All the SPEC values can be
424 single values (symbol or string) or lists thereof (in which case
425 any of the search terms matches).
427 :create t means to create a token if possible.
429 A new token will be created if no matching tokens were found.
430 The new token will have only the keys the backend requires. For
431 the netrc backend, for instance, that's the user, host, and
436 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
437 (A . \"default A\"))))
438 (auth-source-search :host \"mine\" :type 'netrc :max 1
439 :P \"pppp\" :Q \"qqqq\"
444 \"Search for any entry matching host 'mine' in backends of type
445 'netrc', maximum one result.
447 Create a new entry if you found none. The netrc backend will
448 automatically require host, user, and port. The host will be
449 'mine'. We prompt for the user with default 'defaultUser' and
450 for the port without a default. We will not prompt for A, Q,
451 or P. The resulting token will only have keys user, host, and
454 :create '(A B C) also means to create a token if possible.
456 The behavior is like :create t but if the list contains any
457 parameter, that parameter will be required in the resulting
458 token. The value for that parameter will be obtained from the
459 search parameters or from user input. If any queries are needed,
460 the alist `auth-source-creation-defaults' will be checked for the
461 default value. If the user, host, or port are missing, the alist
462 `auth-source-creation-prompts' will be used to look up the
463 prompts IN THAT ORDER (so the 'user prompt will be queried first,
464 then 'host, then 'port, and finally 'secret). Each prompt string
465 can use %u, %h, and %p to show the user, host, and port.
469 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
470 (A . \"default A\")))
471 (auth-source-creation-prompts
472 '((password . \"Enter IMAP password for %h:%p: \"))))
473 (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
474 :P \"pppp\" :Q \"qqqq\"
479 \"Search for any entry matching host 'nonesuch'
480 or 'twosuch' in backends of type 'netrc', maximum one result.
482 Create a new entry if you found none. The netrc backend will
483 automatically require host, user, and port. The host will be
484 'nonesuch' and Q will be 'qqqq'. We prompt for the password
485 with the shown prompt. We will not prompt for Q. The resulting
486 token will have keys user, host, port, A, B, and Q. It will not
487 have P with any value, even though P is used in the search to
488 find only entries that have P set to 'pppp'.\"
490 When multiple values are specified in the search parameter, the
491 user is prompted for which one. So :host (X Y Z) would ask the
492 user to choose between X, Y, and Z.
494 This creation can fail if the search was not specific enough to
495 create a new token (it's up to the backend to decide that). You
496 should `catch' the backend-specific error as usual. Some
497 backends (netrc, at least) will prompt the user rather than throw
500 :require (A B C) means that only results that contain those
501 tokens will be returned. Thus for instance requiring :secret
502 will ensure that any results will actually have a :secret
505 :delete t means to delete any found entries. nil by default.
506 Use `auth-source-delete' in ELisp code instead of calling
507 `auth-source-search' directly with this parameter.
509 :type (X Y Z) will check only those backend types. 'netrc and
510 'secrets are the only ones supported right now.
512 :max N means to try to return at most N items (defaults to 1).
513 When 0 the function will return just t or nil to indicate if any
514 matches were found. More than N items may be returned, depending
515 on the search and the backend.
517 :host (X Y Z) means to match only hosts X, Y, or Z according to
518 the match rules above. Defaults to t.
520 :user (X Y Z) means to match only users X, Y, or Z according to
521 the match rules above. Defaults to t.
523 :port (P Q R) means to match only protocols P, Q, or R.
526 :K (V1 V2 V3) for any other key K will match values V1, V2, or
527 V3 (note the match rules above).
529 The return value is a list with at most :max tokens. Each token
530 is a plist with keys :backend :host :port :user, plus any other
531 keys provided by the backend (notably :secret). But note the
532 exception for :max 0, which see above.
534 The token can hold a :save-function key. If you call that, the
535 user will be prompted to save the data to the backend. You can't
536 request that this should happen right after creation, because
537 `auth-source-search' has no way of knowing if the token is
538 actually useful. So the caller must arrange to call this function.
540 The token's :secret key can hold a function. In that case you
541 must call it to obtain the actual value."
542 (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
544 (ignored-keys '(:require :create :delete :max))
545 (keys (loop for i below (length spec) by 2
546 unless (memq (nth i spec) ignored-keys)
547 collect (nth i spec)))
548 (cached (auth-source-remembered-p spec))
549 ;; note that we may have cached results but found is still nil
550 ;; (there were no results from the search)
551 (found (auth-source-recall spec))
552 filtered-backends accessor-key backend)
554 (if (and cached auth-source-do-cache)
555 (auth-source-do-debug
556 "auth-source-search: found %d CACHED results matching %S"
560 (or (eq t create) (listp create)) t
561 "Invalid auth-source :create parameter (must be t or a list): %s %s")
565 "Invalid auth-source :require parameter (must be a list): %s")
567 (setq filtered-backends (copy-sequence backends))
568 (dolist (backend backends)
570 ;; ignore invalid slots
571 (condition-case signal
572 (unless (eval `(auth-source-search-collection
574 (oref backend ,key)))
575 (setq filtered-backends (delq backend filtered-backends))
577 (invalid-slot-name))))
579 (auth-source-do-trivia
580 "auth-source-search: found %d backends matching %S"
581 (length filtered-backends) spec)
583 ;; (debug spec "filtered" filtered-backends)
584 ;; First go through all the backends without :create, so we can
586 (setq found (auth-source-search-backends filtered-backends
590 ;; create is always nil here
594 (auth-source-do-debug
595 "auth-source-search: found %d results (max %d) matching %S"
596 (length found) max spec)
598 ;; If we didn't find anything, then we allow the backend(s) to
599 ;; create the entries.
602 (setq found (auth-source-search-backends filtered-backends
608 (auth-source-do-debug
609 "auth-source-search: CREATED %d results (max %d) matching %S"
610 (length found) max spec))
612 ;; note we remember the lack of result too, if it's applicable
613 (when auth-source-do-cache
614 (auth-source-remember spec found)))
618 (defun auth-source-search-backends (backends spec max create delete require)
620 (dolist (backend backends)
621 (when (> max (length matches)) ; when we need more matches...
622 (let* ((bmatches (apply
623 (slot-value backend 'search-function)
625 ;; note we're overriding whatever the spec
626 ;; has for :require, :create, and :delete
632 (auth-source-do-trivia
633 "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
634 (length bmatches) max
635 (slot-value backend :type)
636 (slot-value backend :source)
638 (setq matches (append matches bmatches))))))
641 ;;; (auth-source-search :max 1)
642 ;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
643 ;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
644 ;;; (auth-source-search :host "nonesuch" :type 'secrets)
646 (defun* auth-source-delete (&rest spec
649 "Delete entries from the authentication backends according to SPEC.
650 Calls `auth-source-search' with the :delete property in SPEC set to t.
651 The backend may not actually delete the entries.
653 Returns the deleted entries."
654 (auth-source-search (plist-put spec :delete t)))
656 (defun auth-source-search-collection (collection value)
657 "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
658 (when (and (atom collection) (not (eq t collection)))
659 (setq collection (list collection)))
661 ;; (debug :collection collection :value value)
662 (or (eq collection t)
664 (equal collection value)
665 (member value collection)))
667 (defun auth-source-forget-all-cached ()
668 "Forget all cached auth-source data."
670 (loop for sym being the symbols of password-data
671 ;; when the symbol name starts with auth-source-magic
672 when (string-match (concat "^" auth-source-magic)
675 do (password-cache-remove (symbol-name sym))))
677 (defun auth-source-remember (spec found)
678 "Remember FOUND search results for SPEC."
679 (let ((password-cache-expiry auth-source-cache-expiry))
681 (concat auth-source-magic (format "%S" spec)) found)))
683 (defun auth-source-recall (spec)
684 "Recall FOUND search results for SPEC."
685 (password-read-from-cache
686 (concat auth-source-magic (format "%S" spec))))
688 (defun auth-source-remembered-p (spec)
689 "Check if SPEC is remembered."
691 (concat auth-source-magic (format "%S" spec))))
693 (defun auth-source-forget (spec)
694 "Forget any cached data matching SPEC exactly.
696 This is the same SPEC you passed to `auth-source-search'.
697 Returns t or nil for forgotten or not found."
698 (password-cache-remove (concat auth-source-magic (format "%S" spec))))
700 ;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
702 ;;; (auth-source-remember '(:host "wedd") '(4 5 6))
703 ;;; (auth-source-remembered-p '(:host "wedd"))
704 ;;; (auth-source-remember '(:host "xedd") '(1 2 3))
705 ;;; (auth-source-remembered-p '(:host "xedd"))
706 ;;; (auth-source-remembered-p '(:host "zedd"))
707 ;;; (auth-source-recall '(:host "xedd"))
708 ;;; (auth-source-recall '(:host t))
709 ;;; (auth-source-forget+ :host t)
711 (defun* auth-source-forget+ (&rest spec &allow-other-keys)
712 "Forget any cached data matching SPEC. Returns forgotten count.
714 This is not a full `auth-source-search' spec but works similarly.
715 For instance, \(:host \"myhost\" \"yourhost\") would find all the
716 cached data that was found with a search for those two hosts,
717 while \(:host t) would find all host entries."
720 (loop for sym being the symbols of password-data
721 ;; when the symbol name matches with auth-source-magic
722 when (and (setq sname (symbol-name sym))
723 (string-match (concat "^" auth-source-magic "\\(.+\\)")
725 ;; and the spec matches what was stored in the cache
726 (auth-source-specmatchp spec (read (match-string 1 sname))))
729 (password-cache-remove sname)
733 (defun auth-source-specmatchp (spec stored)
734 (let ((keys (loop for i below (length spec) by 2
735 collect (nth i spec))))
738 (unless (auth-source-search-collection (plist-get stored key)
739 (plist-get spec key))
743 ;;; Backend specific parsing: netrc/authinfo backend
745 (defun auth-source-ensure-strings (values)
746 (unless (listp values)
747 (setq values (list values)))
748 (mapcar (lambda (value)
754 (defvar auth-source-netrc-cache nil)
756 ;;; (auth-source-netrc-parse "~/.authinfo.gpg")
757 (defun* auth-source-netrc-parse (&rest
759 &key file max host user port delete require
761 "Parse FILE and return a list of all entries in the file.
762 Note that the MAX parameter is used so we can exit the parse early."
764 ;; We got already parsed contents; just return it.
766 (when (file-exists-p file)
767 (setq port (auth-source-ensure-strings port))
769 (let* ((tokens '("machine" "host" "default" "login" "user"
770 "password" "account" "macdef" "force"
772 (max (or max 5000)) ; sanity check: default to stop at 5K
774 (cached (cdr-safe (assoc file auth-source-netrc-cache)))
775 (cached-mtime (plist-get cached :mtime))
776 (cached-secrets (plist-get cached :secret))
777 alist elem result pair)
779 (if (and (functionp cached-secrets)
781 (nth 5 (file-attributes file))))
783 (auth-source-do-trivia
784 "auth-source-netrc-parse: using CACHED file data for %s"
786 (insert (funcall cached-secrets)))
787 (insert-file-contents file)
788 ;; cache all netrc files (used to be just .gpg files)
789 ;; Store the contents of the file heavily encrypted in memory.
790 ;; (note for the irony-impaired: they are just obfuscated)
791 (aput 'auth-source-netrc-cache file
792 (list :mtime (nth 5 (file-attributes file))
793 :secret (lexical-let ((v (rot13-string
794 (base64-encode-string
796 (lambda () (base64-decode-string
797 (rot13-string v)))))))
798 (goto-char (point-min))
799 ;; Go through the file, line by line.
800 (while (and (not (eobp))
803 (narrow-to-region (point) (point-at-eol))
804 ;; For each line, get the tokens and values.
806 (skip-chars-forward "\t ")
807 ;; Skip lines that begin with a "#".
808 (if (eq (char-after) ?#)
809 (goto-char (point-max))
812 (if (= (following-char) ?\")
813 (read (current-buffer))
815 (point) (progn (skip-chars-forward "^\t ")
818 ((equal elem "macdef")
819 ;; We skip past the macro definition.
821 (while (and (zerop (forward-line 1))
823 (narrow-to-region (point) (point)))
824 ((member elem tokens)
825 ;; Tokens that don't have a following value are ignored,
827 (when (and pair (or (cdr pair)
828 (equal (car pair) "default")))
830 (setq pair (list elem)))
832 ;; Values that haven't got a preceding token are ignored.
836 (setq pair nil)))))))
840 (auth-source-search-collection
843 (aget alist "machine")
846 (auth-source-search-collection
850 (aget alist "account")
853 (auth-source-search-collection
857 (aget alist "protocol")
860 ;; the required list of keys is nil, or
862 ;; every element of require is in the normalized list
863 (let ((normalized (nth 0 (auth-source-netrc-normalize
865 (loop for req in require
866 always (plist-get normalized req)))))
868 (push (nreverse alist) result)
869 ;; to delete a line, we just comment it out
871 (goto-char (point-min))
880 (when auth-source-gpg-encrypt-to
881 ;; (see bug#7487) making `epa-file-encrypt-to' local to
882 ;; this buffer lets epa-file skip the key selection query
883 ;; (see the `local-variable-p' check in
884 ;; `epa-file-write-region').
885 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
886 (make-local-variable 'epa-file-encrypt-to))
887 (if (listp auth-source-gpg-encrypt-to)
888 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
890 ;; ask AFTER we've successfully opened the file
891 (when (y-or-n-p (format "Save file %s? (%d deletions)"
893 (write-region (point-min) (point-max) file nil 'silent)
894 (auth-source-do-debug
895 "auth-source-netrc-parse: modified %d lines in %s"
898 (nreverse result))))))
900 (defun auth-source-netrc-normalize (alist)
901 (mapcar (lambda (entry)
903 (while (setq item (pop entry))
908 (setq k (cond ((member k '("machine")) "host")
909 ((member k '("login" "account")) "user")
910 ((member k '("protocol")) "port")
911 ((member k '("password")) "secret")
914 ;; send back the secret in a function (lexical binding)
915 (when (equal k "secret")
916 (setq v (lexical-let ((v v))
919 (setq ret (plist-put ret
920 (intern (concat ":" k))
926 ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
929 (defun* auth-source-netrc-search (&rest
931 &key backend require create delete
932 type max host user port
934 "Given a property list SPEC, return search matches from the :backend.
935 See `auth-source-search' for details on SPEC."
936 ;; just in case, check that the type is correct (null or same as the backend)
937 (assert (or (null type) (eq type (oref backend type)))
938 t "Invalid netrc search: %s %s")
940 (let ((results (auth-source-netrc-normalize
941 (auth-source-netrc-parse
945 :file (oref backend source)
948 :port (or port t)))))
950 ;; if we need to create an entry AND none were found to match
954 ;; create based on the spec and record the value
956 ;; if the user did not want to create the entry
957 ;; in the file, it will be returned
958 (apply (slot-value backend 'create-function) spec)
959 ;; if not, we do the search again without :create
960 ;; to get the updated data.
962 ;; the result will be returned, even if the search fails
963 (apply 'auth-source-netrc-search
964 (plist-put spec :create nil)))))
967 (defun auth-source-netrc-element-or-first (v)
972 ;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
974 (defun auth-source-format-prompt (prompt alist)
975 "Format PROMPT using %x (for any character x) specifiers in ALIST."
977 (let ((c (nth 0 cell))
980 (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt)))))
983 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
984 ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
986 (defun* auth-source-netrc-create (&rest spec
988 secret host user port create
990 (let* ((base-required '(host user port secret))
991 ;; we know (because of an assertion in auth-source-search) that the
992 ;; :create parameter is either t or a list (which includes nil)
993 (create-extra (if (eq t create) nil create))
994 (required (append base-required create-extra))
995 (file (oref backend source))
997 ;; `valist' is an alist
999 ;; `artificial' will be returned if no creation is needed
1002 ;; only for base required elements (defined as function parameters):
1003 ;; fill in the valist with whatever data we may have from the search
1004 ;; we complete the first value if it's a list and use the value otherwise
1005 (dolist (br base-required)
1006 (when (symbol-value br)
1007 (let ((br-choice (cond
1008 ;; all-accepting choice (predicate is t)
1009 ((eq t (symbol-value br)) nil)
1010 ;; just the value otherwise
1011 (t (symbol-value br)))))
1013 (aput 'valist br br-choice)))))
1015 ;; for extra required elements, see if the spec includes a value for them
1016 (dolist (er create-extra)
1017 (let ((name (concat ":" (symbol-name er)))
1018 (keys (loop for i below (length spec) by 2
1019 collect (nth i spec))))
1021 (when (equal (symbol-name k) name)
1022 (aput 'valist er (plist-get spec k))))))
1024 ;; for each required element
1025 (dolist (r required)
1026 (let* ((data (aget valist r))
1027 ;; take the first element if the data is a list
1028 (data (auth-source-netrc-element-or-first data))
1029 ;; this is the default to be offered
1030 (given-default (aget auth-source-creation-defaults r))
1031 ;; the default supplementals are simple:
1032 ;; for the user, try `given-default' and then (user-login-name);
1033 ;; otherwise take `given-default'
1035 ((and (not given-default) (eq r 'user))
1038 (printable-defaults (list
1041 (auth-source-netrc-element-or-first
1042 (aget valist 'user))
1043 (plist-get artificial :user)
1047 (auth-source-netrc-element-or-first
1048 (aget valist 'host))
1049 (plist-get artificial :host)
1053 (auth-source-netrc-element-or-first
1054 (aget valist 'port))
1055 (plist-get artificial :port)
1057 (prompt (or (aget auth-source-creation-prompts r)
1059 (secret "%p password for %u@%h: ")
1060 (user "%p user name for %h: ")
1061 (host "%p host name for user %u: ")
1062 (port "%p port for %u@%h: "))
1063 (format "Enter %s (%%u@%%h:%%p): " r)))
1064 (prompt (auth-source-format-prompt
1066 `((?u ,(aget printable-defaults 'user))
1067 (?h ,(aget printable-defaults 'host))
1068 (?p ,(aget printable-defaults 'port))))))
1070 ;; store the data, prompting for the password if needed
1073 ((and (null data) (eq r 'secret))
1074 ;; special case prompt for passwords
1075 (read-passwd prompt))
1077 (read-string prompt default))
1078 (t (or data default))))
1081 (setq artificial (plist-put artificial
1082 (intern (concat ":" (symbol-name r)))
1084 (lexical-let ((data data))
1088 ;; when r is not an empty string...
1089 (when (and (stringp data)
1090 (< 0 (length data)))
1091 ;; this function is not strictly necessary but I think it
1092 ;; makes the code clearer -tzz
1093 (let ((printer (lambda ()
1094 ;; append the key (the symbol name of r)
1095 ;; and the value in r
1098 (if (zerop (length add)) "" " ")
1099 ;; remap auth-source tokens to netrc
1103 ('secret "password")
1104 ('port "port") ; redundant but clearer
1105 (t (symbol-name r)))
1106 ;; the value will be printed in %S format
1108 (setq add (concat add (funcall printer)))))))
1113 (lexical-let ((file file)
1115 (lambda () (auth-source-netrc-saver file add))))
1119 ;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch") :user "tzz" :port "imap" :create t :max 1)) :save-function))
1120 (defun auth-source-netrc-saver (file add)
1121 "Save a line ADD in FILE, prompting along the way.
1122 Respects `auth-source-save-behavior'."
1124 (when (file-exists-p file)
1125 (insert-file-contents file))
1126 (when auth-source-gpg-encrypt-to
1127 ;; (see bug#7487) making `epa-file-encrypt-to' local to
1128 ;; this buffer lets epa-file skip the key selection query
1129 ;; (see the `local-variable-p' check in
1130 ;; `epa-file-write-region').
1131 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
1132 (make-local-variable 'epa-file-encrypt-to))
1133 (if (listp auth-source-gpg-encrypt-to)
1134 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
1135 ;; we want the new data to be found first, so insert at beginning
1136 (goto-char (point-min))
1138 ;; ask AFTER we've successfully opened the file
1139 (let ((prompt (format "Save auth info to file %s? %s: "
1142 (done (not (eq auth-source-save-behavior 'ask)))
1143 (bufname "*auth-source Help*")
1146 (message "%s" prompt)
1147 (setq k (read-char))
1151 (with-output-to-temp-buffer bufname
1153 (concat "(y)es, save\n"
1154 "(n)o but use the info\n"
1155 "(N)o and don't ask to save again\n"
1157 "(?) for help as you can see.\n"))
1158 (set-buffer standard-output)
1164 auth-source-save-behavior nil))
1165 (?e (setq add (read-string "Line to add: " add)))
1168 (when (get-buffer-window bufname)
1169 (delete-window (get-buffer-window bufname)))
1171 ;; make sure the info is not saved
1172 (when (null auth-source-save-behavior)
1175 (when (< 0 (length add))
1180 (write-region (point-min) (point-max) file nil 'silent)
1181 (auth-source-do-debug
1182 "auth-source-netrc-create: wrote 1 new line to %s"
1184 (message "Saved new authentication information to %s" file)
1187 ;;; Backend specific parsing: Secrets API backend
1189 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
1190 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
1191 ;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
1192 ;;; (let ((auth-sources '(default))) (auth-source-search))
1193 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
1194 ;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
1196 (defun* auth-source-secrets-search (&rest
1198 &key backend create delete label
1199 type max host user port
1201 "Search the Secrets API; spec is like `auth-source'.
1203 The :label key specifies the item's label. It is the only key
1204 that can specify a substring. Any :label value besides a string
1205 will allow any label.
1207 All other search keys must match exactly. If you need substring
1208 matching, do a wider search and narrow it down yourself.
1210 You'll get back all the properties of the token as a plist.
1212 Here's an example that looks for the first item in the 'Login'
1215 \(let ((auth-sources '(\"secrets:Login\")))
1216 (auth-source-search :max 1)
1218 Here's another that looks for the first item in the 'Login'
1219 Secrets collection whose label contains 'gnus':
1221 \(let ((auth-sources '(\"secrets:Login\")))
1222 (auth-source-search :max 1 :label \"gnus\")
1224 And this one looks for the first item in the 'Login' Secrets
1225 collection that's a Google Chrome entry for the git.gnus.org site
1226 authentication tokens:
1228 \(let ((auth-sources '(\"secrets:Login\")))
1229 (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
1233 (assert (not create) nil
1234 "The Secrets API auth-source backend doesn't support creation yet")
1236 ;; (secrets-delete-item coll elt)
1237 (assert (not delete) nil
1238 "The Secrets API auth-source backend doesn't support deletion yet")
1240 (let* ((coll (oref backend source))
1241 (max (or max 5000)) ; sanity check: default to stop at 5K
1242 (ignored-keys '(:create :delete :max :backend :label))
1243 (search-keys (loop for i below (length spec) by 2
1244 unless (memq (nth i spec) ignored-keys)
1245 collect (nth i spec)))
1246 ;; build a search spec without the ignored keys
1247 ;; if a search key is nil or t (match anything), we skip it
1248 (search-spec (apply 'append (mapcar
1250 (if (or (null (plist-get spec k))
1251 (eq t (plist-get spec k)))
1253 (list k (plist-get spec k))))
1255 ;; needed keys (always including host, login, port, and secret)
1256 (returned-keys (mm-delete-duplicates (append
1257 '(:host :login :port :secret)
1259 (items (loop for item in (apply 'secrets-search-items coll search-spec)
1260 unless (and (stringp label)
1261 (not (string-match label item)))
1263 ;; TODO: respect max in `secrets-search-items', not after the fact
1264 (items (butlast items (- (length items) max)))
1265 ;; convert the item name to a full plist
1266 (items (mapcar (lambda (item)
1268 ;; make an entry for the secret (password) element
1271 (lexical-let ((v (secrets-get-secret coll item)))
1273 ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
1275 (mapcar (lambda (entry)
1276 (list (car entry) (cdr entry)))
1277 (secrets-get-attributes coll item)))))
1279 ;; ensure each item has each key in `returned-keys'
1280 (items (mapcar (lambda (plist)
1283 (mapcar (lambda (req)
1284 (if (plist-get plist req)
1292 (defun* auth-source-secrets-create (&rest
1294 &key backend type max host user port
1297 ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
1302 ;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
1304 ;; deprecate the old interface
1305 (make-obsolete 'auth-source-user-or-password
1306 'auth-source-search "Emacs 24.1")
1307 (make-obsolete 'auth-source-forget-user-or-password
1308 'auth-source-forget "Emacs 24.1")
1310 (defun auth-source-user-or-password
1311 (mode host port &optional username create-missing delete-existing)
1312 "Find MODE (string or list of strings) matching HOST and PORT.
1314 DEPRECATED in favor of `auth-source-search'!
1316 USERNAME is optional and will be used as \"login\" in a search
1317 across the Secret Service API (see secrets.el) if the resulting
1318 items don't have a username. This means that if you search for
1319 username \"joe\" and it matches an item but the item doesn't have
1320 a :user attribute, the username \"joe\" will be returned.
1322 A non nil DELETE-EXISTING means deleting any matching password
1323 entry in the respective sources. This is useful only when
1324 CREATE-MISSING is non nil as well; the intended use case is to
1325 remove wrong password entries.
1327 If no matching entry is found, and CREATE-MISSING is non nil,
1328 the password will be retrieved interactively, and it will be
1329 stored in the password database which matches best (see
1332 MODE can be \"login\" or \"password\"."
1333 (auth-source-do-debug
1334 "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
1335 mode host port username)
1337 (let* ((listy (listp mode))
1338 (mode (if listy mode (list mode)))
1340 (format "%s %s:%s %s" mode host port username)
1341 (format "%s %s:%s" mode host port)))
1342 (search (list :host host :port port))
1343 (search (if username (append search (list :user username)) search))
1344 (search (if create-missing
1345 (append search (list :create t))
1347 (search (if delete-existing
1348 (append search (list :delete t))
1350 ;; (found (if (not delete-existing)
1351 ;; (gethash cname auth-source-cache)
1352 ;; (remhash cname auth-source-cache)
1357 (auth-source-do-debug
1358 "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
1360 ;; don't show the password
1361 (if (and (member "password" mode) t)
1365 found) ; return the found data
1366 ;; else, if not found, search with a max of 1
1367 (let ((choice (nth 0 (apply 'auth-source-search
1368 (append '(:max 1) search)))))
1372 ((equal "password" m)
1373 (push (if (plist-get choice :secret)
1374 (funcall (plist-get choice :secret))
1377 (push (plist-get choice :user) found)))))
1378 (setq found (nreverse found))
1379 (setq found (if listy found (car-safe found)))))
1383 (provide 'auth-source)
1385 ;;; auth-source.el ends here