Make GnuPG version check robuster

We changed the default gpg program to "gpg2" from "gpg" in the commit
f93d669a16bd3cb3f43f0c8cfd22fe18b627a6a1.  However, there are two
maintained branches (2.0 and 2.1) and Emacs doesn't work well with 2.0
series.  Check the actual version of "gpg2" at run time, and properly
divert to "gpg" if necessary.
* lisp/epg-config.el: Require 'cl-lib for `cl-destructuring-bind'.
(epg-config--program-alist): New variable.
(epg--configurations): New variable.
(epg-configuration-find): New function.
(epg-config--make-gpg-configuration): New function.
(epg-config--make-gpgsm-configuration): New function.
(epg-configuration): Mark as obsolete.
* lisp/epg.el (epg-context): Use `epg-configuration-find'.

diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index c41d97dbfacbd1d8c9ee98de17060be1f59e373b..17364563e8bcf94c072ba0eda34c3f3abb7ed0e6 100644 (file)
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -23,6 +23,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl-lib))
+
 (defconst epg-package-name "epg"
   "Name of this package.")
 
@@ -76,12 +78,67 @@ Note that the buffer name starts with a space."
 
 (defconst epg-gpg-minimum-version "1.4.3")
 
+(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.")
+
+(defvar epg--configurations nil)
+
 ;;;###autoload
-(defun epg-configuration ()
-  "Return a list of internal configuration parameters of `epg-gpg-program'."
+(defun epg-configuration-find (protocol &optional force)
+  "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)))
+    (unless entry
+      (error "Unknown protocol %S" protocol))
+    (cl-destructuring-bind (symbol constructor . alist)
+        (cdr entry)
+      (or (and (not force) (alist-get protocol epg--configurations))
+          (let ((executable (get symbol 'saved-value)))
+            (if executable
+                (ignore-errors
+                  (let ((configuration (funcall constructor executable)))
+                    (epg-check-configuration configuration)
+                    (push (cons protocol configuration) epg--configurations)
+                    configuration))
+              (catch 'found
+                (dolist (program-version alist)
+                  (setq 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))))))))))))
+
+;; Create an `epg-configuration' object for `gpg', using PROGRAM.
+(defun epg-config--make-gpg-configuration (program)
   (let (config groups type args)
     (with-temp-buffer
-      (apply #'call-process epg-gpg-program nil (list t nil) nil
+      (apply #'call-process program nil (list t nil) nil
             (append (if epg-gpg-home-directory
                         (list "--homedir" epg-gpg-home-directory))
                     '("--with-colons" "--list-config")))
@@ -113,10 +170,30 @@ Note that the buffer name starts with a space."
                         type args))))
         (t
          (setq config (cons (cons type args) config))))))
+    (push (cons 'program program) config)
     (if groups
        (cons (cons 'groups groups) config)
       config)))
 
+;; Create an `epg-configuration' object for `gpgsm', using PROGRAM.
+(defun epg-config--make-gpgsm-configuration (program)
+  (with-temp-buffer
+    (call-process program nil (list t nil) nil "--version")
+    (goto-char (point-min))
+    (when (looking-at "\\S-+ (")
+      (goto-char (match-end 0))
+      (backward-char)
+      (forward-sexp)
+      (skip-syntax-forward "-" (point-at-eol))
+      (list (cons 'program program)
+            (cons 'version (buffer-substring (point) (point-at-eol)))))))
+
+;;;###autoload
+(defun epg-configuration ()
+  "Return a list of internal configuration parameters of `epg-gpg-program'."
+  (declare (obsolete epg-configuration-find "25.1"))
+  (epg-config--make-gpg-configuration epg-gpg-program))
+
 (defun epg-config--parse-version (string)
   (let ((index 0)
        version)

diff --git a/lisp/epg.el b/lisp/epg.el
index 1f9db23478c72622e00c623fa1a1a1d91d52830a..1a18ab2a52afd92aba052848d73af5b0e90ca20c 100644 (file)
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -186,11 +186,11 @@
                           compress-algorithm
                  &aux
                  (program
-                  (pcase protocol
-                    (`OpenPGP epg-gpg-program)
-                    (`CMS epg-gpgsm-program)
-                    (_ (signal 'epg-error
-                               (list "unknown protocol" protocol)))))))
+                  (let ((configuration (epg-configuration-find protocol)))
+                    (unless configuration
+                      (signal 'epg-error
+                              (list "no usable configuration" protocol)))
+                    (alist-get 'program configuration)))))
                (:copier nil)
                (:predicate nil))
   protocol