From 3b8d629d7b3ab638e164ce292b6ba6300e9de740 Mon Sep 17 00:00:00 2001 From: Jens Schmidt Date: Wed, 16 Aug 2023 23:42:11 +0200 Subject: [PATCH 2/2] 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 +;; 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 . + +;;; 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") + + + +;;; 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))) + + + +;;; 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))) + + + +;;; 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)))))))) + + + +;;; 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