lisp/epg-config.el

   1 ;;; epg-config.el --- configuration of the EasyPG Library
   2
   3 ;; Copyright (C) 2006-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Daiki Ueno <ueno@unixuser.org>
   6 ;; Keywords: PGP, GnuPG
   7 ;; Package: epg
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  23
  24 ;;; Code:
  25
  26 (eval-when-compile (require 'cl-lib))
  27
  28 (defconst epg-package-name "epg"
  29   "Name of this package.")
  30
  31 (defconst epg-version-number "1.0.0"
  32   "Version number of this package.")
  33
  34 (defconst epg-bug-report-address "ueno@unixuser.org"
  35   "Report bugs to this address.")
  36
  37 (defgroup epg ()
  38   "Interface to the GNU Privacy Guard (GnuPG)."
  39   :tag "EasyPG"
  40   :version "23.1"
  41   :group 'data
  42   :group 'external)
  43
  44 (defcustom epg-gpg-program (if (executable-find "gpg2")
  45                                "gpg2"
  46                              "gpg")
  47   "The `gpg' executable.
  48 Setting this variable directly does not take effect;
  49 instead use \\[customize] (see the info node `Easy Customization')."
  50   :version "25.1"
  51   :type 'string)
  52
  53 (defcustom epg-gpgsm-program "gpgsm"
  54   "The `gpgsm' executable.
  55 Setting this variable directly does not take effect;
  56 instead use \\[customize] (see the info node `Easy Customization')."
  57   :type 'string)
  58
  59 (defcustom epg-gpgconf-program "gpgconf"
  60   "The `gpgconf' executable."
  61   :version "25.1"
  62   :type 'string)
  63
  64 (defcustom epg-gpg-home-directory nil
  65   "The directory which contains the configuration files of `epg-gpg-program'."
  66   :type '(choice (const :tag "Default" nil) directory))
  67
  68 (defcustom epg-passphrase-coding-system nil
  69   "Coding system to use with messages from `epg-gpg-program'."
  70   :type 'symbol)
  71
  72 (define-obsolete-variable-alias
  73   'epa-pinentry-mode 'epg-pinentry-mode "27.1")
  74
  75 ;; In the doc string below, we say "symbol `error'" to avoid producing
  76 ;; a hyperlink for `error' the function.
  77 (defcustom epg-pinentry-mode nil
  78   "The pinentry mode.
  79
  80 GnuPG 2.1 or later has an option to control the behavior of
  81 Pinentry invocation.  The value should be the symbol `error',
  82 `ask', `cancel', or `loopback'.  See the GnuPG manual for the
  83 meanings.
  84
  85 A particularly useful mode is `loopback', which redirects all
  86 Pinentry queries to the caller, so Emacs can query passphrase
  87 through the minibuffer, instead of external Pinentry program."
  88   :type '(choice (const nil)
  89                  (const ask)
  90                  (const cancel)
  91                  (const error)
  92                  (const loopback))
  93   :version "27.1")
  94
  95 (defcustom epg-debug nil
  96   "If non-nil, debug output goes to the \" *epg-debug*\" buffer.
  97 Note that the buffer name starts with a space."
  98   :type 'boolean)
  99
 100 (defconst epg-gpg-minimum-version "1.4.3")
 101 (defconst epg-gpg2-minimum-version "2.1.6")
 102
 103 (defconst epg-config--program-alist
 104   `((OpenPGP
 105      epg-gpg-program
 106      ("gpg2" . ,epg-gpg2-minimum-version)
 107      ("gpg" . ((,epg-gpg-minimum-version . "2.0")
 108                ,epg-gpg2-minimum-version)))
 109     (CMS
 110      epg-gpgsm-program
 111      ("gpgsm" . "2.0.4")))
 112   "Alist used to obtain the usable configuration of executables.
 113 The first element of each entry is protocol symbol, which is
 114 either `OpenPGP' or `CMS'.  The second element is a symbol where
 115 the executable name is remembered.  The rest of the entry is an
 116 alist mapping executable names to the minimum required version
 117 suitable for the use with Emacs.")
 118
 119 (defconst epg-config--configuration-constructor-alist
 120   '((OpenPGP . epg-config--make-gpg-configuration)
 121     (CMS . epg-config--make-gpgsm-configuration))
 122   "Alist used to obtain the usable configuration of executables.
 123 The first element of each entry is protocol symbol, which is
 124 either `OpenPGP' or `CMS'.  The second element is a function
 125 which constructs a configuration object (actually a plist).")
 126
 127 (defvar epg--configurations nil)
 128
 129 ;;;###autoload
 130 (defun epg-find-configuration (protocol &optional no-cache program-alist)
 131   "Find or create a usable configuration to handle PROTOCOL.
 132 This function first looks at the existing configuration found by
 133 the previous invocation of this function, unless NO-CACHE is non-nil.
 134
 135 Then it walks through PROGRAM-ALIST or
 136 `epg-config--program-alist'.  If `epg-gpg-program' or
 137 `epg-gpgsm-program' is already set with custom, use it.
 138 Otherwise, it tries the programs listed in the entry until the
 139 version requirement is met."
 140   (unless program-alist
 141     (setq program-alist epg-config--program-alist))
 142   (let ((entry (assq protocol program-alist)))
 143     (unless entry
 144       (error "Unknown protocol %S" protocol))
 145     (cl-destructuring-bind (symbol . alist)
 146         (cdr entry)
 147       (let ((constructor
 148              (alist-get protocol epg-config--configuration-constructor-alist)))
 149         (or (and (not no-cache) (alist-get protocol epg--configurations))
 150             ;; If the executable value is already set with M-x
 151             ;; customize, use it without checking.
 152             (if (and symbol (or (get symbol 'saved-value)
 153                                 (get symbol 'customized-value)))
 154                 (let ((configuration
 155                        (funcall constructor (symbol-value symbol))))
 156                   (push (cons protocol configuration) epg--configurations)
 157                   configuration)
 158               (catch 'found
 159                 (dolist (program-version alist)
 160                   (let ((executable (executable-find (car program-version))))
 161                     (when executable
 162                       (let ((configuration
 163                              (funcall constructor executable)))
 164                         (when (ignore-errors
 165                                 (epg-check-configuration configuration
 166                                                          (cdr program-version))
 167                                 t)
 168                           (unless no-cache
 169                             (push (cons protocol configuration)
 170                                   epg--configurations))
 171                           (throw 'found configuration)))))))))))))
 172
 173 ;; Create an `epg-configuration' object for `gpg', using PROGRAM.
 174 (defun epg-config--make-gpg-configuration (program)
 175   (let (config groups type args)
 176     (with-temp-buffer
 177       (apply #'call-process program nil (list t nil) nil
 178              (append (if epg-gpg-home-directory
 179                          (list "--homedir" epg-gpg-home-directory))
 180                      '("--with-colons" "--list-config")))
 181       (goto-char (point-min))
 182       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
 183         (setq type (intern (match-string 1))
 184               args (match-string 2))
 185         (cond
 186          ((eq type 'group)
 187           (if (string-match "\\`\\([^:]+\\):" args)
 188                   (setq groups
 189                         (cons (cons (downcase (match-string 1 args))
 190                                     (delete "" (split-string
 191                                                 (substring args
 192                                                            (match-end 0))
 193                                                 ";")))
 194                               groups))
 195             (if epg-debug
 196                 (message "Invalid group configuration: %S" args))))
 197          ((memq type '(pubkey cipher digest compress))
 198           (if (string-match "\\`\\([0-9]+\\)\\(;[0-9]+\\)*" args)
 199               (setq config
 200                     (cons (cons type
 201                                 (mapcar #'string-to-number
 202                                         (delete "" (split-string args ";"))))
 203                           config))
 204             (if epg-debug
 205                 (message "Invalid %S algorithm configuration: %S"
 206                          type args))))
 207          (t
 208           (setq config (cons (cons type args) config))))))
 209     (push (cons 'program program) config)
 210     (if groups
 211         (cons (cons 'groups groups) config)
 212       config)))
 213
 214 ;; Create an `epg-configuration' object for `gpgsm', using PROGRAM.
 215 (defun epg-config--make-gpgsm-configuration (program)
 216   (with-temp-buffer
 217     (call-process program nil (list t nil) nil "--version")
 218     (goto-char (point-min))
 219     (when (looking-at "\\S-+ (")
 220       (goto-char (match-end 0))
 221       (backward-char)
 222       (forward-sexp)
 223       (skip-syntax-forward "-" (point-at-eol))
 224       (list (cons 'program program)
 225             (cons 'version (buffer-substring (point) (point-at-eol)))))))
 226
 227 ;;;###autoload
 228 (defun epg-configuration ()
 229   "Return a list of internal configuration parameters of `epg-gpg-program'."
 230   (declare (obsolete epg-find-configuration "25.1"))
 231   (epg-config--make-gpg-configuration epg-gpg-program))
 232
 233 ;;;###autoload
 234 (defun epg-check-configuration (config &optional req-versions)
 235   "Verify that a sufficient version of GnuPG is installed.
 236 CONFIG should be a `epg-configuration' object (a plist).
 237 REQ-VERSIONS should be a list with elements of the form (MIN
 238 . MAX) where MIN and MAX are version strings indicating a
 239 semi-open range of acceptable versions.  REQ-VERSIONS may also be
 240 a single minimum version string."
 241   (let ((version (alist-get 'version config)))
 242     (unless (stringp version)
 243       (error "Undetermined version: %S" version))
 244     (catch 'version-ok
 245       (pcase-dolist ((or `(,min . ,max)
 246                          (and min (let max nil)))
 247                      (if (listp req-versions) req-versions
 248                        (list req-versions)))
 249         (when (and (version<= (or min epg-gpg-minimum-version)
 250                               version)
 251                    (or (null max)
 252                        (version< version max)))
 253           (throw 'version-ok t)))
 254       (error "Unsupported version: %s" version))))
 255
 256 ;;;###autoload
 257 (defun epg-expand-group (config group)
 258   "Look at CONFIG and try to expand GROUP."
 259   (let ((entry (assq 'groups config)))
 260     (if (and entry
 261              (setq entry (assoc (downcase group) (cdr entry))))
 262         (cdr entry))))
 263
 264 (provide 'epg-config)
 265
 266 ;;; epg-config.el ends here