Keep a cache of encoded Message contents to avoid re-GPG-in data

* lisp/gnus/gnus-msg.el (gnus-inews-do-gcc): Use it to avoid
re-encoding.

* lisp/gnus/message.el (message-encoded-mail-cache): New variable.

* lisp/gnus/message.el (message-send-mail): Store encoded.
(message--cache-encoded): New function.
(message-do-fcc): Store encoded (bug#25155).

diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 25efb8afda3e89ea106ad305a5f54c593b97fa69..10793455a52f812037efd535b7b3ed02efa5f02c 100644 (file)
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1587,6 +1587,7 @@ this is a reply."
       (message-narrow-to-headers)
       (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
            (cur (current-buffer))
+           (encoded-cache message-encoded-mail-cache)
            groups group method group-art options
            mml-externalize-attachments)
        (when gcc
@@ -1614,7 +1615,12 @@ this is a reply."
              (setq message-options (with-current-buffer cur message-options))
              (insert-buffer-substring cur)
              (run-hooks 'gnus-gcc-pre-body-encode-hook)
-             (message-encode-message-body)
+             ;; Avoid re-doing things like GPG-encoding secret parts.
+             (if (not encoded-cache)
+                 (message-encode-message-body)
+               (erase-buffer)
+               (insert encoded-cache))
+             (message-remove-header "gcc")
              (run-hooks 'gnus-gcc-post-body-encode-hook)
              (save-restriction
                (message-narrow-to-headers)

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 58b25f91440f863263328d1f14995d18568d7805..c211bcc265440d35c400775ab05935fca1d19fa9 100644 (file)
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1891,6 +1891,9 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (defvar message-bogus-system-names "\\`localhost\\.\\|\\.local\\'"
   "The regexp of bogus system names.")
 
+(defvar message-encoded-mail-cache nil
+  "After sending a message, the encoded version is cached in this variable.")
+
 (autoload 'gnus-alive-p "gnus-util")
 (autoload 'gnus-delay-article "gnus-delay")
 (autoload 'gnus-extract-address-components "gnus-util")
@@ -2974,7 +2977,8 @@ Like `text-mode', but with these additional commands:
   ;; excluding citations and other artifacts.
   ;;
   (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize)
-  (set (make-local-variable 'parse-sexp-ignore-comments) t))
+  (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  (setq-local message-encoded-mail-cache nil))
 
 (defun message-setup-fill-variables ()
   "Setup message fill variables."
@@ -4598,6 +4602,7 @@ If you always want Gnus to send messages in one piece, set
                    (mml-buffer-substring-no-properties-except-some
                     (point-min) (point-max))))
          (message-encode-message-body)
+         (message--cache-encoded mailbuf)
          (save-restriction
            (message-narrow-to-headers)
            ;; We (re)generate the Lines header.
@@ -4653,6 +4658,14 @@ If you always want Gnus to send messages in one piece, set
     (setq message-options options)
     (push 'mail message-sent-message-via)))
 
+(defun message--cache-encoded (mailbuf)
+  ;; Store the encoded buffer data for possible reuse later
+  ;; when doing Fcc/Gcc handling.  This avoids having to do
+  ;; things like re-GPG-encoding secure parts.
+  (let ((encoded (buffer-string)))
+    (with-current-buffer mailbuf
+      (setq message-encoded-mail-cache encoded))))
+
 (defun message--fold-long-headers ()
   "Fold too-long header lines.
 Each line should be no more than 79 characters long."
@@ -4946,6 +4959,7 @@ Otherwise, generate and save a value for `canlock-password' first."
                 (mml-buffer-substring-no-properties-except-some
                  (point-min) (point-max))))
              (message-encode-message-body)
+             (message--cache-encoded messbuf)
              ;; Remove some headers.
              (save-restriction
                (message-narrow-to-headers)
@@ -5408,6 +5422,7 @@ The result is a fixnum."
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
        (buf (current-buffer))
+       (encoded-cache message-encoded-mail-cache)
        (mml-externalize-attachments message-fcc-externalize-attachments)
        (file (message-field-value "fcc" t))
        list)
@@ -5415,7 +5430,11 @@ The result is a fixnum."
       (with-temp-buffer
        (insert-buffer-substring buf)
        (message-clone-locals buf)
-       (message-encode-message-body)
+       ;; Avoid re-doing things like GPG-encoding secret parts.
+       (if (not encoded-cache)
+           (message-encode-message-body)
+         (erase-buffer)
+         (insert encoded-cache))
        (save-restriction
          (message-narrow-to-headers)
          (while (setq file (message-fetch-field "fcc" t))