(autoload 'secrets-list-collections "secrets")
(autoload 'secrets-search-items "secrets")
+(autoload 'rfc2104-hash "rfc2104")
+
(defvar secrets-enabled)
(defgroup auth-source nil
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")
(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)
value))
values))
+;;; Backend specific parsing: netrc/authinfo backend
+
(defvar auth-source-netrc-cache nil)
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
(nth 0 v)
v))
-;; (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) v prompt)))))
- prompt)
-
;;; (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)))
(?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
+ ;; Special case prompt for passwords.
(read-passwd prompt))
((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
(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))))
(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? %s: "
- file
- "y/n/N/e/?"))
- (done (not (eq auth-source-save-behavior 'ask)))
- (bufname "*auth-source Help*")
- k)
- (while (not done)
- (message "%s" prompt)
- (setq k (read-char))
- (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