(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)
(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
&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")
(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 "\
-----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)
(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)
(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)
(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)
(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)))))
projects / emacs.git / commitdiff