(require 'password-cache)
(require 'mm-util)
(require 'gnus-util)
-(require 'netrc)
(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-context-operation "epg")
+(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")
+
(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
:type `(choice
:tag "auth-source debugging mode"
(const :tag "Log using `message' to the *Messages* buffer" t)
+ (const :tag "Log all trivia with `message' to the *Messages* buffer"
+ trivia)
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
-(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
+(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
"List of authentication sources.
The default will get login and password information from
\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
packages to be encrypted. If that file doesn't exist, it will
-try the unencrypted version \"~/.authinfo\".
+try the unencrypted version \"~/.authinfo\" and the famous
+\"~/.netrc\" file.
See the auth.info manual for details.
,@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.
(when auth-source-debug
(apply 'auth-source-do-warn msg)))
+(defun auth-source-do-trivia (&rest msg)
+ (when (or (eq auth-source-debug 'trivia)
+ (functionp auth-source-debug))
+ (apply 'auth-source-do-warn msg)))
+
(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 found-here goal matches backend)
+ 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)
(assert
(or (eq t create) (listp create)) t
- "Invalid auth-source :create parameter (must be nil, t, or a list): %s %s")
+ "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)
(return))
(invalid-slot-name))))
- (auth-source-do-debug
+ (auth-source-do-trivia
"auth-source-search: found %d backends matching %S"
(length filtered-backends) spec)
;; (debug spec "filtered" filtered-backends)
- (setq goal max)
;; First go through all the backends without :create, so we can
;; query them all.
- (let ((uspec (copy-sequence spec)))
- (plist-put uspec :create nil)
- (dolist (backend filtered-backends)
- (let ((match (apply
- (slot-value backend 'search-function)
- :backend backend
- uspec)))
- (when match
- (push (list backend match) matches)))))
+ (setq found (auth-source-search-backends filtered-backends
+ spec
+ ;; to exit early
+ max
+ ;; create is always nil here
+ nil delete
+ require))
+
+ (auth-source-do-debug
+ "auth-source-search: found %d results (max %d) matching %S"
+ (length found) max spec)
+
;; If we didn't find anything, then we allow the backend(s) to
;; create the entries.
(when (and create
- (not matches))
- (dolist (backend filtered-backends)
- (unless matches
- (let ((match (apply
- (slot-value backend 'search-function)
- :backend backend
- :create create
- :delete delete
- spec)))
- (when match
- (push (list backend match) matches))))))
-
- (setq backend (caar matches)
- found-here (cadar matches))
-
- (block nil
- ;; if max is 0, as soon as we find something, return it
- (when (and (zerop max) (> 0 (length found-here)))
- (return t))
-
- ;; decrement the goal by the number of new results
- (decf goal (length found-here))
- ;; and append the new results to the full list
- (setq found (append found found-here))
-
- (auth-source-do-debug
- "auth-source-search: found %d results (max %d/%d) in %S matching %S"
- (length found-here) max goal backend spec)
-
- ;; return full list if the goal is 0 or negative
- (when (zerop (max 0 goal))
- (return found))
-
- ;; change the :max parameter in the spec to the goal
- (setq spec (plist-put spec :max goal))
-
- (when (and found auth-source-do-cache)
- (auth-source-remember spec found))))
+ (not found))
+ (setq found (auth-source-search-backends filtered-backends
+ spec
+ ;; to exit early
+ max
+ create delete
+ require))
+ (auth-source-do-debug
+ "auth-source-search: CREATED %d results (max %d) matching %S"
+ (length found) max spec))
+
+ ;; note we remember the lack of result too, if it's applicable
+ (when auth-source-do-cache
+ (auth-source-remember spec found)))
found))
+(defun auth-source-search-backends (backends spec max create delete require)
+ (let (matches)
+ (dolist (backend backends)
+ (when (> max (length matches)) ; when we need more matches...
+ (let* ((bmatches (apply
+ (slot-value backend 'search-function)
+ :backend backend
+ ;; note we're overriding whatever the spec
+ ;; has for :require, :create, and :delete
+ :require require
+ :create create
+ :delete delete
+ spec)))
+ (when bmatches
+ (auth-source-do-trivia
+ "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
+ (length bmatches) max
+ (slot-value backend :type)
+ (slot-value backend :source)
+ spec)
+ (setq matches (append matches bmatches))))))
+ matches))
+
;;; (auth-source-search :max 1)
;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
(equal collection value)
(member value collection)))
+(defvar auth-source-netrc-cache nil)
+
(defun auth-source-forget-all-cached ()
"Forget all cached auth-source data."
(interactive)
when (string-match (concat "^" auth-source-magic)
(symbol-name sym))
;; remove that key
- do (password-cache-remove (symbol-name sym))))
+ do (password-cache-remove (symbol-name sym)))
+ (setq auth-source-netrc-cache nil))
(defun auth-source-remember (spec found)
"Remember FOUND search results for SPEC."
(password-read-from-cache
(concat auth-source-magic (format "%S" spec))))
+(defun auth-source-remembered-p (spec)
+ "Check if SPEC is remembered."
+ (password-in-cache-p
+ (concat auth-source-magic (format "%S" spec))))
+
(defun auth-source-forget (spec)
"Forget any cached data matching SPEC exactly.
;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
;;; (auth-source-remember '(:host "wedd") '(4 5 6))
+;;; (auth-source-remembered-p '(:host "wedd"))
;;; (auth-source-remember '(:host "xedd") '(1 2 3))
+;;; (auth-source-remembered-p '(:host "xedd"))
+;;; (auth-source-remembered-p '(:host "zedd"))
;;; (auth-source-recall '(:host "xedd"))
;;; (auth-source-recall '(:host t))
;;; (auth-source-forget+ :host t)
(defun auth-source-specmatchp (spec stored)
(let ((keys (loop for i below (length spec) by 2
- collect (nth i spec))))
+ collect (nth i spec))))
(not (eq
(dolist (key keys)
(unless (auth-source-search-collection (plist-get stored key)
(return 'no)))
'no))))
-;;; Backend specific parsing: netrc/authinfo backend
+;;; (auth-source-pick-first-password :host "z.lifelogs.com")
+;;; (auth-source-pick-first-password :port "imap")
+(defun auth-source-pick-first-password (&rest spec)
+ "Pick the first secret found from applying SPEC to `auth-source-search'."
+ (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
+ (secret (plist-get result :secret)))
+
+ (if (functionp secret)
+ (funcall secret)
+ secret)))
+
+;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
+(defun auth-source-format-prompt (prompt alist)
+ "Format PROMPT using %x (for any character x) specifiers in ALIST."
+ (dolist (cell alist)
+ (let ((c (nth 0 cell))
+ (v (nth 1 cell)))
+ (when (and c v)
+ (setq prompt (replace-regexp-in-string (format "%%%c" c)
+ (format "%s" v)
+ prompt)))))
+ prompt)
(defun auth-source-ensure-strings (values)
(unless (listp values)
(setq values (list values)))
(mapcar (lambda (value)
- (if (numberp value)
- (format "%s" value)
- value))
- values))
+ (if (numberp value)
+ (format "%s" value)
+ value))
+ values))
-(defvar auth-source-netrc-cache nil)
+;;; Backend specific parsing: netrc/authinfo backend
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
spec
- &key file max host user port delete
+ &key file max host user port delete require
&allow-other-keys)
"Parse FILE and return a list of all entries in the file.
Note that the MAX parameter is used so we can exit the parse early."
(when (file-exists-p file)
(setq port (auth-source-ensure-strings port))
(with-temp-buffer
- (let ((tokens '("machine" "host" "default" "login" "user"
- "password" "account" "macdef" "force"
- "port" "protocol"))
- (max (or max 5000)) ; sanity check: default to stop at 5K
- (modified 0)
- alist elem result pair)
- (if (and auth-source-netrc-cache
- (equal (car auth-source-netrc-cache)
- (nth 5 (file-attributes file))))
- (insert (base64-decode-string
- (rot13-string (cdr auth-source-netrc-cache))))
- (insert-file-contents file)
- (when (string-match "\\.gpg\\'" file)
- ;; Store the contents of the file heavily encrypted in memory.
- (setq auth-source-netrc-cache
- (cons (nth 5 (file-attributes file))
- (rot13-string
- (base64-encode-string
- (buffer-string)))))))
+ (let* ((tokens '("machine" "host" "default" "login" "user"
+ "password" "account" "macdef" "force"
+ "port" "protocol"))
+ (max (or max 5000)) ; sanity check: default to stop at 5K
+ (modified 0)
+ (cached (cdr-safe (assoc file auth-source-netrc-cache)))
+ (cached-mtime (plist-get cached :mtime))
+ (cached-secrets (plist-get cached :secret))
+ alist elem result pair)
+
+ (if (and (functionp cached-secrets)
+ (equal cached-mtime
+ (nth 5 (file-attributes file))))
+ (progn
+ (auth-source-do-trivia
+ "auth-source-netrc-parse: using CACHED file data for %s"
+ file)
+ (insert (funcall cached-secrets)))
+ (insert-file-contents file)
+ ;; cache all netrc files (used to be just .gpg files)
+ ;; Store the contents of the file heavily encrypted in memory.
+ ;; (note for the irony-impaired: they are just obfuscated)
+ (aput 'auth-source-netrc-cache file
+ (list :mtime (nth 5 (file-attributes file))
+ :secret (lexical-let ((v (rot13-string
+ (base64-encode-string
+ (buffer-string)))))
+ (lambda () (base64-decode-string
+ (rot13-string v)))))))
(goto-char (point-min))
;; Go through the file, line by line.
(while (and (not (eobp))
(or
(aget alist "port")
(aget alist "protocol")
- t)))
+ t))
+ (or
+ ;; the required list of keys is nil, or
+ (null require)
+ ;; every element of require is in the normalized list
+ (let ((normalized (nth 0 (auth-source-netrc-normalize
+ (list alist) file))))
+ (loop for req in require
+ always (plist-get normalized req)))))
(decf max)
(push (nreverse alist) result)
;; to delete a line, we just comment it out
(setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
;; ask AFTER we've successfully opened the file
- (when (y-or-n-p (format "Save file %s? (%d modifications)"
+ (when (y-or-n-p (format "Save file %s? (%d deletions)"
file modified))
(write-region (point-min) (point-max) file nil 'silent)
(auth-source-do-debug
(nreverse result))))))
-(defun auth-source-netrc-normalize (alist)
+(defvar auth-source-passphrase-alist nil)
+
+(defun auth-source-token-passphrase-callback-function (context key-id file)
+ (let* ((file (file-truename file))
+ (entry (assoc file auth-source-passphrase-alist))
+ passphrase)
+ ;; return the saved passphrase, calling a function if needed
+ (or (copy-sequence (if (functionp (cdr entry))
+ (funcall (cdr entry))
+ (cdr entry)))
+ (progn
+ (unless entry
+ (setq entry (list file))
+ (push entry auth-source-passphrase-alist))
+ (setq passphrase
+ (read-passwd
+ (format "Passphrase for %s tokens: " file)
+ t))
+ (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
+ (lambda () p)))
+ passphrase))))
+
+;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc")
+(defun auth-source-epa-extract-gpg-token (secret file)
+ "Pass either the decoded SECRET or the gpg:BASE64DATA version.
+FILE is the file from which we obtained this token."
+ (when (string-match "^gpg:\\(.+\\)" secret)
+ (setq secret (base64-decode-string (match-string 1 secret))))
+ (let ((context (epg-make-context 'OpenPGP))
+ plain)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'auth-source-token-passphrase-callback-function
+ file))
+ (epg-decrypt-string context secret)))
+
+;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc"))
+(defun auth-source-epa-make-gpg-token (secret file)
+ (let ((context (epg-make-context 'OpenPGP))
+ (pp-escape-newlines nil)
+ cipher)
+ (epg-context-set-armor context t)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'auth-source-token-passphrase-callback-function
+ file))
+ (setq cipher (epg-encrypt-string context secret nil))
+ (with-temp-buffer
+ (insert cipher)
+ (base64-encode-region (point-min) (point-max) t)
+ (concat "gpg:" (buffer-substring-no-properties
+ (point-min)
+ (point-max))))))
+
+(defun auth-source-netrc-normalize (alist filename)
(mapcar (lambda (entry)
(let (ret item)
(while (setq item (pop entry))
;; send back the secret in a function (lexical binding)
(when (equal k "secret")
- (setq v (lexical-let ((v v))
- (lambda () v))))
-
+ (setq v (lexical-let ((lexv v)
+ (token-decoder nil))
+ (when (string-match "^gpg:" lexv)
+ ;; it's a GPG token: create a token decoder
+ ;; which unsets itself once
+ (setq token-decoder
+ (lambda (val)
+ (prog1
+ (auth-source-epa-extract-gpg-token
+ val
+ filename)
+ (setq token-decoder nil)))))
+ (lambda ()
+ (when token-decoder
+ (setq lexv (funcall token-decoder lexv)))
+ lexv))))
(setq ret (plist-put ret
(intern (concat ":" k))
- v))
- ))
+ v))))
ret))
alist))
(defun* auth-source-netrc-search (&rest
spec
- &key backend create delete
+ &key backend require create delete
type max host user port
&allow-other-keys)
-"Given a property list SPEC, return search matches from the :backend.
+ "Given a property list SPEC, return search matches from the :backend.
See `auth-source-search' for details on SPEC."
;; just in case, check that the type is correct (null or same as the backend)
(assert (or (null type) (eq type (oref backend type)))
(let ((results (auth-source-netrc-normalize
(auth-source-netrc-parse
:max max
+ :require require
:delete delete
:file (oref backend source)
:host (or host t)
:user (or user t)
- :port (or port t)))))
+ :port (or port t))
+ (oref backend source))))
;; if we need to create an entry AND none were found to match
(when (and create
- (= 0 (length results)))
+ (not results))
;; create based on the spec and record the value
(setq results (or
(plist-put spec :create nil)))))
results))
+(defun auth-source-netrc-element-or-first (v)
+ (if (listp v)
+ (nth 0 v)
+ v))
+
;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
;; we know (because of an assertion in auth-source-search) that the
;; :create parameter is either t or a list (which includes nil)
(create-extra (if (eq t create) nil create))
+ (current-data (car (auth-source-search :max 1
+ :host host
+ :port port)))
(required (append base-required create-extra))
(file (oref backend source))
(add "")
- (show "")
;; `valist' is an alist
valist
;; `artificial' will be returned if no creation is needed
;; for each required element
(dolist (r required)
(let* ((data (aget valist r))
+ ;; take the first element if the data is a list
+ (data (or (auth-source-netrc-element-or-first data)
+ (plist-get current-data
+ (intern (format ":%s" r) obarray))))
+ ;; this is the default to be offered
(given-default (aget auth-source-creation-defaults r))
- ;; the defaults are simple
+ ;; the default supplementals are simple:
+ ;; for the user, try `given-default' and then (user-login-name);
+ ;; otherwise take `given-default'
(default (cond
((and (not given-default) (eq r 'user))
(user-login-name))
- ;; note we need this empty string
- ((and (not given-default) (eq r 'port))
- "")
(t given-default)))
- ;; the prompt's default string depends on the data so far
- (default-string (if (and default (< 0 (length default)))
- (format " (default %s)" default)
- " (no default)"))
- ;; the prompt should also show what's entered so far
- (user-value (aget valist 'user))
- (host-value (aget valist 'host))
- (port-value (aget valist 'port))
- ;; note this handles lists by just printing them
- ;; later we allow the user to use completing-read to pick
- (info-so-far (concat (if user-value
- (format "%s@" user-value)
- "[USER?]")
- (if host-value
- (format "%s" host-value)
- "[HOST?]")
- (if port-value
- ;; this distinguishes protocol between
- (if (zerop (length port-value))
- "" ; 'entered as "no default"' vs.
- (format ":%s" port-value)) ; given
- ;; and this is when the protocol is unknown
- "[PORT?]"))))
-
- ;; now prompt if the search SPEC did not include a required key;
- ;; take the result and put it in `data' AND store it in `valist'
- (aput 'valist r
- (setq data
- (cond
- ((and (null data) (eq r 'secret))
- ;; special case prompt for passwords
- (read-passwd (format "Password for %s: " info-so-far)))
- ((null data)
- (read-string
- (format "Enter %s for %s%s: "
- r info-so-far default-string)
- nil nil default))
- ((listp data)
- (completing-read
- (format "Enter %s for %s (TAB to see the choices): "
- r info-so-far)
- data
- nil ; no predicate
- t ; require a match
- ;; note the default is nil, but if the user
- ;; hits RET we'll get "", which is handled OK later
- nil))
- (t data))))
+ (printable-defaults (list
+ (cons 'user
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'user))
+ (plist-get artificial :user)
+ "[any user]"))
+ (cons 'host
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'host))
+ (plist-get artificial :host)
+ "[any host]"))
+ (cons 'port
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'port))
+ (plist-get artificial :port)
+ "[any port]"))))
+ (prompt (or (aget auth-source-creation-prompts r)
+ (case r
+ (secret "%p password for %u@%h: ")
+ (user "%p user name for %h: ")
+ (host "%p host name for user %u: ")
+ (port "%p port for %u@%h: "))
+ (format "Enter %s (%%u@%%h:%%p): " r)))
+ (prompt (auth-source-format-prompt
+ prompt
+ `((?u ,(aget printable-defaults 'user))
+ (?h ,(aget printable-defaults 'host))
+ (?p ,(aget printable-defaults 'port))))))
+
+ ;; Store the data, prompting for the password if needed.
+ (setq data
+ (cond
+ ((and (null data) (eq r 'secret))
+ ;; Special case prompt for passwords.
+ ;; 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)))
+ ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+ (let* ((ep (format "Use GPG password tokens in %s?" file))
+ (gpg-encrypt
+ (cond
+ ((eq auth-source-netrc-use-gpg-tokens 'never)
+ 'never)
+ ((listp auth-source-netrc-use-gpg-tokens)
+ (let ((check (copy-sequence
+ auth-source-netrc-use-gpg-tokens))
+ item ret)
+ (while check
+ (setq item (pop check))
+ (when (or (eq (car item) t)
+ (string-match (car item) file))
+ (setq ret (cdr item))
+ (setq check nil)))))
+ (t 'never)))
+ (plain (read-passwd prompt)))
+ ;; ask if we don't know what to do (in which case
+ ;; auth-source-netrc-use-gpg-tokens must be a list)
+ (unless gpg-encrypt
+ (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never))
+ ;; TODO: save the defcustom now? or ask?
+ (setq auth-source-netrc-use-gpg-tokens
+ (cons `(,file ,gpg-encrypt)
+ auth-source-netrc-use-gpg-tokens)))
+ (if (eq gpg-encrypt 'gpg)
+ (auth-source-epa-make-gpg-token plain file)
+ plain)))
+ ((null data)
+ (when default
+ (setq prompt
+ (if (string-match ": *\\'" prompt)
+ (concat (substring prompt 0 (match-beginning 0))
+ " (default " default "): ")
+ (concat prompt "(default " default ") "))))
+ (read-string prompt nil nil default))
+ (t (or data default))))
(when data
(setq artificial (plist-put artificial
(lambda () data))
data))))
- ;; when r is not an empty string...
+ ;; When r is not an empty string...
(when (and (stringp data)
(< 0 (length data)))
- (let ((printer (lambda (hide)
+ ;; this function is not strictly necessary but I think it
+ ;; makes the code clearer -tzz
+ (let ((printer (lambda ()
;; append the key (the symbol name of r)
;; and the value in r
- (format "%s%s %S"
+ (format "%s%s %s"
;; prepend a space
(if (zerop (length add)) "" " ")
;; remap auth-source tokens to netrc
(case r
- ('user "login")
- ('host "machine")
- ('secret "password")
- ('port "port") ; redundant but clearer
+ (user "login")
+ (host "machine")
+ (secret "password")
+ (port "port") ; redundant but clearer
(t (symbol-name r)))
- ;; the value will be printed in %S format
- (if (and hide (eq r 'secret))
- "HIDDEN_SECRET"
+ (if (string-match "[\" ]" data)
+ (format "%S" data)
data)))))
- (setq add (concat add (funcall printer nil)))
- (setq show (concat show (funcall printer t)))))))
-
- (with-temp-buffer
- (when (file-exists-p file)
- (insert-file-contents file))
- (when auth-source-gpg-encrypt-to
- ;; (see bug#7487) making `epa-file-encrypt-to' local to
- ;; this buffer lets epa-file skip the key selection query
- ;; (see the `local-variable-p' check in
- ;; `epa-file-write-region').
- (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
- (make-local-variable 'epa-file-encrypt-to))
- (if (listp auth-source-gpg-encrypt-to)
- (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
- (goto-char (point-max))
-
- ;; ask AFTER we've successfully opened the file
- (if (y-or-n-p (format "Add to file %s: line [%s]" file show))
- (progn
- (unless (bolp)
- (insert "\n"))
- (insert add "\n")
- (write-region (point-min) (point-max) file nil 'silent)
- (auth-source-do-debug
- "auth-source-netrc-create: wrote 1 new line to %s"
- file)
- nil)
- (list artificial)))))
+ (setq add (concat add (funcall printer)))))))
+
+ (plist-put
+ artificial
+ :save-function
+ (lexical-let ((file file)
+ (add add))
+ (lambda () (auth-source-netrc-saver file add))))
+
+ (list artificial)))
+
+;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch2") :user "tzz" :port "imap" :create t :max 1)) :save-function))
+(defun auth-source-netrc-saver (file add)
+ "Save a line ADD in FILE, prompting along the way.
+Respects `auth-source-save-behavior'. Uses
+`auth-source-netrc-cache' to avoid prompting more than once."
+ (let* ((key (format "%s %s" file (rfc2104-hash 'md5 64 16 file add)))
+ (cached (assoc key auth-source-netrc-cache)))
+
+ (if cached
+ (auth-source-do-trivia
+ "auth-source-netrc-saver: found previous run for key %s, returning"
+ key)
+ (with-temp-buffer
+ (when (file-exists-p file)
+ (insert-file-contents file))
+ (when auth-source-gpg-encrypt-to
+ ;; (see bug#7487) making `epa-file-encrypt-to' local to
+ ;; this buffer lets epa-file skip the key selection query
+ ;; (see the `local-variable-p' check in
+ ;; `epa-file-write-region').
+ (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
+ (make-local-variable 'epa-file-encrypt-to))
+ (if (listp auth-source-gpg-encrypt-to)
+ (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
+ ;; we want the new data to be found first, so insert at beginning
+ (goto-char (point-min))
+
+ ;; Ask AFTER we've successfully opened the file.
+ (let ((prompt (format "Save auth info to file %s? " file))
+ (done (not (eq auth-source-save-behavior 'ask)))
+ (bufname "*auth-source Help*")
+ k)
+ (while (not done)
+ (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
+ (case k
+ (?y (setq done t))
+ (?? (save-excursion
+ (with-output-to-temp-buffer bufname
+ (princ
+ (concat "(y)es, save\n"
+ "(n)o but use the info\n"
+ "(N)o and don't ask to save again\n"
+ "(e)dit the line\n"
+ "(?) for help as you can see.\n"))
+ ;; Why? Doesn't with-output-to-temp-buffer already do
+ ;; the exact same thing anyway? --Stef
+ (set-buffer standard-output)
+ (help-mode))))
+ (?n (setq add ""
+ done t))
+ (?N
+ (setq add ""
+ done t)
+ (customize-save-variable 'auth-source-save-behavior nil))
+ (?e (setq add (read-string "Line to add: " add)))
+ (t nil)))
+
+ (when (get-buffer-window bufname)
+ (delete-window (get-buffer-window bufname)))
+
+ ;; Make sure the info is not saved.
+ (when (null auth-source-save-behavior)
+ (setq add ""))
+
+ (when (< 0 (length add))
+ (progn
+ (unless (bolp)
+ (insert "\n"))
+ (insert add "\n")
+ (write-region (point-min) (point-max) file nil 'silent)
+ (auth-source-do-debug
+ "auth-source-netrc-create: wrote 1 new line to %s"
+ file)
+ (message "Saved new authentication information to %s" file)
+ nil))))
+ (aput 'auth-source-netrc-cache key "ran"))))
;;; Backend specific parsing: Secrets API backend
(eq t (plist-get spec k)))
nil
(list k (plist-get spec k))))
- search-keys)))
+ search-keys)))
;; needed keys (always including host, login, port, and secret)
(returned-keys (mm-delete-duplicates (append
- '(:host :login :port :secret)
- search-keys)))
+ '(:host :login :port :secret)
+ search-keys)))
(items (loop for item in (apply 'secrets-search-items coll search-spec)
unless (and (stringp label)
(not (string-match label item)))
;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
(debug spec))
+;;; Backend specific parsing: PLSTORE backend
+
+(defun* auth-source-plstore-search (&rest
+ spec
+ &key backend create delete label
+ type max host user port
+ &allow-other-keys)
+ "Search the PLSTORE; spec is like `auth-source'."
+ (let* ((store (oref backend data))
+ (max (or max 5000)) ; sanity check: default to stop at 5K
+ (ignored-keys '(:create :delete :max :backend :require))
+ (search-keys (loop for i below (length spec) by 2
+ unless (memq (nth i spec) ignored-keys)
+ collect (nth i spec)))
+ ;; build a search spec without the ignored keys
+ ;; if a search key is nil or t (match anything), we skip it
+ (search-spec (apply 'append (mapcar
+ (lambda (k)
+ (let ((v (plist-get spec k)))
+ (if (or (null v)
+ (eq t v))
+ nil
+ (if (stringp v)
+ (setq v (list v)))
+ (list k v))))
+ search-keys)))
+ ;; needed keys (always including host, login, port, and secret)
+ (returned-keys (mm-delete-duplicates (append
+ '(:host :login :port :secret)
+ search-keys)))
+ (items (plstore-find store search-spec))
+ (item-names (mapcar #'car items))
+ (items (butlast items (- (length items) max)))
+ ;; convert the item to a full plist
+ (items (mapcar (lambda (item)
+ (let* ((plist (copy-tree (cdr item)))
+ (secret (plist-member plist :secret)))
+ (if secret
+ (setcar
+ (cdr secret)
+ (lexical-let ((v (car (cdr secret))))
+ (lambda () v))))
+ plist))
+ items))
+ ;; ensure each item has each key in `returned-keys'
+ (items (mapcar (lambda (plist)
+ (append
+ (apply 'append
+ (mapcar (lambda (req)
+ (if (plist-get plist req)
+ nil
+ (list req nil)))
+ returned-keys))
+ plist))
+ items)))
+ (cond
+ ;; if we need to create an entry AND none were found to match
+ ((and create
+ (not items))
+
+ ;; create based on the spec and record the value
+ (setq items (or
+ ;; if the user did not want to create the entry
+ ;; in the file, it will be returned
+ (apply (slot-value backend 'create-function) spec)
+ ;; if not, we do the search again without :create
+ ;; to get the updated data.
+
+ ;; the result will be returned, even if the search fails
+ (apply 'auth-source-plstore-search
+ (plist-put spec :create nil)))))
+ ((and delete
+ item-names)
+ (dolist (item-name item-names)
+ (plstore-delete store item-name))
+ (plstore-save store)))
+ items))
+
+(defun* auth-source-plstore-create (&rest spec
+ &key backend
+ secret host user port create
+ &allow-other-keys)
+ (let* ((base-required '(host user port secret))
+ (base-secret '(secret))
+ ;; we know (because of an assertion in auth-source-search) that the
+ ;; :create parameter is either t or a list (which includes nil)
+ (create-extra (if (eq t create) nil create))
+ (current-data (car (auth-source-search :max 1
+ :host host
+ :port port)))
+ (required (append base-required create-extra))
+ (file (oref backend source))
+ (add "")
+ ;; `valist' is an alist
+ valist
+ ;; `artificial' will be returned if no creation is needed
+ artificial
+ secret-artificial)
+
+ ;; only for base required elements (defined as function parameters):
+ ;; fill in the valist with whatever data we may have from the search
+ ;; we complete the first value if it's a list and use the value otherwise
+ (dolist (br base-required)
+ (when (symbol-value br)
+ (let ((br-choice (cond
+ ;; all-accepting choice (predicate is t)
+ ((eq t (symbol-value br)) nil)
+ ;; just the value otherwise
+ (t (symbol-value br)))))
+ (when br-choice
+ (aput 'valist br br-choice)))))
+
+ ;; for extra required elements, see if the spec includes a value for them
+ (dolist (er create-extra)
+ (let ((name (concat ":" (symbol-name er)))
+ (keys (loop for i below (length spec) by 2
+ collect (nth i spec))))
+ (dolist (k keys)
+ (when (equal (symbol-name k) name)
+ (aput 'valist er (plist-get spec k))))))
+
+ ;; for each required element
+ (dolist (r required)
+ (let* ((data (aget valist r))
+ ;; take the first element if the data is a list
+ (data (or (auth-source-netrc-element-or-first data)
+ (plist-get current-data
+ (intern (format ":%s" r) obarray))))
+ ;; this is the default to be offered
+ (given-default (aget auth-source-creation-defaults r))
+ ;; the default supplementals are simple:
+ ;; for the user, try `given-default' and then (user-login-name);
+ ;; otherwise take `given-default'
+ (default (cond
+ ((and (not given-default) (eq r 'user))
+ (user-login-name))
+ (t given-default)))
+ (printable-defaults (list
+ (cons 'user
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'user))
+ (plist-get artificial :user)
+ "[any user]"))
+ (cons 'host
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'host))
+ (plist-get artificial :host)
+ "[any host]"))
+ (cons 'port
+ (or
+ (auth-source-netrc-element-or-first
+ (aget valist 'port))
+ (plist-get artificial :port)
+ "[any port]"))))
+ (prompt (or (aget auth-source-creation-prompts r)
+ (case r
+ (secret "%p password for %u@%h: ")
+ (user "%p user name for %h: ")
+ (host "%p host name for user %u: ")
+ (port "%p port for %u@%h: "))
+ (format "Enter %s (%%u@%%h:%%p): " r)))
+ (prompt (auth-source-format-prompt
+ prompt
+ `((?u ,(aget printable-defaults 'user))
+ (?h ,(aget printable-defaults 'host))
+ (?p ,(aget printable-defaults 'port))))))
+
+ ;; Store the data, prompting for the password if needed.
+ (setq data
+ (cond
+ ((and (null data) (eq r 'secret))
+ ;; Special case prompt for passwords.
+ (read-passwd prompt))
+ ((null data)
+ (when default
+ (setq prompt
+ (if (string-match ": *\\'" prompt)
+ (concat (substring prompt 0 (match-beginning 0))
+ " (default " default "): ")
+ (concat prompt "(default " default ") "))))
+ (read-string prompt nil nil default))
+ (t (or data default))))
+
+ (when data
+ (if (member r base-secret)
+ (setq secret-artificial
+ (plist-put secret-artificial
+ (intern (concat ":" (symbol-name r)))
+ data))
+ (setq artificial (plist-put artificial
+ (intern (concat ":" (symbol-name r)))
+ data))))))
+ (plstore-put (oref backend data)
+ (sha1 (format "%s@%s:%s"
+ (plist-get artificial :user)
+ (plist-get artificial :host)
+ (plist-get artificial :port)))
+ artificial secret-artificial)
+ (if (y-or-n-p (format "Save auth info to file %s? "
+ (plstore-get-file (oref backend data))))
+ (plstore-save (oref backend data)))))
+
;;; older API
;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
(cond
((equal "password" m)
(push (if (plist-get choice :secret)
- (funcall (plist-get choice :secret))
- nil) found))
+ (funcall (plist-get choice :secret))
+ nil) found))
((equal "login" m)
(push (plist-get choice :user) found)))))
(setq found (nreverse found))
(setq found (if listy found (car-safe found)))))
- found))
+ found))
(provide 'auth-source)
projects / gnus / blobdiff