;;; 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 '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-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
"How many seconds passwords are cached, or nil to disable
expiring. Overrides `password-cache-expiry' through a
let-binding."
+ :version "24.1"
:group 'auth-source
:type '(choice (const :tag "Never" nil)
(const :tag "All Day" 86400)
(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
(repeat :tag "Names"
(string :tag "Name")))))
-;;; generate all the protocols in a format Customize can use
-;;; TODO: generate on the fly from auth-source-protocols
+;; Generate all the protocols in a format Customize can use.
+;; TODO: generate on the fly from auth-source-protocols
(defconst auth-source-protocols-customize
(mapcar (lambda (a)
(let ((p (car-safe a)))
(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)
+ 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))
- (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))
-;;; (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)
-;;; (auth-source-search :host "nonesuch" :type 'secrets)
+(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)
+;; (auth-source-search :host "nonesuch" :type 'secrets)
(defun* auth-source-delete (&rest spec
&key delete
(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-format-cache-entry (spec)
+ "Format SPEC entry to put it in the password cache."
+ (concat auth-source-magic (format "%S" spec)))
(defun auth-source-remember (spec found)
"Remember FOUND search results for SPEC."
(let ((password-cache-expiry auth-source-cache-expiry))
(password-cache-add
- (concat auth-source-magic (format "%S" spec)) found)))
+ (auth-source-format-cache-entry spec) found)))
(defun auth-source-recall (spec)
"Recall FOUND search results for SPEC."
- (password-read-from-cache
- (concat auth-source-magic (format "%S" spec))))
+ (password-read-from-cache (auth-source-format-cache-entry spec)))
+
+(defun auth-source-remembered-p (spec)
+ "Check if SPEC is remembered."
+ (password-in-cache-p
+ (auth-source-format-cache-entry spec)))
(defun auth-source-forget (spec)
"Forget any cached data matching SPEC exactly.
This is the same SPEC you passed to `auth-source-search'.
Returns t or nil for forgotten or not found."
- (password-cache-remove (concat auth-source-magic (format "%S" spec))))
+ (password-cache-remove (auth-source-format-cache-entry spec)))
-;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
+;; (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-remember '(:host "xedd") '(1 2 3))
-;;; (auth-source-recall '(:host "xedd"))
-;;; (auth-source-recall '(:host t))
-;;; (auth-source-forget+ :host t)
+;; (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-forget+ (&rest spec &allow-other-keys)
"Forget any cached data matching SPEC. Returns forgotten count.
(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))))
+;; (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))
+
;;; Backend specific parsing: netrc/authinfo backend
-;;; (auth-source-netrc-parse "~/.authinfo.gpg")
+(defun auth-source--aput-1 (alist key val)
+ (let ((seen ())
+ (rest alist))
+ (while (and (consp rest) (not (equal key (caar rest))))
+ (push (pop rest) seen))
+ (cons (cons key val)
+ (if (null rest) alist
+ (nconc (nreverse seen)
+ (if (equal key (caar rest)) (cdr rest) rest))))))
+(defmacro auth-source--aput (var key val)
+ `(setq ,var (auth-source--aput-1 ,var ,key ,val)))
+
+(defun auth-source--aget (alist key)
+ (cdr (assoc key alist)))
+
+;; (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."
;; We got already parsed contents; just return it.
file
(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)
- (insert-file-contents file)
+ (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)
+ (auth-source--aput
+ auth-source-netrc-cache file
+ (list :mtime (nth 5 (file-attributes file))
+ :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
+ (lambda () (apply 'string (mapcar '1- v)))))))
(goto-char (point-min))
;; Go through the file, line by line.
(while (and (not (eobp))
(auth-source-search-collection
host
(or
- (aget alist "machine")
- (aget alist "host")
+ (auth-source--aget alist "machine")
+ (auth-source--aget alist "host")
t))
(auth-source-search-collection
user
(or
- (aget alist "login")
- (aget alist "account")
- (aget alist "user")
+ (auth-source--aget alist "login")
+ (auth-source--aget alist "account")
+ (auth-source--aget alist "user")
t))
(auth-source-search-collection
port
(or
- (aget alist "port")
- (aget alist "protocol")
- t)))
+ (auth-source--aget alist "port")
+ (auth-source--aget alist "protocol")
+ 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))
-;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
-;;; (funcall secret)
+;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
+;; (funcall secret)
(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)
projects / gnus / blobdiff