lisp/epg-config.el

   1 ;;; epg-config.el --- configuration of the EasyPG Library
   2
   3 ;; Copyright (C) 2006-2017 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 <http://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   :group 'epg
  52   :type 'string)
  53
  54 (defcustom epg-gpgsm-program "gpgsm"
  55   "The `gpgsm' executable.
  56 Setting this variable directly does not take effect;
  57 instead use \\[customize] (see the info node `Easy Customization')."
  58   :group 'epg
  59   :type 'string)
  60
  61 (defcustom epg-gpgconf-program "gpgconf"
  62   "The `gpgconf' executable."
  63   :version "25.1"
  64   :group 'epg
  65   :type 'string)
  66
  67 (defcustom epg-gpg-home-directory nil
  68   "The directory which contains the configuration files of `epg-gpg-program'."
  69   :group 'epg
  70   :type '(choice (const :tag "Default" nil) directory))
  71
  72 (defcustom epg-passphrase-coding-system nil
  73   "Coding system to use with messages from `epg-gpg-program'."
  74   :group 'epg
  75   :type 'symbol)
  76
  77 (defcustom epg-debug nil
  78   "If non-nil, debug output goes to the \" *epg-debug*\" buffer.
  79 Note that the buffer name starts with a space."
  80   :group 'epg
  81   :type 'boolean)
  82
  83 (defconst epg-gpg-minimum-version "1.4.3")
  84
  85 (defconst epg-config--program-alist
  86   `((OpenPGP
  87      epg-gpg-program
  88      ("gpg2" . "2.1.6") ("gpg" . ,epg-gpg-minimum-version))
  89     (CMS
  90      epg-gpgsm-program
  91      ("gpgsm" . "2.0.4")))
  92   "Alist used to obtain the usable configuration of executables.
  93 The first element of each entry is protocol symbol, which is
  94 either `OpenPGP' or `CMS'.  The second element is a symbol where
  95 the executable name is remembered.  The rest of the entry is an
  96 alist mapping executable names to the minimum required version
  97 suitable for the use with Emacs.")
  98
  99 (defconst epg-config--configuration-constructor-alist
 100   '((OpenPGP . epg-config--make-gpg-configuration)
 101     (CMS . epg-config--make-gpgsm-configuration))
 102   "Alist used to obtain the usable configuration of executables.
 103 The first element of each entry is protocol symbol, which is
 104 either `OpenPGP' or `CMS'.  The second element is a function
 105 which constructs a configuration object (actually a plist).")
 106
 107 (defvar epg--configurations nil)
 108
 109 ;;;###autoload
 110 (defun epg-find-configuration (protocol &optional no-cache program-alist)
 111   "Find or create a usable configuration to handle PROTOCOL.
 112 This function first looks at the existing configuration found by
 113 the previous invocation of this function, unless NO-CACHE is non-nil.
 114
 115 Then it walks through PROGRAM-ALIST or
 116 `epg-config--program-alist'.  If `epg-gpg-program' or
 117 `epg-gpgsm-program' is already set with custom, use it.
 118 Otherwise, it tries the programs listed in the entry until the
 119 version requirement is met."
 120   (unless program-alist
 121     (setq program-alist epg-config--program-alist))
 122   (let ((entry (assq protocol program-alist)))
 123     (unless entry
 124       (error "Unknown protocol %S" protocol))
 125     (cl-destructuring-bind (symbol . alist)
 126         (cdr entry)
 127       (let ((constructor
 128              (alist-get protocol epg-config--configuration-constructor-alist)))
 129         (or (and (not no-cache) (alist-get protocol epg--configurations))
 130             ;; If the executable value is already set with M-x
 131             ;; customize, use it without checking.
 132             (if (and symbol (or (get symbol 'saved-value)
 133                                 (get symbol 'customized-value)))
 134                 (let ((configuration
 135                        (funcall constructor (symbol-value symbol))))
 136                   (push (cons protocol configuration) epg--configurations)
 137                   configuration)
 138               (catch 'found
 139                 (dolist (program-version alist)
 140                   (let ((executable (executable-find (car program-version))))
 141                     (when executable
 142                       (let ((configuration
 143                              (funcall constructor executable)))
 144                         (when (ignore-errors
 145                                 (epg-check-configuration configuration
 146                                                          (cdr program-version))
 147                                 t)
 148                           (unless no-cache
 149                             (push (cons protocol configuration)
 150                                   epg--configurations))
 151                           (throw 'found configuration)))))))))))))
 152
 153 ;; Create an `epg-configuration' object for `gpg', using PROGRAM.
 154 (defun epg-config--make-gpg-configuration (program)
 155   (let (config groups type args)
 156     (with-temp-buffer
 157       (apply #'call-process program nil (list t nil) nil
 158              (append (if epg-gpg-home-directory
 159                          (list "--homedir" epg-gpg-home-directory))
 160                      '("--with-colons" "--list-config")))
 161       (goto-char (point-min))
 162       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
 163         (setq type (intern (match-string 1))
 164               args (match-string 2))
 165         (cond
 166          ((eq type 'group)
 167           (if (string-match "\\`\\([^:]+\\):" args)
 168                   (setq groups
 169                         (cons (cons (downcase (match-string 1 args))
 170                                     (delete "" (split-string
 171                                                 (substring args
 172                                                            (match-end 0))
 173                                                 ";")))
 174                               groups))
 175             (if epg-debug
 176                 (message "Invalid group configuration: %S" args))))
 177          ((memq type '(pubkey cipher digest compress))
 178           (if (string-match "\\`\\([0-9]+\\)\\(;[0-9]+\\)*" args)
 179               (setq config
 180                     (cons (cons type
 181                                 (mapcar #'string-to-number
 182                                         (delete "" (split-string args ";"))))
 183                           config))
 184             (if epg-debug
 185                 (message "Invalid %S algorithm configuration: %S"
 186                          type args))))
 187          (t
 188           (setq config (cons (cons type args) config))))))
 189     (push (cons 'program program) config)
 190     (if groups
 191         (cons (cons 'groups groups) config)
 192       config)))
 193
 194 ;; Create an `epg-configuration' object for `gpgsm', using PROGRAM.
 195 (defun epg-config--make-gpgsm-configuration (program)
 196   (with-temp-buffer
 197     (call-process program nil (list t nil) nil "--version")
 198     (goto-char (point-min))
 199     (when (looking-at "\\S-+ (")
 200       (goto-char (match-end 0))
 201       (backward-char)
 202       (forward-sexp)
 203       (skip-syntax-forward "-" (point-at-eol))
 204       (list (cons 'program program)
 205             (cons 'version (buffer-substring (point) (point-at-eol)))))))
 206
 207 ;;;###autoload
 208 (defun epg-configuration ()
 209   "Return a list of internal configuration parameters of `epg-gpg-program'."
 210   (declare (obsolete epg-find-configuration "25.1"))
 211   (epg-config--make-gpg-configuration epg-gpg-program))
 212
 213 (defun epg-config--parse-version (string)
 214   (let ((index 0)
 215         version)
 216     (while (eq index (string-match "\\([0-9]+\\)\\.?" string index))
 217       (setq version (cons (string-to-number (match-string 1 string))
 218                           version)
 219             index (match-end 0)))
 220     (nreverse version)))
 221
 222 (defun epg-config--compare-version (v1 v2)
 223   (while (and v1 v2 (= (car v1) (car v2)))
 224     (setq v1 (cdr v1) v2 (cdr v2)))
 225   (- (or (car v1) 0) (or (car v2) 0)))
 226
 227 ;;;###autoload
 228 (defun epg-check-configuration (config &optional minimum-version)
 229   "Verify that a sufficient version of GnuPG is installed."
 230   (let ((entry (assq 'version config))
 231         version)
 232     (unless (and entry
 233                  (stringp (cdr entry)))
 234       (error "Undetermined version: %S" entry))
 235     (setq version (epg-config--parse-version (cdr entry))
 236           minimum-version (epg-config--parse-version
 237                            (or minimum-version
 238                                epg-gpg-minimum-version)))
 239     (unless (>= (epg-config--compare-version version minimum-version) 0)
 240       (error "Unsupported version: %s" (cdr entry)))))
 241
 242 ;;;###autoload
 243 (defun epg-expand-group (config group)
 244   "Look at CONFIG and try to expand GROUP."
 245   (let ((entry (assq 'groups config)))
 246     (if (and entry
 247              (setq entry (assoc (downcase group) (cdr entry))))
 248         (cdr entry))))
 249
 250 (provide 'epg-config)
 251
 252 ;;; epg-config.el ends here