>From 483d0f6723d945ee828348fb9705c403305486fd Mon Sep 17 00:00:00 2001 From: Damien Cassou 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 , Person 2 \n") + (insert "CC: Person 3 , Person 4 \n") + (insert "BCC: Person 5 , Person 6 \n") + (should (equal (message-recipients) + '(("Person 1" "p1@p1.org") + ("Person 2" "p2@p2.org") + ("Person 3" "p3@p3.org") + ("Person 4" "p4@p4.org") + ("Person 5" "p5@p5.org") + ("Person 6" "p6@p6.org")))))) (provide 'message-mode-tests) -- 2.14.3