lisp/epg-config.el

   1 ;;; epg-config.el --- configuration of the EasyPG Library
   2
   3 ;; Copyright (C) 2006-2016 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" . "1.4.3"))
  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 (get symbol 'saved-value))
 133                 (let ((configuration
 134                        (funcall constructor (symbol-value symbol))))
 135                   (push (cons protocol configuration) epg--configurations)
 136                   configuration)
 137               (catch 'found
 138                 (dolist (program-version alist)
 139                   (let ((executable (executable-find (car program-version))))
 140                     (when executable
 141                       (let ((configuration
 142                              (funcall constructor executable)))
 143                         (when (ignore-errors
 144                                 (epg-check-configuration configuration
 145                                                          (cdr program-version))
 146                                 t)
 147                           (unless no-cache
 148                             (push (cons protocol configuration)
 149                                   epg--configurations))
 150                           (throw 'found configuration)))))))))))))
 151
 152 ;; Create an `epg-configuration' object for `gpg', using PROGRAM.
 153 (defun epg-config--make-gpg-configuration (program)
 154   (let (config groups type args)
 155     (with-temp-buffer
 156       (apply #'call-process program nil (list t nil) nil
 157              (append (if epg-gpg-home-directory
 158                          (list "--homedir" epg-gpg-home-directory))
 159                      '("--with-colons" "--list-config")))
 160       (goto-char (point-min))
 161       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
 162         (setq type (intern (match-string 1))
 163               args (match-string 2))
 164         (cond
 165          ((eq type 'group)
 166           (if (string-match "\\`\\([^:]+\\):" args)
 167                   (setq groups
 168                         (cons (cons (downcase (match-string 1 args))
 169                                     (delete "" (split-string
 170                                                 (substring args
 171                                                            (match-end 0))
 172                                                 ";")))
 173                               groups))
 174             (if epg-debug
 175                 (message "Invalid group configuration: %S" args))))
 176          ((memq type '(pubkey cipher digest compress))
 177           (if (string-match "\\`\\([0-9]+\\)\\(;[0-9]+\\)*" args)
 178               (setq config
 179                     (cons (cons type
 180                                 (mapcar #'string-to-number
 181                                         (delete "" (split-string args ";"))))
 182                           config))
 183             (if epg-debug
 184                 (message "Invalid %S algorithm configuration: %S"
 185                          type args))))
 186          (t
 187           (setq config (cons (cons type args) config))))))
 188     (push (cons 'program program) config)
 189     (if groups
 190         (cons (cons 'groups groups) config)
 191       config)))
 192
 193 ;; Create an `epg-configuration' object for `gpgsm', using PROGRAM.
 194 (defun epg-config--make-gpgsm-configuration (program)
 195   (with-temp-buffer
 196     (call-process program nil (list t nil) nil "--version")
 197     (goto-char (point-min))
 198     (when (looking-at "\\S-+ (")
 199       (goto-char (match-end 0))
 200       (backward-char)
 201       (forward-sexp)
 202       (skip-syntax-forward "-" (point-at-eol))
 203       (list (cons 'program program)
 204             (cons 'version (buffer-substring (point) (point-at-eol)))))))
 205
 206 ;;;###autoload
 207 (defun epg-configuration ()
 208   "Return a list of internal configuration parameters of `epg-gpg-program'."
 209   (declare (obsolete epg-find-configuration "25.1"))
 210   (epg-config--make-gpg-configuration epg-gpg-program))
 211
 212 (defun epg-config--parse-version (string)
 213   (let ((index 0)
 214         version)
 215     (while (eq index (string-match "\\([0-9]+\\)\\.?" string index))
 216       (setq version (cons (string-to-number (match-string 1 string))
 217                           version)
 218             index (match-end 0)))
 219     (nreverse version)))
 220
 221 (defun epg-config--compare-version (v1 v2)
 222   (while (and v1 v2 (= (car v1) (car v2)))
 223     (setq v1 (cdr v1) v2 (cdr v2)))
 224   (- (or (car v1) 0) (or (car v2) 0)))
 225
 226 ;;;###autoload
 227 (defun epg-check-configuration (config &optional minimum-version)
 228   "Verify that a sufficient version of GnuPG is installed."
 229   (let ((entry (assq 'version config))
 230         version)
 231     (unless (and entry
 232                  (stringp (cdr entry)))
 233       (error "Undetermined version: %S" entry))
 234     (setq version (epg-config--parse-version (cdr entry))
 235           minimum-version (epg-config--parse-version
 236                            (or minimum-version
 237                                epg-gpg-minimum-version)))
 238     (unless (>= (epg-config--compare-version version minimum-version) 0)
 239       (error "Unsupported version: %s" (cdr entry)))))
 240
 241 ;;;###autoload
 242 (defun epg-expand-group (config group)
 243   "Look at CONFIG and try to expand GROUP."
 244   (let ((entry (assq 'groups config)))
 245     (if (and entry
 246              (setq entry (assoc (downcase group) (cdr entry))))
 247         (cdr entry))))
 248
 249 (provide 'epg-config)
 250
 251 ;;; epg-config.el ends here