procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

epg: Add a way to detect gpg1 executable for tests

Browse source 
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 2016-05-19 18:05:19 +09:00
parent ebc3a94e27
commit d4ae6d7033
2 changed files with 70 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

80
lisp/epg-config.el
View file

@ -81,57 +81,69 @@ Note that the buffer name starts with a space."
(defconst epg-config--program-alist (defconst epg-config--program-alist
'((OpenPGP '((OpenPGP
epg-gpg-program epg-gpg-program
epg-config--make-gpg-configuration
("gpg2" . "2.1.6") ("gpg" . "1.4.3")) ("gpg2" . "2.1.6") ("gpg" . "1.4.3"))
(CMS (CMS
epg-gpgsm-program epg-gpgsm-program
epg-config--make-gpgsm-configuration
("gpgsm" . "2.0.4"))) ("gpgsm" . "2.0.4")))
"Alist used to obtain the usable configuration of executables. "Alist used to obtain the usable configuration of executables.
The first element of each entry is protocol symbol, which is The first element of each entry is protocol symbol, which is
either `OpenPGP' or `CMS'. The second element is a symbol where either `OpenPGP' or `CMS'. The second element is a symbol where
the executable name is remembered. The third element is a the executable name is remembered. The rest of the entry is an
function which constructs a configuration object (actually a alist mapping executable names to the minimum required version
plist). The rest of the entry is an alist mapping executable suitable for the use with Emacs.")
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) (defvar epg--configurations nil)
;;;###autoload ;;;###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. "Find or create a usable configuration to handle PROTOCOL.
This function first looks at the existing configuration found by 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 Then it walks through PROGRAM-ALIST or
`epg-gpg-program' or `epg-gpgsm-program' is already set with `epg-config--program-alist'. If `epg-gpg-program' or
custom, use it. Otherwise, it tries the programs listed in the `epg-gpgsm-program' is already set with custom, use it.
entry until the version requirement is met." Otherwise, it tries the programs listed in the entry until the
(let ((entry (assq protocol epg-config--program-alist))) version requirement is met."
(unless program-alist
(setq program-alist epg-config--program-alist))
(let ((entry (assq protocol program-alist)))
(unless entry (unless entry
(error "Unknown protocol %S" protocol)) (error "Unknown protocol %S" protocol))
(cl-destructuring-bind (symbol constructor . alist) (cl-destructuring-bind (symbol . alist)
(cdr entry) (cdr entry)
(or (and (not force) (alist-get protocol epg--configurations)) (let ((constructor
;; If the executable value is already set with M-x (alist-get protocol epg-config--configuration-constructor-alist)))
;; customize, use it without checking. (or (and (not no-cache) (alist-get protocol epg--configurations))
(if (get symbol 'saved-value) ;; If the executable value is already set with M-x
(let ((configuration (funcall constructor (symbol-value symbol)))) ;; customize, use it without checking.
(push (cons protocol configuration) epg--configurations) (if (and symbol (get symbol 'saved-value))
configuration) (let ((configuration
(catch 'found (funcall constructor (symbol-value symbol))))
(dolist (program-version alist) (push (cons protocol configuration) epg--configurations)
(let ((executable (executable-find (car program-version)))) configuration)
(when executable (catch 'found
(let ((configuration (dolist (program-version alist)
(funcall constructor executable))) (let ((executable (executable-find (car program-version))))
(when (ignore-errors (when executable
(epg-check-configuration configuration (let ((configuration
(cdr program-version)) (funcall constructor executable)))
t) (when (ignore-errors
(push (cons protocol configuration) epg--configurations) (epg-check-configuration configuration
(throw 'found 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. ;; Create an `epg-configuration' object for `gpg', using PROGRAM.
(defun epg-config--make-gpg-configuration (program) (defun epg-config--make-gpg-configuration (program)

42
test/automated/epg-tests.el
View file

@ -30,16 +30,17 @@
(expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY")) (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY"))
"Directory containing epg test data.") "Directory containing epg test data.")
(defun epg-tests-gpg-usable (&optional require-passphrase) (defconst epg-tests-program-alist-for-passphrase-callback
(and (executable-find epg-gpg-program) '((OpenPGP
(condition-case nil nil
(progn ("gpg" . "1.4.3"))))
(epg-check-configuration (epg-configuration))
(if require-passphrase (defun epg-tests-find-usable-gpg-configuration (&optional require-passphrase)
(string-match "\\`1\\." (epg-find-configuration
(cdr (assq 'version (epg-configuration)))) 'OpenPGP
t)) 'no-cache
(error nil)))) (if require-passphrase
epg-tests-program-alist-for-passphrase-callback)))
(defun epg-tests-passphrase-callback (_c _k _d) (defun epg-tests-passphrase-callback (_c _k _d)
;; Need to create a copy here, since the string will be wiped out ;; Need to create a copy here, since the string will be wiped out
@ -52,9 +53,14 @@
&rest body) &rest body)
"Set up temporary locations and variables for testing." "Set up temporary locations and variables for testing."
(declare (indent 1)) (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 (unwind-protect
(let ((context (epg-make-context 'OpenPGP))) (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) (setf (epg-context-home-directory context)
epg-tests-home-directory) epg-tests-home-directory)
(setenv "GPG_AGENT_INFO") (setenv "GPG_AGENT_INFO")
@ -78,7 +84,7 @@
(delete-directory epg-tests-home-directory t))))) (delete-directory epg-tests-home-directory t)))))
(ert-deftest epg-decrypt-1 () (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) (with-epg-tests (:require-passphrase t)
(should (equal "test" (should (equal "test"
(epg-decrypt-string epg-tests-context "\ (epg-decrypt-string epg-tests-context "\
@ -90,14 +96,14 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
-----END PGP MESSAGE-----"))))) -----END PGP MESSAGE-----")))))
(ert-deftest epg-roundtrip-1 () (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) (with-epg-tests (:require-passphrase t)
(let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil))) (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil)))
(should (equal "symmetric" (should (equal "symmetric"
(epg-decrypt-string epg-tests-context cipher)))))) (epg-decrypt-string epg-tests-context cipher))))))
(ert-deftest epg-roundtrip-2 () (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 (with-epg-tests (:require-passphrase t
:require-public-key t :require-public-key t
:require-secret-key t) :require-secret-key t)
@ -108,7 +114,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
(epg-decrypt-string epg-tests-context cipher)))))) (epg-decrypt-string epg-tests-context cipher))))))
(ert-deftest epg-sign-verify-1 () (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 (with-epg-tests (:require-passphrase t
:require-public-key t :require-public-key t
:require-secret-key t) :require-secret-key t)
@ -122,7 +128,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
(should (eq 'good (epg-signature-status (car verify-result))))))) (should (eq 'good (epg-signature-status (car verify-result)))))))
(ert-deftest epg-sign-verify-2 () (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 (with-epg-tests (:require-passphrase t
:require-public-key t :require-public-key t
:require-secret-key t) :require-secret-key t)
@ -138,7 +144,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
(should (eq 'good (epg-signature-status (car verify-result))))))) (should (eq 'good (epg-signature-status (car verify-result)))))))
(ert-deftest epg-sign-verify-3 () (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 (with-epg-tests (:require-passphrase t
:require-public-key t :require-public-key t
:require-secret-key t) :require-secret-key t)
@ -153,7 +159,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
(should (eq 'good (epg-signature-status (car verify-result))))))) (should (eq 'good (epg-signature-status (car verify-result)))))))
(ert-deftest epg-import-1 () (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) (with-epg-tests (:require-passphrase nil)
(should (= 0 (length (epg-list-keys epg-tests-context)))) (should (= 0 (length (epg-list-keys epg-tests-context))))
(should (= 0 (length (epg-list-keys epg-tests-context nil t))))) (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))