bug#63627: Improve plstore.el and fix various issues of it

[Jens Schmidt via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1209 bytes --]

On 2023-09-02  09:41, Eli Zaretskii wrote:

> Date: Thu, 31 Aug 2023 12:21:38 +0200
> Cc: 63627@debbugs.gnu.org
> From: Jens Schmidt <jschmidt4gnu@vodafonemail.de>

> OK, so I've now installed the documentation changes on emacs-29.
Thanks.

> Please prepare the other patch for master, and let's install it there.

Done, please see attached patch.

>> Actually, it *would* be interesting to know what you check in such a
>> situation, if it could be easily described.
> 
> I look at the commit log message, make sure the relevant tests still
> pass, and do anything else my eyes suggest while looking at the patch.

Ok.

Please let your eyes rest in particular on lines 310 and following of
test/lisp/plstore-tests.el, where I have tried to detect and avoid
hangs related to GnuPG 2.4.*.

I have executed the new tests on GNU/Linux only, since that is the only
platform I have available.  Should I take extra steps to get these tests
executed on other platforms than GNU/Linux *before* you commit them?  If
yes, which steps?

The rest of the tests should be more or less standard.  Except
probably for the fact that there is still much infrastructure and few
actual tests, but I plan to change that.

Thanks.

[-- Attachment #2: 0001-Add-tests-for-plstore.el.patch --]
[-- Type: text/x-patch, Size: 32337 bytes --]

From 90626839cc14b32f74acae16d2d7dc1d0d728460 Mon Sep 17 00:00:00 2001
From: Jens Schmidt <jschmidt4gnu@vodafonemail.de>
Date: Wed, 16 Aug 2023 23:42:11 +0200
Subject: [PATCH] Add tests for plstore.el

* test/lisp/plstore-resources/plstore-tests.pubkey:
* test/lisp/plstore-resources/plstore-tests.seckey:
* test/lisp/plstore-tests.el: Add new files.  (Bug#63627)
---
 .../plstore-resources/plstore-tests.pubkey    |  40 ++
 .../plstore-resources/plstore-tests.seckey    |  83 +++
 test/lisp/plstore-tests.el                    | 535 ++++++++++++++++++
 3 files changed, 658 insertions(+)
 create mode 100644 test/lisp/plstore-resources/plstore-tests.pubkey
 create mode 100644 test/lisp/plstore-resources/plstore-tests.seckey
 create mode 100644 test/lisp/plstore-tests.el

diff --git a/test/lisp/plstore-resources/plstore-tests.pubkey b/test/lisp/plstore-resources/plstore-tests.pubkey
new file mode 100644
index 00000000000..f006ce9c071
--- /dev/null
+++ b/test/lisp/plstore-resources/plstore-tests.pubkey
@@ -0,0 +1,40 @@
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+
+mQGNBGSB/poBDACkSkNrg5nkN1J4BoJTgqkSQQa89B88hP+C83UuKZZ90Y2RySbC
+IR8OnARimtOaokEn+k3gMYiVDxmYcPcCM5OYt1diByjbv018MYyq+sPTWvfjSLQM
+k4ZEHho4ucSdP8u+jgbTY8n+qIco07kXR0LjB4D5cvwHPsYmOaXci2DiPaVZ2KSB
+PqIXHL2jXWZKo7yAwRym+gP7SOAXIRbI5Fgnjm4R8xPZI9i67hsVrn4iLEvNdPXN
+C4nZVsKshWCfko5IDAsyZR+SVfoXYj+BpweGZhpcAOrUupGHagDUhvqY9DDz352J
+pWu/852oMfTVvV6h3JevniPd2ZBPWKOyteYBWP+7Cy6KE8wEEXTTpyoGN9UVcXup
+Jrb2rlkmlIBi7rRssgW/uEnfTiNiCF5y90tpvdl0kHhuWU1Mx4+JqYFOjXi7IpCA
+kyObW4nZ0iZrxt5yVqi2r00FJChMWOrzuPtaQgELyJLHVSOjexegpPTv56dV+Eko
+Dvy40PsGxCmgUR8AEQEAAbQScGxzdG9yZS10ZXN0cy1yY3B0iQHOBBMBCgA4FiEE
+AahVzTjV+MwdUQd1HBcSKC4CYkQFAmSB/poCGwMFCwkIBwIGFQoJCAsCBBYCAwEC
+HgECF4AACgkQHBcSKC4CYkRxmwv+OmFgU8JsBGZGj12/RBQu4wXwryS2r5AJf6Cp
+RCLD0ilEe5wX3zvJu1vpSyc79xTSvlXf/thRCHfgXw+m+IkY101rt2pVEBHgLC98
+ql0JDvY5dsd0S98bMgilULFGgSvfJYxY+Zlgf4jiWuo3b/43We4IbCXpF7C2356U
+rJEImZo7PC/wbsb4VUTUACLlaspoXByz0GrnvzpfQjmoZHLQlKtMN1EZnQLooxv/
+0CKmBRXD08rJrO46+wgTKKptxd5hgmCHnRIbmaP3I1nvNDKp1BINUYJEsVNBEQuU
+sScHWXdbzb64zhyQvynad85tdP+srVcRTCJhiTJu7VAFgDvqXK8CZ6ApSvqwN9xa
+euw4LjZi4TjA5Qd9SWUyP/TNtiqg8SsipjRvCeE7UfV7jA/W63uKgsbA48QY337O
+b69bA5HQuBbsNd1oF74mlEd0q/sOog6hVxzT2FplOTJfUlNhQK6QcwQ5HoiMOafI
+8WSDVaAgewjBfpQzhcd0LIK6oKzquQGNBGSB/poBDADB9ioE+o8mfybEce2aGmq8
+4ouwb5k3NHAt3+d4AcVQ+prCe4Hy2Exyk+iiDleAt6LX2sf2eS7+NZ1RsDSNS8iL
+5dwRwFoTc7cVa2sz6EPtHBpwwfdBaihzySxdKl4MEevr2skAcBJ7vC2ALhA02/98
+7CRGxEs8/Zof63/NlMJHdL9Ektsl4dm6SiSijcJlikML6qA7DpN6+l7SXk0ot1AT
+NKGMmmY5n3rpEu6yKKd8kNWxlrhlSDGPXPijBzyOElKG7vfuzaMbisxGBaIF44qb
+n24nwXxlSmiotJHsV+HfxoJaGIJwhd+BW35FFLgGLJ1F+TwUPhPnv+N0b4mtebBs
+MjwbyFCSGMkP7mMPtsNlTRaWlX0Fk5SR7eePhS2+wa/CfYPEOrwf5mpsu/65sAmI
+qBKuNz7xskuwCv5SJG9XdLYHbJcKxTQaJNOizHiRCLT2tHqLbF+B7kEZrm+uDWLU
+XOe8YZRVQltryuwtu7HeaNa1aOCXTgTfbC4E2/5myGEAEQEAAYkBtgQYAQoAIBYh
+BAGoVc041fjMHVEHdRwXEiguAmJEBQJkgf6aAhsMAAoJEBwXEiguAmJErL8L+waA
+JRvLggz1s+SznyV3iXqq9fOJ1ETbu13sJ0+KOih9pn5tbN9eDgH39wmiPw+wZTMi
+Lu+LIy07gEMsVwjK6B9khX0lwXHgWCdEgj8le2c00sQpUHEJx6wBwwu2mk4xbOSg
+U1Y5No8IRhJYC+fchWqOtJYAkBbpRkCPnlVwEoDnF4/S1u6hNBPM7MqJVIc07g9f
+1EiVOzO/XV5Jt8ngZr0BaCa9LHFCxIySH2nkOO2akne+TS/brGRmyC4cKId5vf7a
+NKF7jePh3JSui9nAz6kqqWqCPQTPFN9wGNB9MPLsXoOU8ucjCNZ027S1z/QuDQvt
+JCfR1NICHxjg6UAII5gT/Xw9CGlj3AB/sOVI0khi9nWtI8j7kgmBA33fthuJWD9d
+XkLwpVr6c8NLH5oi7WHVAJM8Qz/QOZeIhF5+CF4KVj5qqNBsZcSfMQLjAHwx+UeY
+PApR0Z2bXjSpcT1hTJVg2kwmKj7Ol6FvAgOyssCi5jMWmGXMiny7zfF86AKaOA==
+=0gx/
+-----END PGP PUBLIC KEY BLOCK-----
diff --git a/test/lisp/plstore-resources/plstore-tests.seckey b/test/lisp/plstore-resources/plstore-tests.seckey
new file mode 100644
index 00000000000..a148c9c2026
--- /dev/null
+++ b/test/lisp/plstore-resources/plstore-tests.seckey
@@ -0,0 +1,83 @@
+-----BEGIN PGP PRIVATE KEY BLOCK-----
+
+lQWGBGSB/poBDACkSkNrg5nkN1J4BoJTgqkSQQa89B88hP+C83UuKZZ90Y2RySbC
+IR8OnARimtOaokEn+k3gMYiVDxmYcPcCM5OYt1diByjbv018MYyq+sPTWvfjSLQM
+k4ZEHho4ucSdP8u+jgbTY8n+qIco07kXR0LjB4D5cvwHPsYmOaXci2DiPaVZ2KSB
+PqIXHL2jXWZKo7yAwRym+gP7SOAXIRbI5Fgnjm4R8xPZI9i67hsVrn4iLEvNdPXN
+C4nZVsKshWCfko5IDAsyZR+SVfoXYj+BpweGZhpcAOrUupGHagDUhvqY9DDz352J
+pWu/852oMfTVvV6h3JevniPd2ZBPWKOyteYBWP+7Cy6KE8wEEXTTpyoGN9UVcXup
+Jrb2rlkmlIBi7rRssgW/uEnfTiNiCF5y90tpvdl0kHhuWU1Mx4+JqYFOjXi7IpCA
+kyObW4nZ0iZrxt5yVqi2r00FJChMWOrzuPtaQgELyJLHVSOjexegpPTv56dV+Eko
+Dvy40PsGxCmgUR8AEQEAAf4HAwLhaRlLy4u4Ff96uoRLTaN8TElz55OLBt4esjTl
+mefUVnYI/OBlTizBjtmOD0Rp6Sf5a94L0g/ZLI7OV9JXwFPKS8X2OjcoqwApzs5N
+X61Fp3JoH6i5lqh6qoTELaz6hPqeEM97oBdls6m808l76ztDnzFVXCOu41gGwev+
+/S7kdwi2+jx3OkL4P+a3PEU45IXc4vvRtby3gFAZ6yN0Kh/SES8wACTyXriJ8c5x
+LZ6+qtnAyMdMHf17YwCm3Sisr3+e6RTt4ruWRQjyp3gVsT9eTCqzuyUhQRh9vnjs
+XxjYPzxuo5MKyZXgZ3D+Wlp7RN1Tm/s8J5ug517oXlJEYEKVOz/MPSOwzkDF1skf
+A6K9pC/os5cf6gx1NqiasPGrd2GHRrg6qEe0g2xqVJPVnGZWb6u9RmJsJU8OH+yA
+z1v1/ZygdM2HOtwt/pZTpk4JBgGIPhnBQBZC5XBmcr0zVWXfRIyRhLUtL1QAGLqm
+bKodi3PqY4+p1+Qd9SAeG+y0OmfqAjghNikv2csehKG7S0DoCdQ0ku8YsTqzFLO7
+eR15sKJrFLhyerRwlE7WjCsQC2DXqDTFdIQkz9j0Jkmv2UTEzllmjK+jNcP4ieHX
+BSnft/lUvLVFIXP/5MTMbOruSRES2vtX7q7tv62Qc6KjCZKCH8ghk+1552ZdDkFb
+mNhai+XJ7JEClx85VjAmweh4XwqTHtCLsR2zHttEctb9jT1fAK3VNJWOqpni9/3G
+EvhDD0qVO69Fn002QlNhwDy0WxQpqH3kKeEb1/5/QnaF0xFz1nM48y7iG+ITUdoO
+tWUKxqVuw8yntk8Ngmkc8n0ebBKxLU0sDQViYSKGJOAS3htY5Dovq4KVDXxW+/iw
+83YLaivvDG3Gr16uysiHAvNnK91StWPOvKvtxE5ADw39mcMnOkCF1/q4qDafB3RG
++7bXrXPEuuYQ4CCFO6v+g0aHqQxFx/Cre3804CsIBg3yKN5AXxO6rJUcKTytC0zJ
+cJXDbZZV05CBDg3x+6xJn2kPk0oTe/uCSYN6xWPiJi4RjS9UL/ATir/2m4z7/o18
+rVUr1oZ8/HtJoPezfhNtJqqbDu+Q3DkqEfXLdBDMF71vT/0zUMvoE6l98VMAq6wm
+Phrk299mgr1EQOYTWKAnbXQ1gKh2JwegbJG738MwYtixkp6ITDPw71j5x/SYinHj
+WeTZ9sooufXyw6P7JhqRKrZbGRwbDAo4hCMJAyi2Z1VMuR7IH0tf5A4o46l91Izh
+9Z4RewlS5bto3TPhUGwfD+3wywjtiT7d/Xp/IgmhEkcXdsjBNlz4f9oVX/ZtsUj9
+BPRAeeRPcA2GgzFNFGf4iyidzgiEJlqIGbQScGxzdG9yZS10ZXN0cy1yY3B0iQHO
+BBMBCgA4FiEEAahVzTjV+MwdUQd1HBcSKC4CYkQFAmSB/poCGwMFCwkIBwIGFQoJ
+CAsCBBYCAwECHgECF4AACgkQHBcSKC4CYkRxmwv+OmFgU8JsBGZGj12/RBQu4wXw
+ryS2r5AJf6CpRCLD0ilEe5wX3zvJu1vpSyc79xTSvlXf/thRCHfgXw+m+IkY101r
+t2pVEBHgLC98ql0JDvY5dsd0S98bMgilULFGgSvfJYxY+Zlgf4jiWuo3b/43We4I
+bCXpF7C2356UrJEImZo7PC/wbsb4VUTUACLlaspoXByz0GrnvzpfQjmoZHLQlKtM
+N1EZnQLooxv/0CKmBRXD08rJrO46+wgTKKptxd5hgmCHnRIbmaP3I1nvNDKp1BIN
+UYJEsVNBEQuUsScHWXdbzb64zhyQvynad85tdP+srVcRTCJhiTJu7VAFgDvqXK8C
+Z6ApSvqwN9xaeuw4LjZi4TjA5Qd9SWUyP/TNtiqg8SsipjRvCeE7UfV7jA/W63uK
+gsbA48QY337Ob69bA5HQuBbsNd1oF74mlEd0q/sOog6hVxzT2FplOTJfUlNhQK6Q
+cwQ5HoiMOafI8WSDVaAgewjBfpQzhcd0LIK6oKzqnQWGBGSB/poBDADB9ioE+o8m
+fybEce2aGmq84ouwb5k3NHAt3+d4AcVQ+prCe4Hy2Exyk+iiDleAt6LX2sf2eS7+
+NZ1RsDSNS8iL5dwRwFoTc7cVa2sz6EPtHBpwwfdBaihzySxdKl4MEevr2skAcBJ7
+vC2ALhA02/987CRGxEs8/Zof63/NlMJHdL9Ektsl4dm6SiSijcJlikML6qA7DpN6
++l7SXk0ot1ATNKGMmmY5n3rpEu6yKKd8kNWxlrhlSDGPXPijBzyOElKG7vfuzaMb
+isxGBaIF44qbn24nwXxlSmiotJHsV+HfxoJaGIJwhd+BW35FFLgGLJ1F+TwUPhPn
+v+N0b4mtebBsMjwbyFCSGMkP7mMPtsNlTRaWlX0Fk5SR7eePhS2+wa/CfYPEOrwf
+5mpsu/65sAmIqBKuNz7xskuwCv5SJG9XdLYHbJcKxTQaJNOizHiRCLT2tHqLbF+B
+7kEZrm+uDWLUXOe8YZRVQltryuwtu7HeaNa1aOCXTgTfbC4E2/5myGEAEQEAAf4H
+AwKcZyirnVxOrP9hZNgnoid0GKAjq14dnwWifuTCJwQNpjoI9uMZigvvLmTlaRY9
+gl+yjSH/Y+aTyA7Ja/T6Oal8Wb60HF/RTtywDImVmbjXHNpzJ9tGrbNn8cgrHzrp
+njYByKnyE6P8LWmlAf1UBtMyDwGlJJKnLPomIgh4RAllLMEqXScb4j0TYtcpq/gF
+GHE271aL0+cHREBhaIED/B2RfWV1T1lY8T4FvppuGBy/EqrtiDTeEPhvJCgd3KYt
+5bFnktTkMxZCXZ4RFA7x7ad7DR1DoNHUb48lnSy0bjXjyDrFSIw9acdqrGt1ZiZh
+1Kyu3INC3itAKnWw0JWgXPVq3QCOtjXgEdPIiAxwmOvnskAMQGW43B/DPgnpOnch
+lP50KLXyudbvdAVdewjGiaC5/kQzQOEMlIdsnO0UB/6NtDqE5E8MUIfXtnkafDmA
+cP/8YwWlH73lo5bE6AVzAXqlyyq6lXo/BOqY44tDArXEeauZiUVPu3vtHb3YgGqh
+eTXz8NtDkWZsMQ9+ITDlj8hNsET+pa3sVE/FlzNQMLQwtUnjOA+wOW+lbfEjhr8/
+x1/TrF8cHaCeOuhWRl6yJNDN7PBtJ+AgAMxGaCiy/CcByAO38cSaDpLD37N2ZovN
+cgikbCNVsALM0ZbIr979OGmmWW2jK3trXBGvE4K1TUZuN9j/GG/q66dn7cIp9VJw
+I+XiAMCLKaxyAWEHqeqppvLsKcw/HAWkQ2pJsTpcCxj8famuUI9302lNOdg7SfLi
+FDtMVPdnMtzzZTHwTaklMzpEICex8BLOazGVjkp0CqnI6twjbvBJkViXQMRtttdJ
+P+r/hSfNDyhqVj0O4iiLo+S6GEpBQYJl/t0wln/NvgeQ2yNIj/vexDX910u1Emz2
+DqMtygfVYXB0ggEe7ueMBcRr+pIamIRiB2YLOp3NS4wLiizLjHgW3ObyD/aJmlrF
+dm4d1hXUm0Kgq3l2+V/9p8ZmUDqh/OE+IBanAvKSSnjoQgV3JIt9yagE3KCSayCC
+Tfxe0FW37Xl5C9cIkn/lgdacMDRwHUZp9MOr8UKO/tnmaBrKObWacumYrE/QQWF8
+gxlvZrssqMa09QpL7ZVqNwWRUZ+zICm/asLIYgwDZdmQIpkSEJPK+H3ymuZd2EVt
+9+8p+G+BgjSD8BqRZxa9I71xIMuEAjOVV5q99u2LwyDJHu8jIgzeCGPdJ7PBGn8+
+BkOVjjOrd/+jKokgPiiE8JmKaKKa/lLUwRgAcFSU4T6/JppThdGE250CzB50IKeg
+64UhH6hYlPyKCrW23UIZi+AtYQu4N4AeqsYs3yfQ0fFLgy7XoHdvJhJ1rMBD6Sw7
+4lhQ03uLm4kBtgQYAQoAIBYhBAGoVc041fjMHVEHdRwXEiguAmJEBQJkgf6aAhsM
+AAoJEBwXEiguAmJErL8L+waAJRvLggz1s+SznyV3iXqq9fOJ1ETbu13sJ0+KOih9
+pn5tbN9eDgH39wmiPw+wZTMiLu+LIy07gEMsVwjK6B9khX0lwXHgWCdEgj8le2c0
+0sQpUHEJx6wBwwu2mk4xbOSgU1Y5No8IRhJYC+fchWqOtJYAkBbpRkCPnlVwEoDn
+F4/S1u6hNBPM7MqJVIc07g9f1EiVOzO/XV5Jt8ngZr0BaCa9LHFCxIySH2nkOO2a
+kne+TS/brGRmyC4cKId5vf7aNKF7jePh3JSui9nAz6kqqWqCPQTPFN9wGNB9MPLs
+XoOU8ucjCNZ027S1z/QuDQvtJCfR1NICHxjg6UAII5gT/Xw9CGlj3AB/sOVI0khi
+9nWtI8j7kgmBA33fthuJWD9dXkLwpVr6c8NLH5oi7WHVAJM8Qz/QOZeIhF5+CF4K
+Vj5qqNBsZcSfMQLjAHwx+UeYPApR0Z2bXjSpcT1hTJVg2kwmKj7Ol6FvAgOyssCi
+5jMWmGXMiny7zfF86AKaOA==
+=VmVt
+-----END PGP PRIVATE KEY BLOCK-----
diff --git a/test/lisp/plstore-tests.el b/test/lisp/plstore-tests.el
new file mode 100644
index 00000000000..da1fe6163d5
--- /dev/null
+++ b/test/lisp/plstore-tests.el
@@ -0,0 +1,535 @@
+;;; plstore-tests.el --- Test suite for plstore.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Jens Schmidt <jschmidt4gnu@vodafonemail.de>
+;; Keywords: PGP, GnuPG
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These tests depend on EPG finding a usable GnuPG configuration with
+;; a sufficiently new GnuPG version, see `plstore-tests-set-up-epg'.
+;; If EPG cannot find any, this test suite skips all tests requiring
+;; GnuPG.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+(require 'ert-x)
+(require 'plstore)
+
+(defconst plstore-tests-recipient "plstore-tests-rcpt")
+
+(defconst plstore-tests-recipient-passphrase "plstore-tests-passphrase")
+
+\f
+
+;;; plist and alist handling.
+
+;; Return whether OBJECT is a valid plstore alist.  That is, a
+;; string-indexed alist of plists having keyword symbols as property
+;; names.
+(defun plstore-tests-alist-p (object)
+  (and (listp object)
+       (cl-every
+        (lambda (entry)
+          (and
+           (consp entry)
+           (stringp (car entry))
+           (listp (cdr entry))
+           (cl-loop
+            for member on (cdr entry) by #'cddr
+            for pname  = (car member)
+            for kwsymp = (and (symbolp pname)
+                              (eq (aref (symbol-name pname) 0) ?:))
+            unless kwsymp return nil
+            finally return t)))
+        object)))
+
+;; Sort PLIST in a stable manner and return the result as a new plist.
+;; Assume that all property names are symbols and default a missing
+;; trailing property value to nil.
+(defun plstore-tests-plist-sort (plist)
+  ;; Keep this readable instead of functional: Convert PLIST to an
+  ;; alist, sort that, and convert the sorted alist back to a plist.
+  (let (alist)
+    (setq alist
+          (cl-loop
+           for member on plist by #'cddr
+           collect (cons (symbol-name (car member)) (cadr member))))
+    (setq alist
+          (cl-stable-sort alist
+           #'string-lessp :key #'car))
+    (setq plist
+          (cl-loop
+           for (key . value) in alist
+           collect (intern key)
+           collect value))
+    plist))
+
+;; Sort plstore alist ALIST both on alist and on plist level.  Sort it
+;; in a stable manner on all levels and return the result as a new
+;; alist, without modifying ALIST.
+(defun plstore-tests-alist-sort (alist)
+  (cl-stable-sort
+   (mapcar
+    (lambda (entry)
+      (cons (car entry)
+            (plstore-tests-plist-sort (cdr entry))))
+    alist)
+   #'string-lessp :key #'car))
+
+;; Return whether ALIST is a plstore alist and whether it equals
+;; (after plstore-alist-sorting) REF-ALIST.
+(defun plstore-tests-alists-equal-p (alist ref-alist)
+  (and
+   (plstore-tests-alist-p alist)
+   (equal (plstore-tests-alist-sort alist) ref-alist)))
+
+\f
+
+;;; Passphrase handling.
+
+;; The items on this page care about:
+;;
+;; - Providing some response to loopbacked passphrase requests; and
+;;
+;; - tracking whether and which responses have been provided during
+;;   execution of some form.
+
+;; Response to provide to passphrase requests done through function
+;; `plstore-tests-handle-passphrase-request'.  One of:
+;;
+;; - `ok': provide the correct passphrase from
+;;   `plstore-tests-recipient-passphrase'
+;;
+;; - `wrong': provide an invalid (empty) passphrase
+;;
+;; - `quit': quit passphrase request with function `keyboard-quit'
+;;
+;; - any other symbol: signal an error
+;;
+;; Let-bound by macro `with-plstore-tests-passphrase' and (as default)
+;; by macro `with-plstore-tests'.
+(defvar plstore-tests-passphrase-response nil)
+
+;; History of passphrase responses provided through function
+;; `plstore-tests-handle-passphrase-request'.  This is a stack of
+;; stacks of the collected passphrase responses.
+(defvar plstore-tests-passphrase-history nil)
+
+;; Handle a passphrase request according to
+;; `plstore-tests-passphrase-response' and record the provided
+;; response in `plstore-tests-passphrase-history'.
+(defun plstore-tests-handle-passphrase-request ()
+  (push plstore-tests-passphrase-response
+        (car plstore-tests-passphrase-history))
+  (pcase plstore-tests-passphrase-response
+    ('ok    (copy-sequence plstore-tests-recipient-passphrase))
+    ('wrong "")
+    ('quit  (keyboard-quit))
+    (_      (error "Invalid passphrase request"))))
+
+;; Let-bind `plstore-tests-passphrase-response' to provide RESPONSE to
+;; all passphrase requests done during execution of BODY.  If
+;; PASSPHRASE-EXPECTED equals `no', ensure that no passphrases have
+;; been requested during execution of BODY, if it equals `yes', ensure
+;; that at least one passphrase has been requested, otherwise do not
+;; assume anything on the number of passphrase requests.
+;;
+;; This macro is mostly intended to test for *absence* of passphrase
+;; requests, since library `plstore' promises to use decryption and
+;; encryption (and, accordingly, to request passphrases) only when
+;; actually needed.
+;;
+;; This could be extended to track presence or absence of requests
+;; even more closely, but the rules when to expect requests and when
+;; not depend on agent caching and on encryption type, which would
+;; make such tests rather tricky.
+(cl-defmacro with-plstore-tests-passphrase ((&key
+                                             (response ''ok)
+                                             (passphrase-expected ''maybe))
+                                            &rest body)
+  (declare (indent 1) (debug (sexp body)))
+  `(unwind-protect
+       (let ((plstore-tests-passphrase-response ,response))
+         (push nil plstore-tests-passphrase-history)
+         ,@body
+         (when (eq ,passphrase-expected 'no)
+           (should (not (car plstore-tests-passphrase-history))))
+         (when (eq ,passphrase-expected 'yes)
+           (should (car plstore-tests-passphrase-history))))
+     (pop plstore-tests-passphrase-history)))
+
+\f
+
+;;; Test execution infrastructure.
+
+;; Create and return a new plstore test environment from TESTDIR.
+;;
+;; The test environment is a plist which gets successively filled by
+;; the setup functions below with the following members:
+;;
+;;   :status
+;;     Symbol describing environment status.  One of `initial',
+;;     `epg-set-up', `gpg-home-directory-set-up', `skip-tests'.
+;;   :skip-reason
+;;     String describing the reason for the tests to be skipped if
+;;     status equals `skip-tests', otherwise nil.
+;;   :epg-homedir, :epg-config, :epg-context
+;;     Self-explaining.
+;;
+;; The EPG configuration and context stored in the plstore test
+;; environment are used only for the key management done by this test
+;; suite, and not for the encryption and decryption operations done by
+;; plstore.  For these, plstore sets up its own EPG context mainly
+;; from `epg-gpg-home-directory' and `epg-pinentry-mode', which macro
+;; `with-plstore-tests' sets as needed.
+(defun plstore-tests-make-environment (testdir)
+  (list
+   :status      'initial
+   :skip-reason nil
+   :epg-homedir (expand-file-name ".gnupg" testdir)))
+
+;; Set up EPG, determine a usable GnuPG configuration, and store the
+;; resulting information in plstore test environment ENVIRONMENT.
+;;
+;; GnuPG 2.1.5 should already have a usable loopback pinentry (see
+;; Info node `(epa) GnuPG version compatibility)', but
+;; `epg-gpg2-minimum-version' mentions 2.1.6, so require that.
+(defun plstore-tests-set-up-epg (environment)
+  (if-let ((config (epg-find-configuration
+                    'OpenPGP nil
+                    '((OpenPGP epg-gpg-program
+                               ("gpg"  . "2.1.6")
+                               ("gpg2" . "2.1.6")))))
+           (context (epg-make-context 'OpenPGP)))
+      (progn
+        (setf (epg-context-program context)
+              (alist-get 'program config))
+        (setf (epg-context-home-directory context)
+              (plist-get environment :epg-homedir))
+        (setf (epg-context-pinentry-mode context) 'loopback)
+        (plist-put environment :epg-config  config)
+        (plist-put environment :epg-context context)
+        (plist-put environment :status     'epg-set-up))
+    (plist-put environment :status      'skip-tests)
+    (plist-put environment :skip-reason "no usable GnuPG configuration")))
+
+;; Set up a GnuPG home directory for our tests below the path pointed
+;; to by member `:epg-homedir' in plstore test environment
+;; ENVIRONMENT.  Use the predefined public and private key from the
+;; ERT resources to do so.  Perform a final encrypt-decrypt round-trip
+;; test.
+;;
+;; The keys used below have been created with GnuPG 2.2.7 and exported
+;; to the ERT resource directory as follows:
+;;
+;;   mkdir .gnupgtmphome && chmod 0700 .gnupgtmphome
+;;   echo plstore-tests-passphrase |
+;;   gpg --homedir .gnupgtmphome --quiet \
+;;       --pinentry-mode loopback --passphrase-fd 0 \
+;;       --quick-generate-key plstore-tests-rcpt default default 0
+;;   gpg --homedir .gnupgtmphome --quiet \
+;;       --armor --export plstore-tests-rcpt \
+;;       > test/lisp/plstore-resources/plstore-tests.pubkey
+;;   echo plstore-tests-passphrase |
+;;   gpg --homedir .gnupgtmphome --quiet \
+;;       --pinentry-mode loopback --passphrase-fd 0 \
+;;       --armor --export-secret-key plstore-tests-rcpt \
+;;       > test/lisp/plstore-resources/plstore-tests.seckey
+;;   rm -rf .gnupgtmphome
+(defun plstore-tests-set-up-gpg-home-directory (environment)
+  (let ((homedir (plist-get environment :epg-homedir))
+        (context (plist-get environment :epg-context))
+        key (state 0) timeout-timer)
+
+    ;; Create GnuPG home directory.
+    (make-directory homedir)
+    (set-file-modes homedir #o0700)
+
+    ;; Configure passphrase handling to some sane defaults, even if
+    ;; these should be already in effect as GnuPG agent defaults,
+    ;; since the GnuPG agent gets started anew for every new GnuPG
+    ;; home directory.
+    (with-temp-file (expand-file-name "gpg-agent.conf" homedir)
+      (insert "allow-loopback-pinentry\n")
+      (insert "default-cache-ttl 600\n")
+      (insert "max-cache-ttl 7200\n"))
+
+    ;; Import and configure keys.  This step, most notably the import
+    ;; of the private key, is expensive in terms of wall-clock time.
+    (setf (epg-context-passphrase-callback context)
+          '((lambda (_ _ _) (copy-sequence plstore-tests-recipient-passphrase))))
+    (epg-import-keys-from-file context (ert-resource-file "plstore-tests.pubkey"))
+    (epg-import-keys-from-file context (ert-resource-file "plstore-tests.seckey"))
+    (setq key (car-safe (epg-list-keys context plstore-tests-recipient)))
+    (cl-assert (cl-typep key 'epg-key))
+    ;; Trust first subkey of KEY ultimately.
+    (epg-edit-key
+     context key
+     (lambda (context status string _handback)
+       (pcase (vector state status string)
+         (`[0  "KEY_CONSIDERED" ,_])
+         ('[1  "GET_LINE" "keyedit.prompt"]
+          (process-send-string (epg-context-process context) "1\n"))
+         ('[2  "GOT_IT" ""])
+         ('[3  "GET_LINE" "keyedit.prompt"]
+          (process-send-string (epg-context-process context) "trust\n"))
+         ('[4  "GOT_IT" ""])
+         ('[5  "GET_LINE" "edit_ownertrust.value"]
+          (process-send-string (epg-context-process context) "5\n"))
+         ('[6  "GOT_IT" ""])
+         ('[7  "GET_BOOL" "edit_ownertrust.set_ultimate.okay"]
+          (process-send-string (epg-context-process context) "yes\n"))
+         ('[8  "GOT_IT" ""])
+         ('[9  "GET_LINE" "keyedit.prompt"]
+          (process-send-string (epg-context-process context) "quit\n"))
+         ('[10 "GOT_IT" ""])
+         (_
+          (error "Key edit protocol error in state %d" state)))
+       (setq state (1+ state)))
+     nil)
+
+    ;; Ensure an encrypt-decrypt round-trip works, in particular
+    ;; without hangs related to GnuPG 2.4.* and its bug T6481.
+    (unwind-protect
+        (progn
+          (setq timeout-timer
+                (run-at-time
+                 5 nil
+                 (lambda ()
+                   (when-let
+                       ((process (epg-context-process context))
+                        ((eq (process-status process) 'run)))
+                     (kill-process process)
+                     (plist-put environment :status      'skip-tests)
+                     (plist-put environment :skip-reason "GnuPG process timeout")))))
+          (pcase (condition-case err
+                     (equal
+                      (epg-decrypt-string
+                       context
+                       (epg-encrypt-string
+                        context "foobarbaz" (list key)))
+                      "foobarbaz")
+                   (error err))
+            ('t   (plist-put environment :status 'gpg-home-directory-set-up))
+            ('nil (plist-put environment :status      'skip-tests)
+                  (plist-put environment :skip-reason "GnuPG round-trip failure"))
+            (err  (unless (eq (plist-get environment :status) 'skip-tests)
+                    (plist-put environment :status      'skip-tests)
+                    (plist-put environment :skip-reason (error-message-string err))))))
+      (cancel-timer timeout-timer))))
+
+;; Set up plstore test environment and execute BODY.  Execute BODY
+;; with symmetric encryption if ENCRYPTION-TYPE equals `symmetric',
+;; with public-key encryption if ENCRYPTION-TYPE equals `public-key',
+;; otherwise execute BODY once for each of these encryption types.
+;;
+;; BODY can use the following lexical variables:
+;;
+;;   `plstore-encrypt-to'
+;;     Non-nil for public-key encryption, nil for symmetric
+;;     encryption.
+;;
+;;   `plstore-test-directory'
+;;     Points to a test directory which is removed after the test.
+;;     The test directory is initially empty except for the ".gnupg"
+;;     GnuPG home directory.
+;;
+;;   `plstore-test-file'
+;;     Points to a non-existent file below above directory.
+;;     Initialized to a different file name for each execution of
+;;     BODY.
+;;
+;;   `plstore'
+;;     Scratch variable initialized to nil for each execution of BODY.
+;;
+;; Any form in BODY that potentially requests a passphrase must be
+;; wrapped into an appropriate `with-plstore-tests-passphrase' macro.
+;; Passphrase requests done outside that macro result in an error
+;; being signaled.
+;;
+;; Test environment setup includes creation of a temporary GnuPG home
+;; directory and startup of a corresponding GnuPG agent, which is a
+;; somewhat expensive process in terms of wall-clock time.
+;;
+;; Started working off a similar macro and the test resources from
+;; epg-tests.el, but there is not much left from that, probably.
+(cl-defmacro with-plstore-tests ((&key encryption-type)
+                                 &rest body)
+  (declare (indent 1) (debug (sexp body)))
+  `(ert-with-temp-directory testdir
+     (let ((environment (plstore-tests-make-environment testdir)))
+       ;; Set up plstore test environment.
+       (when (eq (plist-get environment :status) 'initial)
+         (plstore-tests-set-up-epg environment))
+       (when (eq (plist-get environment :status) 'epg-set-up)
+         (plstore-tests-set-up-gpg-home-directory environment))
+       (when (eq (plist-get environment :status) 'skip-tests)
+         (ert-skip (format "EPG or GnuPG setup failed (%s)"
+                           (plist-get environment :skip-reason))))
+       (cl-assert (eq (plist-get environment :status)
+                      'gpg-home-directory-set-up))
+
+       (dolist (recipient
+                (pcase ,encryption-type
+                  ('symmetric  (list nil))
+                  ('public-key (list plstore-tests-recipient))
+                  (_           (list nil plstore-tests-recipient))))
+         (let (;; Silence plstore.
+               (inhibit-message t)
+               ;; Set up EPG (for use by plstore) and plstore itself.
+               (epg-gpg-home-directory (plist-get environment :epg-homedir))
+               (epg-pinentry-mode 'loopback)
+               (plstore-encrypt-to recipient)
+               (plstore-select-keys 'silent)
+               ;; Prepare these to detect passphrase requests done
+               ;; outside of any `with-plstore-tests-passphrase'
+               ;; macros.
+               (plstore-tests-passphrase-response 'error)
+               (plstore-tests-passphrase-history '(nil))
+               ;; Provide utility variables for BODY.
+               (plstore-test-directory testdir)
+               (plstore-test-file
+                (expand-file-name (if plstore-encrypt-to
+                                      (format "auth.%s.plist"
+                                              plstore-encrypt-to)
+                                    "auth.symmetric.plist")
+                                  testdir))
+               (plstore nil))
+           (cl-letf
+               (((symbol-function 'plstore-passphrase-callback-function)
+                 (lambda (_ _ _) (plstore-tests-handle-passphrase-request))))
+             ;; Silence byte compiler warnings related to unused
+             ;; lexical utility variables.
+             (when nil
+               (ignore plstore-test-directory
+                       plstore-test-file
+                       plstore))
+             ,@body)
+           (should (equal plstore-tests-passphrase-history '(nil))))))))
+
+\f
+
+;;; The tests!
+
+;; Ensure the test primitives work as intended.
+(ert-deftest plstore-primitives ()
+  ;; plstore-tests-alist-p
+  (should     (plstore-tests-alist-p nil))
+  (should-not (plstore-tests-alist-p 'foo))
+  (should-not (plstore-tests-alist-p '(foo)))
+  (should-not (plstore-tests-alist-p '((foo   . foo))))
+  (should-not (plstore-tests-alist-p '(("foo" . foo))))
+  (should-not (plstore-tests-alist-p '(("foo" . ("foo")))))
+  (should-not (plstore-tests-alist-p '(("foo" . (foo)))))
+  (should     (plstore-tests-alist-p '(("foo" . (:foo)))))
+  ;; plstore-tests-plist-sort
+  (should (equal (plstore-tests-plist-sort nil) nil))
+  (should (equal (plstore-tests-plist-sort '(:foo "foo")) '(:foo "foo")))
+  (should (equal (plstore-tests-plist-sort '(:foo "foo" :bar "bar")) '(:bar "bar" :foo "foo")))
+  (let* ((plist '(:foo "foo" :baz "baz" :bar "bar"))
+         (cars  (copy-sequence plist))
+         (cdrs  (cl-maplist #'identity plist)))
+    (plstore-tests-plist-sort plist)
+    (should (and (cl-every #'eq plist cars)
+                 (cl-every #'eq (cl-maplist #'identity plist) cdrs))))
+  ;; plstore-tests-alist-sort
+  (should (equal (plstore-tests-alist-sort nil) nil))
+  (should (equal (plstore-tests-alist-sort '(("foo"))) '(("foo"))))
+  (should (equal (plstore-tests-alist-sort '(("foo") ("bar"))) '(("bar") ("foo"))))
+  (should (equal (plstore-tests-alist-sort
+                  '(("foo" . (:foo "foo"))
+                    ("baz" . (:foo "foo" :baz "baz" :bar "bar"))
+                    ("bar" . (:foo "foo" :bar "bar"))))
+                 '(("bar"  . (:bar "bar" :foo "foo"))
+                   ("baz"  . (:bar "bar" :baz "baz" :foo "foo"))
+                   ("foo"  . (:foo "foo")))))
+  (let* ((alist '(("foo") ("baz") ("bar")))
+         (cars  (copy-sequence alist))
+         (cdrs  (cl-maplist #'identity alist)))
+    (plstore-tests-alist-sort alist)
+    (should (and (cl-every #'eq alist cars)
+                 (cl-every #'eq (cl-maplist #'identity alist) cdrs)))))
+
+;; Ensure passphrase handling works as intended.
+(ert-deftest plstore-passphrase-handling ()
+  (with-plstore-tests-passphrase (:passphrase-expected 'maybe)
+    (should (string= (plstore-tests-handle-passphrase-request)
+                     plstore-tests-recipient-passphrase)))
+  (with-plstore-tests-passphrase (:response 'ok
+                                  :passphrase-expected 'maybe)
+    (should (string= (plstore-tests-handle-passphrase-request)
+                     plstore-tests-recipient-passphrase)))
+  (with-plstore-tests-passphrase (:response 'wrong
+                                  :passphrase-expected 'maybe)
+    (should (string= (plstore-tests-handle-passphrase-request) "")))
+  (with-plstore-tests-passphrase (:response 'quit
+                                  :passphrase-expected 'maybe)
+    (should (condition-case nil
+                (plstore-tests-handle-passphrase-request)
+              (quit t) (:success nil))))
+  (with-plstore-tests-passphrase (:passphrase-expected 'no))
+  (with-plstore-tests-passphrase (:response 'ok
+                                  :passphrase-expected 'yes)
+    (plstore-tests-handle-passphrase-request)))
+
+;; Ensure the examples from the plstore.el header come through without
+;; errors.
+(ert-deftest plstore-example-01 ()
+  (with-plstore-tests (:encryption-type 'both)
+    (setq plstore (plstore-open plstore-test-file))
+    (plstore-put plstore "foo" '(:host "foo.example.org" :port 80) nil)
+    (plstore-save plstore)
+    (plstore-put plstore "bar" '(:host "bar.example.org") '(:user "test"))
+    (plstore-put plstore "baz" '(:host "baz.example.org") '(:password "test"))
+    ;; symmetric encryption: 'yes
+    ;; public-key encryption: 'no
+    (with-plstore-tests-passphrase (:passphrase-expected 'maybe)
+      (plstore-save plstore))
+    (plstore-close plstore)
+
+    (should
+     (> (file-attribute-size (file-attributes plstore-test-file)) 0))
+
+    (setq plstore (plstore-open plstore-test-file))
+    (should
+     (plstore-tests-alists-equal-p
+      (plstore-find plstore '(:host ("foo.example.org")))
+      '(("foo" . (:host "foo.example.org" :port 80)))))
+    ;; symmetric decryption: 'no (agent cache)
+    ;; public-key decryption: 'yes
+    (with-plstore-tests-passphrase (:passphrase-expected 'maybe)
+      (should
+       (plstore-tests-alists-equal-p
+        (plstore-find plstore '(:host ("bar.example.org")))
+        '(("bar" . (:host "bar.example.org" :user "test"))))))
+    ;; symmetric decryption: 'no (agent cache)
+    ;; public-key decryption: 'no (agent cache)
+    (with-plstore-tests-passphrase (:passphrase-expected 'no)
+      (should
+       (plstore-tests-alists-equal-p
+        (plstore-find plstore '(:host ("baz.example.org")))
+        '(("baz" . (:host "baz.example.org" :password "test"))))))
+    (plstore-close plstore)))
+
+(provide 'plstore-tests)
+
+;;; plstore-tests.el ends here
-- 
2.30.2