mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-26 07:33:47 +00:00
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.
This commit is contained in:
Daiki Ueno
parent
ebc3a94e27
commit
d4ae6d7033
@ -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.
|
||||
the previous invocation of this function, unless NO-CACHE 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)))
|
||||
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)
|
||||
|
||||
@ -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)))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user