;;; auth-source.el --- authentication sources for Gnus and Emacs
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
(require 'mm-util)
(require 'gnus-util)
(require 'assoc)
+
(eval-when-compile (require 'cl))
(eval-and-compile
(or (ignore-errors (require 'eieio))
;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
(ignore-errors
- (let ((load-path (cons (expand-file-name
- "gnus-fallback-lib/eieio"
- (file-name-directory (locate-library "gnus")))
- load-path)))
- (require 'eieio)))
+ (let ((load-path (cons (expand-file-name
+ "gnus-fallback-lib/eieio"
+ (file-name-directory (locate-library "gnus")))
+ load-path)))
+ (require 'eieio)))
(error
"eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
(autoload 'secrets-list-collections "secrets")
(autoload 'secrets-search-items "secrets")
+(autoload 'rfc2104-hash "rfc2104")
+
+(autoload 'plstore-open "plstore")
+(autoload 'plstore-find "plstore")
+(autoload 'plstore-put "plstore")
+(autoload 'plstore-delete "plstore")
+(autoload 'plstore-save "plstore")
+(autoload 'plstore-get-file "plstore")
+
+(autoload 'epg-make-context "epg")
+(autoload 'epg-context-set-passphrase-callback "epg")
+(autoload 'epg-decrypt-string "epg")
+(autoload 'epg-context-set-armor "epg")
+(autoload 'epg-encrypt-string "epg")
+
+(autoload 'help-mode "help-mode" nil t)
+
(defvar secrets-enabled)
(defgroup auth-source nil
(const :tag "30 Minutes" 1800)
(integer :tag "Seconds")))
+;;; The slots below correspond with the `auth-source-search' spec,
+;;; so a backend with :host set, for instance, would match only
+;;; searches for that host. Normally they are nil.
(defclass auth-source-backend ()
((type :initarg :type
:initform 'netrc
:type t
:custom string
:documentation "The backend protocol.")
+ (data :initarg :data
+ :initform nil
+ :documentation "Internal backend data.")
(create-function :initarg :create-function
:initform ignore
:type function
(defvar auth-source-creation-defaults nil
"Defaults for creating token values. Usually let-bound.")
+(defvar auth-source-creation-prompts nil
+ "Default prompts for token values. Usually let-bound.")
+
(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
+(defcustom auth-source-save-behavior 'ask
+ "If set, auth-source will respect it for save behavior."
+ :group 'auth-source
+ :version "23.2" ;; No Gnus
+ :type `(choice
+ :tag "auth-source new token save behavior"
+ (const :tag "Always save" t)
+ (const :tag "Never save" nil)
+ (const :tag "Ask" ask)))
+
+;; 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)))
+;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+
+(defcustom auth-source-netrc-use-gpg-tokens 'never
+ "Set this to tell auth-source when to create GPG password
+tokens in netrc files. It's either an alist or `never'.
+Note that if EPA/EPG is not available, this should NOT be used."
+ :group 'auth-source
+ :version "23.2" ;; No Gnus
+ :type `(choice
+ (const :tag "Always use GPG password tokens" (t gpg))
+ (const :tag "Never use GPG password tokens" never)
+ (repeat :tag "Use a lookup list"
+ (list
+ (choice :tag "Matcher"
+ (const :tag "Match anything" t)
+ (const :tag "The EPA encrypted file extensions"
+ ,(if (boundp 'epa-file-auto-mode-alist-entry)
+ (car (symbol-value
+ 'epa-file-auto-mode-alist-entry))
+ "\\.gpg\\'"))
+ (regexp :tag "Regular expression"))
+ (choice :tag "What to do"
+ (const :tag "Save GPG-encrypted password tokens" gpg)
+ (const :tag "Don't encrypt tokens" never))))))
+
(defvar auth-source-magic "auth-source-magic ")
(defcustom auth-source-do-cache t
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
-(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
+(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
"List of authentication sources.
The default will get login and password information from
,@auth-source-protocols-customize))
(list :tag "User" :inline t
(const :format "" :value :user)
- (choice :tag "Personality/Username"
- (const :tag "Any" t)
- (string :tag "Name")))))))))
+ (choice
+ :tag "Personality/Username"
+ (const :tag "Any" t)
+ (string
+ :tag "Name")))))))))
(defcustom auth-source-gpg-encrypt-to t
"List of recipient keys that `authinfo.gpg' encrypted to.
(defun auth-source-do-warn (&rest msg)
(apply
- ;; set logger to either the function in auth-source-debug or 'message
- ;; note that it will be 'message if auth-source-debug is nil
+ ;; set logger to either the function in auth-source-debug or 'message
+ ;; note that it will be 'message if auth-source-debug is nil
(if (functionp auth-source-debug)
auth-source-debug
'message)
msg))
+;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
+(defun auth-source-read-char-choice (prompt choices)
+ "Read one of CHOICES by `read-char-choice', or `read-char'.
+`dropdown-list' support is disabled because it doesn't work reliably.
+Only one of CHOICES will be returned. The PROMPT is augmented
+with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
+ (when choices
+ (let* ((prompt-choices
+ (apply 'concat (loop for c in choices
+ collect (format "%c/" c))))
+ (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
+ (full-prompt (concat prompt prompt-choices))
+ k)
+
+ (while (not (memq k choices))
+ (setq k (cond
+ ((fboundp 'read-char-choice)
+ (read-char-choice full-prompt choices))
+ (t (message "%s" full-prompt)
+ (setq k (read-char))))))
+ k)))
+
;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
;; (auth-source-pick t :host "any" :port 'imap :user "joe")
;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
;; a file name with parameters
((stringp (plist-get entry :source))
- (auth-source-backend
- (plist-get entry :source)
- :source (plist-get entry :source)
- :type 'netrc
- :search-function 'auth-source-netrc-search
- :create-function 'auth-source-netrc-create))
+ (if (equal (file-name-extension (plist-get entry :source)) "plist")
+ (auth-source-backend
+ (plist-get entry :source)
+ :source (plist-get entry :source)
+ :type 'plstore
+ :search-function 'auth-source-plstore-search
+ :create-function 'auth-source-plstore-create
+ :data (plstore-open (plist-get entry :source)))
+ (auth-source-backend
+ (plist-get entry :source)
+ :source (plist-get entry :source)
+ :type 'netrc
+ :search-function 'auth-source-netrc-search
+ :create-function 'auth-source-netrc-create)))
;; the Secrets API. We require the package, in order to have a
;; defined value for `secrets-enabled'.
(defun* auth-source-search (&rest spec
&key type max host user port secret
- create delete
+ require create delete
&allow-other-keys)
"Search or modify authentication backends according to SPEC.
token. The value for that parameter will be obtained from the
search parameters or from user input. If any queries are needed,
the alist `auth-source-creation-defaults' will be checked for the
-default prompt.
+default value. If the user, host, or port are missing, the alist
+`auth-source-creation-prompts' will be used to look up the
+prompts IN THAT ORDER (so the 'user prompt will be queried first,
+then 'host, then 'port, and finally 'secret). Each prompt string
+can use %u, %h, and %p to show the user, host, and port.
Here's an example:
\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
- (A . \"default A\"))))
+ (A . \"default A\")))
+ (auth-source-creation-prompts
+ '((password . \"Enter IMAP password for %h:%p: \"))))
(auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
:P \"pppp\" :Q \"qqqq\"
:create '(A B Q)))
Create a new entry if you found none. The netrc backend will
automatically require host, user, and port. The host will be
- 'nonesuch' and Q will be 'qqqq'. We prompt for A with default
- 'default A', for B and port with default nil, and for the
- user with default 'defaultUser'. We will not prompt for Q. The
- resulting token will have keys user, host, port, A, B, and Q.
- It will not have P with any value, even though P is used in the
- search to find only entries that have P set to 'pppp'.\"
+ 'nonesuch' and Q will be 'qqqq'. We prompt for the password
+ with the shown prompt. We will not prompt for Q. The resulting
+ token will have keys user, host, port, A, B, and Q. It will not
+ have P with any value, even though P is used in the search to
+ find only entries that have P set to 'pppp'.\"
When multiple values are specified in the search parameter, the
user is prompted for which one. So :host (X Y Z) would ask the
backends (netrc, at least) will prompt the user rather than throw
an error.
+:require (A B C) means that only results that contain those
+tokens will be returned. Thus for instance requiring :secret
+will ensure that any results will actually have a :secret
+property.
+
:delete t means to delete any found entries. nil by default.
Use `auth-source-delete' in ELisp code instead of calling
`auth-source-search' directly with this parameter.
keys provided by the backend (notably :secret). But note the
exception for :max 0, which see above.
+The token can hold a :save-function key. If you call that, the
+user will be prompted to save the data to the backend. You can't
+request that this should happen right after creation, because
+`auth-source-search' has no way of knowing if the token is
+actually useful. So the caller must arrange to call this function.
+
The token's :secret key can hold a function. In that case you
must call it to obtain the actual value."
(let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
(max (or max 1))
- (ignored-keys '(:create :delete :max))
+ (ignored-keys '(:require :create :delete :max))
(keys (loop for i below (length spec) by 2
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
+ (cached (auth-source-remembered-p spec))
+ ;; note that we may have cached results but found is still nil
+ ;; (there were no results from the search)
(found (auth-source-recall spec))
filtered-backends accessor-key backend)
- (if (and found auth-source-do-cache)
+ (if (and cached auth-source-do-cache)
(auth-source-do-debug
"auth-source-search: found %d CACHED results matching %S"
(length found) spec)
(or (eq t create) (listp create)) t
"Invalid auth-source :create parameter (must be t or a list): %s %s")
+ (assert
+ (listp require) t
+ "Invalid auth-source :require parameter (must be a list): %s")
+
(setq filtered-backends (copy-sequence backends))
(dolist (backend backends)
(dolist (key keys)
spec
;; to exit early
max
- ;; create and delete
- nil delete))
+ ;; create is always nil here
+ nil delete
+ require))
(auth-source-do-debug
"auth-source-search: found %d results (max %d) matching %S"
spec
;; to exit early
max
- ;; create and delete
- create delete))
projects / gnus / blobdiff