diff options
| -rw-r--r-- | lisp/epg-config.el | 83 | ||||
| -rw-r--r-- | lisp/epg.el | 10 |
2 files changed, 85 insertions, 8 deletions
diff --git a/lisp/epg-config.el b/lisp/epg-config.el index c41d97dbfac..17364563e8b 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el | |||
| @@ -23,6 +23,8 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | (eval-when-compile (require 'cl-lib)) | ||
| 27 | |||
| 26 | (defconst epg-package-name "epg" | 28 | (defconst epg-package-name "epg" |
| 27 | "Name of this package.") | 29 | "Name of this package.") |
| 28 | 30 | ||
| @@ -76,12 +78,67 @@ Note that the buffer name starts with a space." | |||
| 76 | 78 | ||
| 77 | (defconst epg-gpg-minimum-version "1.4.3") | 79 | (defconst epg-gpg-minimum-version "1.4.3") |
| 78 | 80 | ||
| 81 | (defconst epg-config--program-alist | ||
| 82 | '((OpenPGP | ||
| 83 | epg-gpg-program | ||
| 84 | epg-config--make-gpg-configuration | ||
| 85 | ("gpg2" . "2.1.6") ("gpg" . "1.4.3")) | ||
| 86 | (CMS | ||
| 87 | epg-gpgsm-program | ||
| 88 | epg-config--make-gpgsm-configuration | ||
| 89 | ("gpgsm" . "2.0.4"))) | ||
| 90 | "Alist used to obtain the usable configuration of executables. | ||
| 91 | The first element of each entry is protocol symbol, which is | ||
| 92 | either `OpenPGP' or `CMS'. The second element is a symbol where | ||
| 93 | the executable name is remembered. The third element is a | ||
| 94 | function which constructs a configuration object (actually a | ||
| 95 | plist). The rest of the entry is an alist mapping executable | ||
| 96 | names to the minimum required version suitable for the use with | ||
| 97 | Emacs.") | ||
| 98 | |||
| 99 | (defvar epg--configurations nil) | ||
| 100 | |||
| 79 | ;;;###autoload | 101 | ;;;###autoload |
| 80 | (defun epg-configuration () | 102 | (defun epg-configuration-find (protocol &optional force) |
| 81 | "Return a list of internal configuration parameters of `epg-gpg-program'." | 103 | "Find or create a usable configuration to handle PROTOCOL. |
| 104 | This function first looks at the existing configuration found by | ||
| 105 | the previous invocation of this function, unless FORCE is non-nil. | ||
| 106 | |||
| 107 | Then it walks through `epg-config--program-alist'. If | ||
| 108 | `epg-gpg-program' or `epg-gpgsm-program' is already set with | ||
| 109 | custom, use it. Otherwise, it tries the programs listed in the | ||
| 110 | entry until the version requirement is met." | ||
| 111 | (let ((entry (assq protocol epg-config--program-alist))) | ||
| 112 | (unless entry | ||
| 113 | (error "Unknown protocol %S" protocol)) | ||
| 114 | (cl-destructuring-bind (symbol constructor . alist) | ||
| 115 | (cdr entry) | ||
| 116 | (or (and (not force) (alist-get protocol epg--configurations)) | ||
| 117 | (let ((executable (get symbol 'saved-value))) | ||
| 118 | (if executable | ||
| 119 | (ignore-errors | ||
| 120 | (let ((configuration (funcall constructor executable))) | ||
| 121 | (epg-check-configuration configuration) | ||
| 122 | (push (cons protocol configuration) epg--configurations) | ||
| 123 | configuration)) | ||
| 124 | (catch 'found | ||
| 125 | (dolist (program-version alist) | ||
| 126 | (setq executable (executable-find (car program-version))) | ||
| 127 | (when executable | ||
| 128 | (let ((configuration | ||
| 129 | (funcall constructor executable))) | ||
| 130 | (when (ignore-errors | ||
| 131 | (epg-check-configuration configuration | ||
| 132 | (cdr program-version)) | ||
| 133 | t) | ||
| 134 | (push (cons protocol configuration) epg--configurations) | ||
| 135 | (throw 'found configuration)))))))))))) | ||
| 136 | |||
| 137 | ;; Create an `epg-configuration' object for `gpg', using PROGRAM. | ||
| 138 | (defun epg-config--make-gpg-configuration (program) | ||
| 82 | (let (config groups type args) | 139 | (let (config groups type args) |
| 83 | (with-temp-buffer | 140 | (with-temp-buffer |
| 84 | (apply #'call-process epg-gpg-program nil (list t nil) nil | 141 | (apply #'call-process program nil (list t nil) nil |
| 85 | (append (if epg-gpg-home-directory | 142 | (append (if epg-gpg-home-directory |
| 86 | (list "--homedir" epg-gpg-home-directory)) | 143 | (list "--homedir" epg-gpg-home-directory)) |
| 87 | '("--with-colons" "--list-config"))) | 144 | '("--with-colons" "--list-config"))) |
| @@ -113,10 +170,30 @@ Note that the buffer name starts with a space." | |||
| 113 | type args)))) | 170 | type args)))) |
| 114 | (t | 171 | (t |
| 115 | (setq config (cons (cons type args) config)))))) | 172 | (setq config (cons (cons type args) config)))))) |
| 173 | (push (cons 'program program) config) | ||
| 116 | (if groups | 174 | (if groups |
| 117 | (cons (cons 'groups groups) config) | 175 | (cons (cons 'groups groups) config) |
| 118 | config))) | 176 | config))) |
| 119 | 177 | ||
| 178 | ;; Create an `epg-configuration' object for `gpgsm', using PROGRAM. | ||
| 179 | (defun epg-config--make-gpgsm-configuration (program) | ||
| 180 | (with-temp-buffer | ||
| 181 | (call-process program nil (list t nil) nil "--version") | ||
| 182 | (goto-char (point-min)) | ||
| 183 | (when (looking-at "\\S-+ (") | ||
| 184 | (goto-char (match-end 0)) | ||
| 185 | (backward-char) | ||
| 186 | (forward-sexp) | ||
| 187 | (skip-syntax-forward "-" (point-at-eol)) | ||
| 188 | (list (cons 'program program) | ||
| 189 | (cons 'version (buffer-substring (point) (point-at-eol))))))) | ||
| 190 | |||
| 191 | ;;;###autoload | ||
| 192 | (defun epg-configuration () | ||
| 193 | "Return a list of internal configuration parameters of `epg-gpg-program'." | ||
| 194 | (declare (obsolete epg-configuration-find "25.1")) | ||
| 195 | (epg-config--make-gpg-configuration epg-gpg-program)) | ||
| 196 | |||
| 120 | (defun epg-config--parse-version (string) | 197 | (defun epg-config--parse-version (string) |
| 121 | (let ((index 0) | 198 | (let ((index 0) |
| 122 | version) | 199 | version) |
diff --git a/lisp/epg.el b/lisp/epg.el index 1f9db23478c..1a18ab2a52a 100644 --- a/lisp/epg.el +++ b/lisp/epg.el | |||
| @@ -186,11 +186,11 @@ | |||
| 186 | compress-algorithm | 186 | compress-algorithm |
| 187 | &aux | 187 | &aux |
| 188 | (program | 188 | (program |
| 189 | (pcase protocol | 189 | (let ((configuration (epg-configuration-find protocol))) |
| 190 | (`OpenPGP epg-gpg-program) | 190 | (unless configuration |
| 191 | (`CMS epg-gpgsm-program) | 191 | (signal 'epg-error |
| 192 | (_ (signal 'epg-error | 192 | (list "no usable configuration" protocol))) |
| 193 | (list "unknown protocol" protocol))))))) | 193 | (alist-get 'program configuration))))) |
| 194 | (:copier nil) | 194 | (:copier nil) |
| 195 | (:predicate nil)) | 195 | (:predicate nil)) |
| 196 | protocol | 196 | protocol |