Merge from trunk.

5 files changed, 227 insertions, 17 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 1a788e7f6f9..8707a8b0adc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -820,6 +820,11 @@ on a D-Bus without simultaneously registering a property or a method.
 *** The option `ange-ftp-binary-file-name-regexp' has changed its
 default value to "".
 
+** Rmail
+
+*** The command `rmail-epa-decrypt' decrypts OpenPGP data
+in the Rmail incoming message.
+
 ** VC and related modes
 
 *** Support for pulling on distributed version control systems.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7116a152605..70d34fb7117 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
+2011-08-16  Richard Stallman  <rms@gnu.org>
+
+        * epa-mail.el: Handle GnuPG group definitions.
+        (epa-mail-group-alist, epa-mail-group-modtime)
+        (epa-mail-gnupg-conf-file): New variables.
+        (epa-mail-parse-groups, epa-mail-sync-groups)
+        (epa-mail-expand-recipient-1, epa-mail-expand-recipients-2)
+        (epa-mail-expand-recipients): New functions.
+        (epa-mail-encrypt): Call epa-mail-expand-recipients.
+
+        * mail/rmail.el (rmail-epa-decrypt): New command.
+
+        * epa.el (epa-decrypt-region): New arg MAKE-BUFFER-FUNCTION.
+        Don't bind buffer-read-only, just inhibit-read-only.
+        (epa--find-coding-system-for-mime-charset): Fix the non-xemacs case.
+        (epa-decrypt-armor-in-region): Make error message clearer.
+
 2011-08-15  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * minibuffer.el (completion-pcm--merge-completions): Don't merge "a1b"
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index a3f11f78675..e6f6c0ec2b1 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -50,6 +50,9 @@
   "A minor-mode for composing encrypted/clearsigned mails."
   nil " epa-mail" epa-mail-mode-map)
 
+;;; ??? Could someone please clarify this doc string?
+;;; In particular, what does USAGE look like
+;;; and what does it mean?  -- rms
 (defun epa-mail--find-usable-key (keys usage)
   "Find a usable key from KEYS for USAGE."
   (catch 'found
@@ -63,6 +66,71 @@
           (setq pointer (cdr pointer))))
       (setq keys (cdr keys)))))
 
+(defvar epa-mail-group-alist nil
+  "Alist of GnuPG mail groups (`group' commands in `.gnupg/gpg.conf').
+Each element has the form (GROUPNAME ADDRESSES...).
+t means the list is not yet read in.")
+
+(defvar epa-mail-group-modtime nil
+  "The modification time of `~/.gnupg/gpg.conf' file when last examined.")
+
+(defvar epa-mail-gnupg-conf-file "~/.gnupg/gpg.conf"
+  "File name of GnuPG configuration file that specifies recipient groups.")
+
+(defun epa-mail-parse-groups ()
+  "Parse `~/.gnupg/gpg.conf' and set `epa-mail-group-alist' from it."
+  (let (aliases)
+    (with-temp-buffer
+      (insert-file-contents-literally epa-mail-gnupg-conf-file)
+
+      (while (re-search-forward "^[ \t]*group[ \t]*" nil t)
+        (if (looking-at "\\([^= \t]+\\)[ \t]*=[ \t]*\\([^ \t\n]+\\)")
+            (push (cons (match-string-no-properties 1)
+                        (split-string (match-string-no-properties 2)))
+                  aliases))))
+    (setq epa-mail-group-alist aliases)))
+
+(defun epa-mail-sync-groups ()
+  "Update GnuPG groups from file if necessary."
+  (if (file-exists-p epa-mail-gnupg-conf-file)
+      (let ((modtime (nth 5 (file-attributes epa-mail-gnupg-conf-file))))
+        (if (not (equal epa-mail-group-modtime modtime))
+            (progn
+              (setq epa-mail-group-modtime modtime)
+              (epa-mail-parse-groups))))
+    (setq epa-mail-group-alist nil)))
+
+(defun epa-mail-expand-recipient-1 (recipient)
+  "Expand RECIPIENT once thru `epa-mail-group-alist'.
+Returns the list of names it stands for, or nil if it isn't a group."
+  ;; Load the alias list if not loaded before.
+  (let (alist-elt)
+    (setq alist-elt (assoc recipient epa-mail-group-alist))
+    (cdr alist-elt)))
+
+(defun epa-mail-expand-recipients-2 (recipients)
+  "Expand list RECIPIENTS once thru `epa-mail-group-alist'.
+Returns the list of names they stand for."
+  ;; Load the alias list if not loaded before.
+  (let (output)
+    (dolist (r recipients)
+      (let ((expanded (epa-mail-expand-recipient-1 r)))
+        (if expanded
+            (dolist (xr expanded)
+              (unless (member xr output)
+                (push xr output)))
+          (unless (member r output)
+            (push r output)))))
+    (nreverse output)))
+
+(defun epa-mail-expand-recipients (recipients)
+  "Expand RECIPIENTS thru `epa-mail-group-alist' until it stops changing."
+  (epa-mail-sync-groups)
+  (while (not (equal recipients
+                     (setq recipients
+                           (epa-mail-expand-recipients-2 recipients)))))
+  recipients)
+
 ;;;###autoload
 (defun epa-mail-decrypt ()
   "Decrypt OpenPGP armors in the current buffer.
@@ -140,6 +208,13 @@ Don't use this command in Lisp programs!"
            (setq recipients (delete ""
                                     (split-string recipients
                                                   "[ \t\n]*,[ \t\n]*"))))
+
+       ;; Process all the recipients thru the list of GnuPG groups.
+       ;; Expand GnuPG group names to what they stand for.
+       ;; The code below, and elsewhere, that checks that names have keys
+       ;; does not know about these group names.
+       (setq recipients (epa-mail-expand-recipients recipients))
+
        (goto-char (point-min))
        (if (search-forward mail-header-separator nil t)
            (forward-line))
diff --git a/lisp/epa.el b/lisp/epa.el
index e2fafc753d7..f0ec1ece0d1 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -803,10 +803,15 @@ If no one is selected, symmetric encryption will be performed.  ")))
              (file-name-nondirectory cipher))))
 
 ;;;###autoload
