Merge changes made in Gnus trunk.

gnus-art.el (gnus-request-article-this-buffer): Use existing function `gnus-refer-article-methods'.
auth-source.el: Require EPA and EPG.
 (auth-source-passphrase-alist): New variable.
 (auth-source-passphrase-callback-function, auth-source-token-passphrase-callback-function): Callbacks for the netrc field encryption (GPG tokens).
 (auth-source-epa-extract-gpg-token, auth-source-epa-make-gpg-token): Symmetric encryption and decryption of the netrc GPG tokens.
 (auth-source-netrc-normalize): Use them, simplifying the closure.

3 files changed, 108 insertions, 112 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ea7aedc3e6a..8133964dd41 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,19 @@
+2011-06-30  Andrew Cohen  <cohen@andy.bu.edu>
+
+        * gnus-art.el (gnus-request-article-this-buffer): Use existing function
+        `gnus-refer-article-methods'.
+
+2011-06-30  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * auth-source.el: Require EPA and EPG.
+        (auth-source-passphrase-alist): New variable.
+        (auth-source-passphrase-callback-function)
+        (auth-source-token-passphrase-callback-function): Callbacks for the
+        netrc field encryption (GPG tokens).
+        (auth-source-epa-extract-gpg-token, auth-source-epa-make-gpg-token):
+        Symmetric encryption and decryption of the netrc GPG tokens.
+        (auth-source-netrc-normalize): Use them, simplifying the closure.
+
 2011-06-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
         * nnimap.el (nnimap-split-incoming-mail): If `nnimap-split-fancy' is
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index d62b79b6484..25c6b924305 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -43,6 +43,9 @@
 (require 'mm-util)
 (require 'gnus-util)
 (require 'assoc)
+(require 'epa)
+(require 'epg)
+
 (eval-when-compile (require 'cl))
 (require 'eieio)
 
@@ -979,56 +982,78 @@ Note that the MAX parameter is used so we can exit the parse early."
 
           (nreverse result))))))
 
-(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)
-                 (symbol-value 'find-file-hook)
-               (symbol-value '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))
-
+(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)
+        ;; 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 (auth-source-passphrase-callback-function context
+                                                                 key-id
+                                                                 file
+                                                                 " tokens"))
+              (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
+                              (lambda () p)))
+              passphrase)))
+    (epa-passphrase-callback-function context key-id file)))
+
+;; (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)
-  (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))))
+  (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)
@@ -1046,60 +1071,22 @@ 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)
-                                          (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 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))))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 6c3ad01eabf..7e2d213d20c 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6832,23 +6832,16 @@ If given a prefix, show the hidden text instead."
                 (numberp article))
             (let ((gnus-override-method gnus-override-method)
                   (methods (and (stringp article)
-                                gnus-refer-article-method))
+                                (with-current-buffer gnus-summary-buffer
+                                  (gnus-refer-article-methods))))
                   (backend (car (gnus-find-method-for-group
                                  gnus-newsgroup-name)))
                   result
                   (inhibit-read-only t))
-              (if (or (not (listp methods))
-                      (and (symbolp (car methods))
-                           (assq (car methods) nnoo-definition-alist)))
-                  (setq methods (list methods)))
               (when (and (null gnus-override-method)
                          methods)
                 (setq gnus-override-method (pop methods)))
               (while (not result)
-                (when (eq gnus-override-method 'current)
-                  (setq gnus-override-method
-                        (with-current-buffer gnus-summary-buffer
-                          gnus-current-select-method)))
                 (erase-buffer)
                 (gnus-kill-all-overlays)
                 (let ((gnus-newsgroup-name group))