(autoload 'secrets-list-collections "secrets")
(autoload 'secrets-search-items "secrets")
+(autoload 'rfc2104-hash "rfc2104")
+
(defvar secrets-enabled)
(defgroup auth-source nil
(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'."
+ :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"
+ (choice
+ :tag "Personality/Username"
(const :tag "Any" t)
- (string :tag "Name")))))))))
+ (string
+ :tag "Name")))))))))
(defcustom auth-source-gpg-encrypt-to t
"List of recipient keys that `authinfo.gpg' encrypted to.
(let ((c (nth 0 cell))
(v (nth 1 cell)))
(when (and c v)
- (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt)))))
+ (setq prompt (replace-regexp-in-string (format "%%%c" c)
+ (format "%s" v)
+ prompt)))))
prompt)
(defun auth-source-ensure-strings (values)
(null require)
;; every element of require is in the normalized list
(let ((normalized (nth 0 (auth-source-netrc-normalize
- (list alist)))))
+ (list alist) file))))
(loop for req in require
always (plist-get normalized req)))))
(decf max)
(nreverse result))))))
-(defun auth-source-netrc-normalize (alist)
+(defmacro with-auth-source-epa-overrides (&rest body)
+ `(let ((file-name-handler-alist
+ ',(if (boundp 'epa-file-handler)
+ (remove (symbol-value 'epa-file-handler)
+ file-name-handler-alist)
+ file-name-handler-alist))
+ (,(if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)
+ ',(remove
+ 'epa-file-find-file-hook
+ (if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)))
+ (auto-mode-alist
+ ',(if (boundp 'epa-file-auto-mode-alist-entry)
+ (remove (symbol-value 'epa-file-auto-mode-alist-entry)
+ auto-mode-alist)
+ auto-mode-alist)))
+ ,@body))
+
+(defun auth-source-epa-make-gpg-token (secret file)
+ (require 'epa nil t)
+ (unless (featurep 'epa)
+ (error "EPA could not be loaded."))
+ (let* ((base (file-name-sans-extension file))
+ (passkey (format "gpg:-%s" base))
+ (stash (concat base ".gpg"))
+ ;; temporarily disable EPA
+ (stashfile
+ (with-auth-source-epa-overrides
+ (make-temp-file "gpg-token" nil
+ stash)))
+ (epa-file-passphrase-alist
+ `((,stashfile
+ . ,(password-read
+ (format
+ "token pass for %s? "
+ file)
+ passkey)))))
+ (write-region secret nil stashfile)
+ ;; temporarily disable EPA
+ (unwind-protect
+ (with-auth-source-epa-overrides
+ (with-temp-buffer
+ (insert-file-contents stashfile)
+ (base64-encode-region (point-min) (point-max) t)
+ (concat "gpg:"
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max)))))
+ (delete-file stashfile))))
+
+(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 ret (plist-put ret
- (intern (concat ":" k))
- v))
- ))
- ret))
- alist))
+ (setq v (lexical-let ((v v)
+ (filename filename)
+ (base (file-name-nondirectory
+ filename))
+ (token-decoder nil)
+ (gpgdata nil)
+ (stash nil))
+ (setq stash (concat base ".gpg"))
+ (when (string-match "gpg:\\(.+\\)" v)
+ (require 'epa nil t)
+ (unless (featurep 'epa)
+ (error "EPA could not be loaded."))
+ (setq gpgdata (base64-decode-string
+ (match-string 1 v)))
+ ;; it's a GPG token
+ (setq
+ token-decoder
+ (lambda (gpgdata)
+;;; FIXME: this relies on .gpg files being handled by EPA/EPG
+ (let* ((passkey (format "gpg:-%s" base))
+ ;; temporarily disable EPA
+ (stashfile
+ (with-auth-source-epa-overrides
+ (make-temp-file "gpg-token" nil
+ stash)))
+ (epa-file-passphrase-alist
+ `((,stashfile
+ . ,(password-read
+ (format
+ "token pass for %s? "
+ filename)
+ passkey)))))
+ (unwind-protect
+ (progn
+ ;; temporarily disable EPA
+ (with-auth-source-epa-overrides
+ (write-region gpgdata
+ nil
+ stashfile))
+ (setq
+ v
+ (with-temp-buffer
+ (insert-file-contents stashfile)
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max)))))
+ (delete-file stashfile)))
+ ;; clear out the decoder at end
+ (setq token-decoder nil
+ gpgdata nil))))
+ (lambda ()
+ (when token-decoder
+ (funcall token-decoder gpgdata))
+ v))))
+ (setq ret (plist-put ret
+ (intern (concat ":" k))
+ v))))
+ ret))
+ alist))
;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
;;; (funcall secret)
: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
(?h ,(aget printable-defaults 'host))
(?p ,(aget printable-defaults 'port))))))
- ;; store the data, prompting for the password if needed
+ ;; 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))
+ ;; 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)
- (read-string prompt default))
+ (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
(lambda () data))
data))))
- ;; when r is not an empty string...
+ ;; When r is not an empty string...
(when (and (stringp data)
(< 0 (length data)))
;; this function is not strictly necessary but I think it
(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
- data))))
+ (if (string-match "[\" ]" data)
+ (format "%S" data)
+ data)))))
(setq add (concat add (funcall printer)))))))
(plist-put
(list artificial)))
-;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch") :user "tzz" :port "imap" :create t :max 1)) :save-function))
+;;(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'."
- (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"))
- (set-buffer standard-output)
- (help-mode))))
- (?n (setq add ""
- done t))
- (?N (setq add ""
- done t
- 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)))))
+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
+ 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
projects / gnus / blobdiff