-(defun epa-decrypt-region (start end)
+(defun epa-decrypt-region (start end &optional make-buffer-function)
   "Decrypt the current region between START and END.
 
-Don't use this command in Lisp programs!
+If MAKE-BUFFER-FUNCTION is non-nil, call it to prepare an output buffer.
+It should return that buffer.  If it copies the input, it should
+delete the text now being decrypted.  It should leave point at the
+proper place to insert the plaintext.
+
+Be careful about using this command in Lisp programs!
 Since this function operates on regions, it does some tricks such
 as coding-system detection and unibyte/multibyte conversion.  If
 you are sure how the data in the region should be treated, you
@@ -838,16 +843,19 @@ For example:
                    (or coding-system-for-read
                        (get-text-property start 'epa-coding-system-used)
                        'undecided)))
-      (if (y-or-n-p "Replace the original text? ")
-          (let ((inhibit-read-only t)
-                buffer-read-only)
-            (delete-region start end)
-            (goto-char start)
-            (insert plain))
-        (with-output-to-temp-buffer "*Temp*"
-          (set-buffer standard-output)
-          (insert plain)
-          (epa-info-mode)))
+      (if make-buffer-function
+          (with-current-buffer (funcall make-buffer-function)
+            (let ((inhibit-read-only t))
+              (insert plain)))
+        (if (y-or-n-p "Replace the original text? ")
+            (let ((inhibit-read-only t))
+              (delete-region start end)
+              (goto-char start)
+              (insert plain))
+          (with-output-to-temp-buffer "*Temp*"
+            (set-buffer standard-output)
+              (insert plain)
+              (epa-info-mode))))
       (if (epg-context-result-for context 'verify)
           (epa-display-info (epg-verify-result-to-string
                              (epg-context-result-for context 'verify)))))))
@@ -856,12 +864,13 @@ For example:
   (if (featurep 'xemacs)
       (if (fboundp 'find-coding-system)
           (find-coding-system mime-charset))
+    ;; Find the first coding system which corresponds to MIME-CHARSET.
     (let ((pointer (coding-system-list)))
       (while (and pointer
-                  (eq (coding-system-get (car pointer) 'mime-charset)
-                      mime-charset))
+                  (not (eq (coding-system-get (car pointer) 'mime-charset)
+                           mime-charset)))
         (setq pointer (cdr pointer)))
-      pointer)))
+      (car pointer))))
 
 ;;;###autoload
 (defun epa-decrypt-armor-in-region (start end)
@@ -880,7 +889,7 @@ See the reason described in the `epa-decrypt-region' documentation."
                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
                                              nil t))
           (unless armor-end
-            (error "No armor tail"))
+            (error "Encryption armor beginning has no matching end"))
           (goto-char armor-start)
           (let ((coding-system-for-read
                  (or coding-system-for-read
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index c43ec9e5611..9b4bbf91823 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -4249,7 +4249,7 @@ TEXT and INDENT are not used."
    ;; rmail-output expands non-absolute filenames against rmail-default-file.
    ;; What is the point of that, anyway?
    (rmail-output (expand-file-name token))))
-
+
 ;; Functions for setting, getting and encoding the POP password.
 ;; The password is encoded to prevent it from being easily accessible
 ;; to "prying eyes."  Obviously, this encoding isn't "real security,"
@@ -4300,6 +4300,110 @@ encoded string (and the same mask) will decode the string."
      (setq i (1+ i)))
    (concat string-vector)))
 
+(defun rmail-epa-decrypt ()
+  "Decrypt OpenPGP armors in current message."
+  (interactive)
+
+  ;; Save the current buffer here for cleanliness, in case we
+  ;; change it in one of the calls to `epa-decrypt-region'.
+
+  (save-excursion
+    (let (new-buffer not-first-armor)
+      (goto-char (point-min))
+
+      ;; In case the encrypted data is inside a mime attachment,
+      ;; show it.  This is a kludge; to be clean, it should not
+      ;; modify the buffer, but I don't see how to do that.
+      (when (search-forward "octet-stream" nil t)
+        (beginning-of-line)
+        (forward-button 1)
+        (if (looking-at "Show")
+            (rmail-mime-toggle-hidden)))
+
+      ;; Now find all armored messages in the buffer
+      ;; and decrypt them one by one.
+      (goto-char (point-min))
+      (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
+        (let (armor-start armor-end
+                          (coding-system-for-read coding-system-for-read))
+          (setq armor-start (match-beginning 0)
+                armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
+                                             nil t))
+          (unless armor-end
+            (error "Encryption armor beginning has no matching end"))
+          (goto-char armor-start)
+
+          ;; Because epa--find-coding-system-for-mime-charset not autoloaded.
+          (require 'epa)
+
+          ;; Use the charset specified in the armor.
+          (unless coding-system-for-read
+            (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
+                (setq coding-system-for-read
+                      (epa--find-coding-system-for-mime-charset
+                       (intern (downcase (match-string 1)))))))
+
+          ;; Advance over this armor.
+          (goto-char armor-end)
+
+          ;; Decrypt it, maybe in place, maybe making new buffer.
+          (epa-decrypt-region
+           armor-start armor-end
+           ;; Call back this function to prepare the output.
+           (lambda ()
+             (if (or not-first-armor
+                     (y-or-n-p "Replace the original message? "))
+                 ;; User wants to decrypt in place,
+                 ;; or this isn't the first armor.
+                 ;; We only ask the question for the first armor.
+                 (let ((inhibit-read-only t))
+                   (delete-region armor-start armor-end)
+                   (goto-char armor-start)
+                   (current-buffer))
+               ;; User says not to replace the original text.
+               (or new-buffer
+                   (let ((from-buffer
+                          (if (rmail-buffers-swapped-p)
+                              rmail-view-buffer rmail-buffer))
+                         (from-pruned (rmail-msg-is-pruned))
+                         (beg (rmail-msgbeg rmail-current-message))
+                         (end (rmail-msgend rmail-current-message)))
+                     (with-current-buffer (generate-new-buffer "*Decrypt*")
+                       (setq buffer-read-only nil)
+                       (insert-buffer-substring from-buffer beg end)
+                       (rmail-mode)
+                       ;; This should be pruned if the original message was.
+                       (unless from-pruned (rmail-toggle-header))
+                       (goto-char (point-min))
+
+                       ;; Find the first armor in the text we just copied.
+                       ;; What we copied may not be identical
+                       ;; to the initial text.
+                       (re-search-forward "-----BEGIN PGP MESSAGE-----$")
+                       (setq armor-start (match-beginning 0))
+                       (re-search-forward "^-----END PGP MESSAGE-----$")
+                       (setq armor-end (point))
+                       ;; Delete it and put point there.
+                       (let ((inhibit-read-only t))
+                         (delete-region armor-start armor-end))
+                       (goto-char armor-start)
+                       (setq new-buffer (current-buffer))
+                       ;; Return; epa-decrypt-region will insert plaintext.
+                       ))))))
+
+          (setq not-first-armor t)
+
+          ;; If we copied the buffer, switch to the copy
+          ;; for the rest of this loop.
+          ;; Point is the only buffer pointer that is live here,
+          ;; and it was properly set in NEW-BUFFER by `epa-decrypt-region'
+          ;; when it inserted the decrypted epa
+          (if new-buffer (set-buffer new-buffer))))
+
+      ;; If we decrypted into a new buffer, show it.
+      (if new-buffer
+          (display-buffer new-buffer)))))
+
 ;;;;  Desktop support
 
 (defun rmail-restore-desktop-buffer (desktop-buffer-file-name