From: Daiki Ueno Date: Thu, 19 May 2016 09:05:19 +0000 (+0900) Subject: epg: Add a way to detect gpg1 executable for tests X-Git-Tag: emacs-25.0.95~68 X-Git-Url: https://code.delx.au/gnu-emacs/commitdiff_plain/d4ae6d7033b34e8b75c59aaf1584131e439ef2d5 epg: Add a way to detect gpg1 executable for tests Fixes bug#23561. * test/automated/epg-tests.el (epg-tests-program-alist-for-passphrase-callback): New constant. (epg-tests-find-usable-gpg-configuration): New function, renamed from `epg-tests-gpg-usable'. All callers changed. (epg-tests-gpg-usable): Remove. * lisp/epg-config.el (epg-config--program-alist): Factor out constructor element to... (epg-config--configuration-constructor-alist): ...here. (epg-find-configuration): Rename FORCE argument to NO-CACHE, and add PROGRAM-ALIST argument. --- diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 8a208044cb..9179e04dcc 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -81,57 +81,69 @@ Note that the buffer name starts with a space." (defconst epg-config--program-alist '((OpenPGP epg-gpg-program - epg-config--make-gpg-configuration ("gpg2" . "2.1.6") ("gpg" . "1.4.3")) (CMS epg-gpgsm-program - epg-config--make-gpgsm-configuration ("gpgsm" . "2.0.4"))) "Alist used to obtain the usable configuration of executables. The first element of each entry is protocol symbol, which is either `OpenPGP' or `CMS'. The second element is a symbol where -the executable name is remembered. The third element is a -function which constructs a configuration object (actually a -plist). The rest of the entry is an alist mapping executable -names to the minimum required version suitable for the use with -Emacs.") +the executable name is remembered. The rest of the entry is an +alist mapping executable names to the minimum required version +suitable for the use with Emacs.") + +(defconst epg-config--configuration-constructor-alist + '((OpenPGP . epg-config--make-gpg-configuration) + (CMS . epg-config--make-gpgsm-configuration)) + "Alist used to obtain the usable configuration of executables. +The first element of each entry is protocol symbol, which is +either `OpenPGP' or `CMS'. The second element is a function +which constructs a configuration object (actually a plist).") (defvar epg--configurations nil) ;;;###autoload -(defun epg-find-configuration (protocol &optional force) +(defun epg-find-configuration (protocol &optional no-cache program-alist) "Find or create a usable configuration to handle PROTOCOL. This function first looks at the existing configuration found by -the previous invocation of this function, unless FORCE is non-nil. - -Then it walks through `epg-config--program-alist'. If -`epg-gpg-program' or `epg-gpgsm-program' is already set with -custom, use it. Otherwise, it tries the programs listed in the -entry until the version requirement is met." - (let ((entry (assq protocol epg-config--program-alist))) +the previous invocation of this function, unless NO-CACHE is non-nil. + +Then it walks through PROGRAM-ALIST or +`epg-config--program-alist'. If `epg-gpg-program' or +`epg-gpgsm-program' is already set with custom, use it. +Otherwise, it tries the programs listed in the entry until the +version requirement is met." + (unless program-alist + (setq program-alist epg-config--program-alist)) + (let ((entry (assq protocol program-alist))) (unless entry (error "Unknown protocol %S" protocol)) - (cl-destructuring-bind (symbol constructor . alist) + (cl-destructuring-bind (symbol . alist) (cdr entry) - (or (and (not force) (alist-get protocol epg--configurations)) - ;; If the executable value is already set with M-x - ;; customize, use it without checking. - (if (get symbol 'saved-value) - (let ((configuration (funcall constructor (symbol-value symbol)))) - (push (cons protocol configuration) epg--configurations) - configuration) - (catch 'found - (dolist (program-version alist) - (let ((executable (executable-find (car program-version)))) - (when executable - (let ((configuration - (funcall constructor executable))) - (when (ignore-errors - (epg-check-configuration configuration - (cdr program-version)) - t) - (push (cons protocol configuration) epg--configurations) - (throw 'found configuration)))))))))))) + (let ((constructor + (alist-get protocol epg-config--configuration-constructor-alist))) + (or (and (not no-cache) (alist-get protocol epg--configurations)) + ;; If the executable value is already set with M-x + ;; customize, use it without checking. + (if (and symbol (get symbol 'saved-value)) + (let ((configuration + (funcall constructor (symbol-value symbol)))) + (push (cons protocol configuration) epg--configurations) + configuration) + (catch 'found + (dolist (program-version alist) + (let ((executable (executable-find (car program-version)))) + (when executable + (let ((configuration + (funcall constructor executable))) + (when (ignore-errors + (epg-check-configuration configuration + (cdr program-version)) + t) + (unless no-cache + (push (cons protocol configuration) + epg--configurations)) + (throw 'found configuration))))))))))))) ;; Create an `epg-configuration' object for `gpg', using PROGRAM. (defun epg-config--make-gpg-configuration (program) diff --git a/test/automated/epg-tests.el b/test/automated/epg-tests.el index 4a317974ef..d51ab23f71 100644 --- a/test/automated/epg-tests.el +++ b/test/automated/epg-tests.el @@ -30,16 +30,17 @@ (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY")) "Directory containing epg test data.") -(defun epg-tests-gpg-usable (&optional require-passphrase) - (and (executable-find epg-gpg-program) - (condition-case nil - (progn - (epg-check-configuration (epg-configuration)) - (if require-passphrase - (string-match "\\`1\\." - (cdr (assq 'version (epg-configuration)))) - t)) - (error nil)))) +(defconst epg-tests-program-alist-for-passphrase-callback + '((OpenPGP + nil + ("gpg" . "1.4.3")))) + +(defun epg-tests-find-usable-gpg-configuration (&optional require-passphrase) + (epg-find-configuration + 'OpenPGP + 'no-cache + (if require-passphrase + epg-tests-program-alist-for-passphrase-callback))) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out @@ -52,9 +53,14 @@ &rest body) "Set up temporary locations and variables for testing." (declare (indent 1)) - `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t))) + `(let ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t))) (unwind-protect (let ((context (epg-make-context 'OpenPGP))) + (setf (epg-context-program context) + (alist-get 'program + (epg-tests-find-usable-gpg-configuration + ,(if require-passphrase + `'require-passphrase)))) (setf (epg-context-home-directory context) epg-tests-home-directory) (setenv "GPG_AGENT_INFO") @@ -78,7 +84,7 @@ (delete-directory epg-tests-home-directory t))))) (ert-deftest epg-decrypt-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t) (should (equal "test" (epg-decrypt-string epg-tests-context "\ @@ -90,14 +96,14 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== -----END PGP MESSAGE-----"))))) (ert-deftest epg-roundtrip-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t) (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil))) (should (equal "symmetric" (epg-decrypt-string epg-tests-context cipher)))))) (ert-deftest epg-roundtrip-2 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -108,7 +114,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (epg-decrypt-string epg-tests-context cipher)))))) (ert-deftest epg-sign-verify-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -122,7 +128,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-sign-verify-2 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -138,7 +144,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-sign-verify-3 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -153,7 +159,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-import-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase nil) (should (= 0 (length (epg-list-keys epg-tests-context)))) (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))