X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fauth-source.el;h=2d6f472d7b2abf3d2f33d422ffee2907485bcbde;hp=108871974a021f1920a074f4a75b528e7d331454;hb=05905038fb21a389fbdf0841921a22d77d336d93;hpb=74126299d9f83f10248624ede0f0198f13d54c0f diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 108871974..2d6f472d7 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -43,17 +43,17 @@ (require 'mm-util) (require 'gnus-util) (require 'assoc) + (eval-when-compile (require 'cl)) -(eval-when-compile (require 'dropdown-list nil t)) (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."))) @@ -65,6 +65,23 @@ (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 @@ -84,6 +101,9 @@ let-binding." (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 @@ -109,6 +129,9 @@ let-binding." :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 @@ -163,6 +186,32 @@ let-binding." (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 @@ -192,7 +241,7 @@ If the value is a function, debug messages are logged by calling (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 @@ -246,9 +295,11 @@ can get pretty complex." ,@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. @@ -289,8 +340,8 @@ If the value is not a list, symmetric encryption will be used." (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) @@ -313,12 +364,6 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." (while (not (memq k choices)) (setq k (cond - ((and nil (featurep 'dropdown-list)) - (let* ((blank (fill (copy-sequence prompt) ?.)) - (dlc (cons (format "%s %c" prompt (car choices)) - (loop for c in (cdr choices) - collect (format "%s %c" blank c))))) - (nth (dropdown-list dlc) choices))) ((fboundp 'read-char-choice) (read-char-choice full-prompt choices)) (t (message "%s" full-prompt) @@ -363,12 +408,20 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." ;; 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'. @@ -642,7 +695,7 @@ must call it to obtain the actual value." (when auth-source-do-cache (auth-source-remember spec found))) - found)) + found)) (defun auth-source-search-backends (backends spec max create delete require) (let (matches) @@ -693,6 +746,8 @@ Returns the deleted entries." (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) @@ -701,30 +756,34 @@ Returns the deleted entries." 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 - (concat auth-source-magic (format "%S" spec)))) + (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)) @@ -761,7 +820,7 @@ while \(:host t) would find all host entries." (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) @@ -769,18 +828,39 @@ while \(:host t) would find all host entries." (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 @@ -819,11 +899,8 @@ Note that the MAX parameter is used so we can exit the parse early." ;; (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))))))) + :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)) @@ -890,7 +967,7 @@ Note that the MAX parameter is used so we can exit the parse early." (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) @@ -926,7 +1003,61 @@ Note that the MAX parameter is used so we can exit the parse early." (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)) @@ -942,13 +1073,25 @@ Note that the MAX parameter is used so we can exit the parse early." ;; 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)) @@ -960,7 +1103,7 @@ Note that the MAX parameter is used so we can exit the parse early." &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))) @@ -974,7 +1117,8 @@ See `auth-source-search' for details on SPEC." :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 @@ -998,17 +1142,6 @@ See `auth-source-search' for details on SPEC." (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))) @@ -1020,6 +1153,9 @@ See `auth-source-search' for details on SPEC." ;; 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 "") @@ -1054,7 +1190,9 @@ See `auth-source-search' for details on SPEC." (dolist (r required) (let* ((data (aget valist r)) ;; take the first element if the data is a list - (data (auth-source-netrc-element-or-first data)) + (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: @@ -1096,14 +1234,49 @@ See `auth-source-search' for details on SPEC." (?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 @@ -1114,7 +1287,7 @@ See `auth-source-search' for details on SPEC." (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 @@ -1122,18 +1295,19 @@ See `auth-source-search' for details on SPEC." (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 @@ -1145,70 +1319,84 @@ See `auth-source-search' for details on SPEC." (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) + (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) + ;; Make the .authinfo file non-world-readable. + (set-file-modes file #o600) + (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 @@ -1277,11 +1465,11 @@ authentication tokens: (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))) @@ -1323,6 +1511,210 @@ authentication tokens: ;; (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") @@ -1397,14 +1789,14 @@ MODE can be \"login\" or \"password\"." (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)