From 72b2b4a5dbac0199ae50430cf956ec85651f38b3 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 23 Sep 2019 11:46:11 +0200
Subject: [PATCH] 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).
---
 lisp/gnus/gnus-msg.el |  8 +++++++-
 lisp/gnus/message.el  | 23 +++++++++++++++++++++--
 2 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 25efb8afda3..10793455a52 100644
--- 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 58b25f91440..c211bcc2654 100644
--- 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))
-- 
2.39.2