From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Damien Cassou Newsgroups: gmane.emacs.bugs Subject: bug#30962: 26.0.91; Encrypt message when there is a key for each recipient Date: Wed, 04 Apr 2018 11:35:55 +0200 Message-ID: <876057fh50.fsf@cassou.me> References: <87r2o58rbc.fsf@cassou.me> <87o9izxtcl.fsf@petton.fr> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1522834510 20255 195.159.176.226 (4 Apr 2018 09:35:10 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 4 Apr 2018 09:35:10 +0000 (UTC) To: Nicolas Petton , 30962@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Apr 04 11:35:05 2018 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1f3eor-0005BJ-5R for geb-bug-gnu-emacs@m.gmane.org; Wed, 04 Apr 2018 11:35:05 +0200 Original-Received: from localhost ([::1]:44580 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f3eqw-0000a9-Ks for geb-bug-gnu-emacs@m.gmane.org; Wed, 04 Apr 2018 05:37:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36888) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f3eqn-0000Ya-NS for bug-gnu-emacs@gnu.org; Wed, 04 Apr 2018 05:37:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f3eqk-0004L5-H9 for bug-gnu-emacs@gnu.org; Wed, 04 Apr 2018 05:37:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:57964) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1f3eqk-0004Kf-2C for bug-gnu-emacs@gnu.org; Wed, 04 Apr 2018 05:37:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1f3eqj-0001wS-M0 for bug-gnu-emacs@gnu.org; Wed, 04 Apr 2018 05:37:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Damien Cassou Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 04 Apr 2018 09:37:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 30962 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 30962-submit@debbugs.gnu.org id=B30962.15228345737403 (code B ref 30962); Wed, 04 Apr 2018 09:37:01 +0000 Original-Received: (at 30962) by debbugs.gnu.org; 4 Apr 2018 09:36:13 +0000 Original-Received: from localhost ([127.0.0.1]:37628 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1f3epq-0001vD-Lj for submit@debbugs.gnu.org; Wed, 04 Apr 2018 05:36:13 -0400 Original-Received: from mail.choca.pics ([62.210.108.126]:52890) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1f3epm-0001ut-Fp for 30962@debbugs.gnu.org; Wed, 04 Apr 2018 05:36:05 -0400 Original-Received: from localhost (localhost.localdomain [IPv6:::1]) by mail.choca.pics (Postfix) with ESMTP id 4298C2331109; Wed, 4 Apr 2018 11:36:01 +0200 (CEST) Original-Received: from mail.choca.pics ([IPv6:::1]) by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10032) with ESMTP id VvLhcovT94Da; Wed, 4 Apr 2018 11:35:58 +0200 (CEST) Original-Received: from localhost (localhost.localdomain [IPv6:::1]) by mail.choca.pics (Postfix) with ESMTP id A4276233110A; Wed, 4 Apr 2018 11:35:58 +0200 (CEST) DKIM-Filter: OpenDKIM Filter v2.10.3 mail.choca.pics A4276233110A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=cassou.me; s=9EA44F5C-DEF4-11E6-A83F-A08DF322D8FB; t=1522834558; bh=cYPtbF6kOwdGgM1yqED/1a5mjEzXlh2nUucSrK/EVDU=; h=From:To:Date:Message-ID:MIME-Version; b=hSB2wpYbBCkX8mTDRJqSu7hYl0t/BlifRdYLGIIUBzpUEZi49WOcqRw5U8uBaEZ8w O7LTgTG2x7EWo+1TwAiV3G0Fin0d+WMNu+V/zvS25vffRaurDo3PmFsZn0UEEkdUnr 6EJKqfn5aTb3beHhUq94xpjcAarRNW/agR40EHwmAg6swGuUP5/zsJ5o2Ry/c49GNE pDzLURBxEOUOvWzsf24gxyiPzUKVtrUPXGoVaajvaDcrI5RLeBblw2zQ4gvSg4EPtS aesdF+GxhWC1Gm8rwCRfLhNhBCdOHHxeOSr91/7A8qu2o6MdU9QbOo1ZHqxdrulcEe tlvFFzmk3n9XQ== X-Virus-Scanned: amavisd-new at choca.pics Original-Received: from mail.choca.pics ([IPv6:::1]) by localhost (mail.choca.pics [IPv6:::1]) (amavisd-new, port 10026) with ESMTP id YBucPLreKYKr; Wed, 4 Apr 2018 11:35:58 +0200 (CEST) Original-Received: from luz4 (20-44-190-109.dsl.ovh.fr [109.190.44.20]) by mail.choca.pics (Postfix) with ESMTPSA id 3DAC02331109; Wed, 4 Apr 2018 11:35:58 +0200 (CEST) In-Reply-To: <87o9izxtcl.fsf@petton.fr> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:144880 Archived-At: --=-=-= Content-Type: text/plain Nicolas Petton writes: > Would `message-all-recipients' be a better name? renamed > Could you add tests for `message-all-epg-keys-available-p' as well? done. Please find attached a new version. -- Damien Cassou http://damiencassou.seasidehosting.st "Success is the ability to go from one failure to another without losing enthusiasm." --Winston Churchill --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Detect-if-a-message-can-be-encrypted-and-add-an-MML-.patch >From 64bf9c2f6b15e82b5d077b1428408237ad1d1e74 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 | 46 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 84 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index baff9664cf..02b31ecff4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -337,6 +337,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..fdb296fc24 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2582,6 +2582,36 @@ message-info (t 'message))))) +(defun message-all-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-all-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..9124dcf77a 100644 --- a/test/lisp/gnus/message-tests.el +++ b/test/lisp/gnus/message-tests.el @@ -29,6 +29,8 @@ (require 'ert) (require 'ert-x) +(require 'cl-lib) + (ert-deftest message-mode-propertize () (with-temp-buffer (unwind-protect @@ -97,6 +99,50 @@ (should (string= stripped-was (message-strip-subject-trailing-was with-was))))))) +(ert-deftest message-all-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-all-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")))))) + +(ert-deftest message-all-epg-keys-available-p () + (let ((person1 '("Person 1" "p1@p1.org")) + (person2 '("Person 2" "p2@p2.org")) + (person3 '("Person 3" "p3@p3.org")) + (recipients nil) + (keyring '("p1@p1.org" "p2@p2.org"))) + (cl-letf (((symbol-function 'epg-list-keys) + (lambda (_ email) (cl-find email keyring :test #'string=))) + ((symbol-function 'message-all-recipients) + (lambda () recipients))) + + (setq recipients (list)) + (should (message-all-epg-keys-available-p)) + + (setq recipients (list person1)) + (should (message-all-epg-keys-available-p)) + + (setq recipients (list person1 person2)) + (should (message-all-epg-keys-available-p)) + + (setq recipients (list person3)) + (should-not (message-all-epg-keys-available-p)) + + (setq recipients (list person1 person3)) + (should-not (message-all-epg-keys-available-p)) + + (setq recipients (list person3 person1)) + (should-not (message-all-epg-keys-available-p)) + + (setq recipients (list person1 person2 person3)) + (should-not (message-all-epg-keys-available-p))))) (provide 'message-mode-tests) -- 2.14.3 --=-=-=--