Subject: bug#30962: closed (Re: bug#30962: 26.0.91; Encrypt message when there is a key for each recipient)

From: [email-masked] (GNU bug Tracking System)
Date: Wed, 04 Apr 2018 18:36:02 +0000

Your bug report

#30962: 26.0.91; Encrypt message when there is a key for each recipient

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
30962: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=30962
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#30962: 26.0.91; Encrypt message when there is a key for each recipient
From: Nicolas Petton <[email-masked]>
To: Lars Ingebrigtsen <[email-masked]>
Cc: Damien Cassou <[email-masked]>, [email-masked], [email-masked]
Date: Wed, 04 Apr 2018 20:35:15 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Lars Ingebrigtsen <[email-masked]> writes:

>> Lars, if that's ok with you, I'll install Damien's patch on master.
>
> Looks good to me.

Ok, I installed it in master, so I'm closing this issue.

Cheers,
Nico

Subject: 26.0.91; Encrypt message when there is a key for each recipient
From: Damien Cassou <[email-masked]>
To: [email-masked]
Date: Tue, 27 Mar 2018 17:35:19 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Attached patch adds support to automatically encrypt email messages when
the epg keyring contains a key for every recipient.

-- 
Damien Cassou
http://damiencassou.seasidehosting.st

"Success is the ability to go from one failure to another without
losing enthusiasm." --Winston Churchill
>From 483d0f6723d945ee828348fb9705c403305486fd Mon Sep 17 00:00:00 2001
From: Damien Cassou <[email-masked]>
Date: Tue, 27 Mar 2018 16:57:51 +0200
Subject: [PATCH] Detect if a message can be encrypted and add an MML tag

* lisp/gnus/message.el (message-recipients): Return a list of pairs,
one for each recipient in To, Cc, Bcc.
(message-all-epg-keys-available-p): Check that there is a public key
in epg for each recipient of the current message.
(message-sign-encrypt-if-all-keys-available): Add MML tag to sign and
encrypt current message if there is a public key for every recipient
in current message.

* test/lisp/gnus/message-tests.el (message-recipients): Test for
message-recipients.
---
 etc/NEWS                        |  8 ++++++++
 lisp/gnus/message.el            | 30 ++++++++++++++++++++++++++++++
 test/lisp/gnus/message-tests.el | 12 ++++++++++++
 3 files changed, 50 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 04774c13e5..5ae52dfa38 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -315,6 +315,14 @@ or NextCloud hosted files and directories.
 It was obsolete since Emacs 22.1, replaced by customize.
 
 
+** Message
+
++++
+*** Messages can now be systematically encrypted
+when the PGP keyring contains a public key for every recipient.  To
+achieve this, add 'message-add-encrypt-tag-if-can-encrypt' to
+'message-send-hook'.
+
 * New Modes and Packages in Emacs 27.1
 
 +++
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 37b994de99..4747d83f4d 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2582,6 +2582,36 @@ message-info
 		      (t
 		       'message)))))
 
+(defun message-recipients ()
+  "Return a list of all recipients in the message, looking at TO, CC and BCC.
+
+Each recipient is in the format of `mail-extract-address-components'."
+  (mapcan (lambda (header)
+            (let ((header-value (message-fetch-field header)))
+              (and
+               header-value
+               (mail-extract-address-components header-value t))))
+          '("To" "Cc" "Bcc")))
+
+(defun message-all-epg-keys-available-p ()
+  "Return non-nil if the pgp keyring has a public key for each recipient."
+  (require 'epa)
+  (let ((context (epg-make-context epa-protocol)))
+    (catch 'break
+      (dolist (recipient (message-recipients))
+        (let ((recipient-email (cadr recipient)))
+          (when (and recipient-email (not (epg-list-keys context recipient-email)))
+            (throw 'break nil))))
+      t)))
+
+(defun message-sign-encrypt-if-all-keys-available ()
+  "Add MML tag to encrypt message when there is a key for each recipient.
+
+Consider adding this function to `message-send-hook' to
+systematically send encrypted emails when possible."
+  (when (message-all-epg-keys-available-p)
+    (mml-secure-message-sign-encrypt)))
+
 
 
 ;;;
diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el
index ec1f247020..3678fa8cc8 100644
--- a/test/lisp/gnus/message-tests.el
+++ b/test/lisp/gnus/message-tests.el
@@ -97,6 +97,18 @@
         (should (string= stripped-was
                          (message-strip-subject-trailing-was with-was)))))))
 
+(ert-deftest message-recipients ()
+  (ert-with-test-buffer (:name "message")
+    (insert "To: Person 1 <[email-masked]>, Person 2 <[email-masked]>\n")
+    (insert "CC: Person 3 <[email-masked]>, Person 4 <[email-masked]>\n")
+    (insert "BCC: Person 5 <[email-masked]>, Person 6 <[email-masked]>\n")
+    (should (equal (message-recipients)
+                   '(("Person 1" "[email-masked]")
+                     ("Person 2" "[email-masked]")
+                     ("Person 3" "[email-masked]")
+                     ("Person 4" "[email-masked]")
+                     ("Person 5" "[email-masked]")
+                     ("Person 6" "[email-masked]"))))))
 
 (provide 'message-mode-tests)
 
-- 
2.14.3