From e9cb4479f5a80de75d79ea957502e59c87992c9c Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Fri, 1 Jul 2011 14:05:59 +0000 Subject: [PATCH] auth-source.el (auth-source-token-passphrase-callback-function): Simplify and remove EPA dependency. --- lisp/gnus/ChangeLog | 5 + lisp/gnus/auth-source.el | 260 +++++++++++++++++++-------------------- 2 files changed, 131 insertions(+), 134 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 088d5a426f0..1567bfaddd2 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2011-07-01 Daiki Ueno + + * auth-source.el (auth-source-token-passphrase-callback-function): + Simplify and remove EPA dependency. + 2011-07-01 Andrew Cohen * nnir.el (nnir-request-article): Fix error message text. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 1b5b4840085..677698ebc96 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -45,7 +45,17 @@ (require 'assoc) (eval-when-compile (require 'cl)) -(require 'eieio) +(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))) + (error + "eieio not found in `load-path' or gnus-fallback-lib/ directory."))) (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") @@ -64,8 +74,6 @@ (autoload 'plstore-save "plstore") (autoload 'plstore-get-file "plstore") -(autoload 'epa-passphrase-callback-function "epa") - (autoload 'epg-context-operation "epg") (autoload 'epg-make-context "epg") (autoload 'epg-context-set-passphrase-callback "epg") @@ -92,6 +100,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 @@ -285,9 +296,9 @@ can get pretty complex." (const :format "" :value :user) (choice :tag "Personality/Username" - (const :tag "Any" t) - (string - :tag "Name"))))))))) + (const :tag "Any" t) + (string + :tag "Name"))))))))) (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. @@ -328,8 +339,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) @@ -397,19 +408,19 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." ;; a file name with parameters ((stringp (plist-get entry :source)) (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 '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))) + (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'. @@ -683,7 +694,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) @@ -805,7 +816,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) @@ -840,10 +851,10 @@ while \(:host t) would find all host entries." (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)) ;;; Backend specific parsing: netrc/authinfo backend @@ -888,7 +899,7 @@ Note that the MAX parameter is used so we can exit the parse early." (base64-encode-string (buffer-string))))) (lambda () (base64-decode-string - (rot13-string v))))))) + (rot13-string v))))))) (goto-char (point-min)) ;; Go through the file, line by line. (while (and (not (eobp)) @@ -955,7 +966,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) file)))) + (list alist) file)))) (loop for req in require always (plist-get normalized req))))) (decf max) @@ -993,25 +1004,7 @@ Note that the MAX parameter is used so we can exit the parse early." (defvar auth-source-passphrase-alist nil) -(defun auth-source-passphrase-callback-function (context key-id handback - &optional sym-detail) - "Exactly like `epa-passphrase-callback-function' but takes an -extra SYM-DETAIL parameter which will be printed at the end of -the symmetric passphrase prompt, and assumes symmetric -encryption." - (read-passwd - (format "Passphrase for symmetric encryption%s%s: " - ;; Add the file name to the prompt, if any. - (if (stringp handback) - (format " for %s" handback) - "") - (if (stringp sym-detail) - sym-detail - "")) - (eq (epg-context-operation context) 'encrypt))) - (defun auth-source-token-passphrase-callback-function (context key-id file) - (if (eq key-id 'SYM) (let* ((file (file-truename file)) (entry (assoc file auth-source-passphrase-alist)) passphrase) @@ -1023,14 +1016,13 @@ encryption." (unless entry (setq entry (list file)) (push entry auth-source-passphrase-alist)) - (setq passphrase (auth-source-passphrase-callback-function context - key-id - file - " tokens")) + (setq passphrase + (read-passwd + (format "Passphrase for %s tokens: " file) + t)) (setcdr entry (lexical-let ((p (copy-sequence passphrase))) (lambda () p))) - passphrase))) - (epa-passphrase-callback-function context key-id file))) + passphrase)))) ;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc") (defun auth-source-epa-extract-gpg-token (secret file) @@ -1096,11 +1088,11 @@ FILE is the file from which we obtained this token." (when token-decoder (setq lexv (funcall token-decoder lexv))) lexv)))) - (setq ret (plist-put ret - (intern (concat ":" k)) - v)))) - ret)) - alist)) + (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) @@ -1110,7 +1102,7 @@ FILE is the file from which we obtained this token." &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))) @@ -1160,9 +1152,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))) + (current-data (car (auth-source-search :max 1 + :host host + :port port))) (required (append base-required create-extra)) (file (oref backend source)) (add "") @@ -1198,8 +1190,8 @@ See `auth-source-search' for details on SPEC." (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)))) + (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: @@ -1246,8 +1238,8 @@ See `auth-source-search' for details on SPEC." (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) + ;; 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 @@ -1264,7 +1256,7 @@ See `auth-source-search' for details on SPEC." (setq ret (cdr item)) (setq check nil))))) (t 'never))) - (plain (read-passwd prompt))) + (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 @@ -1312,9 +1304,9 @@ See `auth-source-search' for details on SPEC." (secret "password") (port "port") ; redundant but clearer (t (symbol-name r))) - (if (string-match "[\" ]" data) - (format "%S" data) - data))))) + (if (string-match "[\" ]" data) + (format "%S" data) + data))))) (setq add (concat add (funcall printer))))))) (plist-put @@ -1377,9 +1369,9 @@ Respects `auth-source-save-behavior'. Uses (?n (setq add "" done t)) (?N - (setq add "" - done t) - (customize-save-variable 'auth-source-save-behavior nil)) + (setq add "" + done t) + (customize-save-variable 'auth-source-save-behavior nil)) (?e (setq add (read-string "Line to add: " add))) (t nil))) @@ -1470,11 +1462,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))) @@ -1534,31 +1526,31 @@ authentication tokens: ;; 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))) + (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))) + '(:host :login :port :secret) + search-keys))) (items (plstore-find store search-spec)) - (item-names (mapcar #'car items)) + (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)) + (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) @@ -1574,38 +1566,38 @@ authentication tokens: (cond ;; if we need to create an entry AND none were found to match ((and create - (not items)) + (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))))) + ;; 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) + item-names) (dolist (item-name item-names) - (plstore-delete store item-name)) + (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) + &key backend + secret host user port create + &allow-other-keys) (let* ((base-required '(host user port secret)) - (base-secret '(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))) + (current-data (car (auth-source-search :max 1 + :host host + :port port))) (required (append base-required create-extra)) (file (oref backend source)) (add "") @@ -1613,7 +1605,7 @@ authentication tokens: valist ;; `artificial' will be returned if no creation is needed artificial - secret-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 @@ -1642,8 +1634,8 @@ authentication tokens: (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)))) + (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: @@ -1702,23 +1694,23 @@ authentication tokens: (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)))))) + (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) + (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))))) + (plstore-get-file (oref backend data)))) + (plstore-save (oref backend data))))) ;;; older API @@ -1794,14 +1786,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) -- 2.39.2