auth-source.el (auth-source-token-passphrase-callback-function): Simplify and remove EPA dependency.

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  <ueno@unixuser.org>
+
+        * auth-source.el (auth-source-token-passphrase-callback-function):
+        Simplify and remove EPA dependency.
+
 2011-07-01  Andrew Cohen  <cohen@andy.bu.edu>
 
         * 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)