code.delx.au - gnu-emacs/blob - 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   :version "25.1"
  49   :group 'epg
  50   :type 'string)
  51
  52 (defcustom epg-gpgsm-program "gpgsm"
  53   "The `gpgsm' executable."
  54   :group 'epg
  55   :type 'string)
  56
  57 (defcustom epg-gpgconf-program "gpgconf"
  58   "The `gpgconf' executable."
  59   :version "25.1"
  60   :group 'epg
  61   :type 'string)
  62
  63 (defcustom epg-gpg-home-directory nil
  64   "The directory which contains the configuration files of `epg-gpg-program'."
  65   :group 'epg
  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   :group 'epg
  71   :type 'symbol)
  72
  73 (defcustom epg-debug nil
  74   "If non-nil, debug output goes to the \" *epg-debug*\" buffer.
  75 Note that the buffer name starts with a space."
  76   :group 'epg
  77   :type 'boolean)
  78
  79 (defconst epg-gpg-minimum-version "1.4.3")
  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
 101 ;;;###autoload
 102 (defun epg-find-configuration (protocol &optional force)
 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           ;; If the executable value is already set with M-x
 118           ;; customize, use it without checking.
 119           (if (get symbol 'saved-value)
 120               (let ((configuration (funcall constructor (symbol-value symbol))))
 121                 (push (cons protocol configuration) epg--configurations)
 122                 configuration)
 123             (catch 'found
 124               (dolist (program-version alist)
 125                 (let ((executable (executable-find (car program-version))))
 126                   (when executable
 127                     (let ((configuration
 128                            (funcall constructor executable)))
 129                       (when (ignore-errors
 130                               (epg-check-configuration configuration
 131                                                        (cdr program-version))
 132                               t)
 133                         (push (cons protocol configuration) epg--configurations)
 134                         (throw 'found configuration))))))))))))
 135
 136 ;; Create an `epg-configuration' object for `gpg', using PROGRAM.
 137 (defun epg-config--make-gpg-configuration (program)
 138   (let (config groups type args)
 139     (with-temp-buffer
 140       (apply #'call-process program nil (list t nil) nil
 141              (append (if epg-gpg-home-directory
 142                          (list "--homedir" epg-gpg-home-directory))
 143                      '("--with-colons" "--list-config")))
 144       (goto-char (point-min))
 145       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
 146         (setq type (intern (match-string 1))
 147               args (match-string 2))
 148         (cond
 149          ((eq type 'group)
 150           (if (string-match "\\`\\([^:]+\\):" args)
 151                   (setq groups
 152                         (cons (cons (downcase (match-string 1 args))
 153                                     (delete "" (split-string
 154                                                 (substring args
 155                                                            (match-end 0))
 156                                                 ";")))
 157                               groups))
 158             (if epg-debug
 159                 (message "Invalid group configuration: %S" args))))
 160          ((memq type '(pubkey cipher digest compress))
 161           (if (string-match "\\`\\([0-9]+\\)\\(;[0-9]+\\)*" args)
 162               (setq config
 163                     (cons (cons type
 164                                 (mapcar #'string-to-number
 165                                         (delete "" (split-string args ";"))))
 166                           config))
 167             (if epg-debug
 168                 (message "Invalid %S algorithm configuration: %S"
 169                          type args))))
 170          (t
 171           (setq config (cons (cons type args) config))))))
 172     (push (cons 'program program) config)
 173     (if groups
 174         (cons (cons 'groups groups) config)
 175       config)))
 176
 177 ;; Create an `epg-configuration' object for `gpgsm', using PROGRAM.
 178 (defun epg-config--make-gpgsm-configuration (program)
 179   (with-temp-buffer
 180     (call-process program nil (list t nil) nil "--version")
 181     (goto-char (point-min))
 182     (when (looking-at "\\S-+ (")
 183       (goto-char (match-end 0))
 184       (backward-char)
 185       (forward-sexp)
 186       (skip-syntax-forward "-" (point-at-eol))
 187       (list (cons 'program program)
 188             (cons 'version (buffer-substring (point) (point-at-eol)))))))
 189
 190 ;;;###autoload
 191 (defun epg-configuration ()
 192   "Return a list of internal configuration parameters of `epg-gpg-program'."
 193   (declare (obsolete epg-find-configuration "25.1"))
 194   (epg-config--make-gpg-configuration epg-gpg-program))
 195
 196 (defun epg-config--parse-version (string)
 197   (let ((index 0)
 198         version)
 199     (while (eq index (string-match "\\([0-9]+\\)\\.?" string index))
 200       (setq version (cons (string-to-number (match-string 1 string))
 201                           version)
 202             index (match-end 0)))
 203     (nreverse version)))
 204
 205 (defun epg-config--compare-version (v1 v2)
 206   (while (and v1 v2 (= (car v1) (car v2)))
 207     (setq v1 (cdr v1) v2 (cdr v2)))
 208   (- (or (car v1) 0) (or (car v2) 0)))
 209
 210 ;;;###autoload
 211 (defun epg-check-configuration (config &optional minimum-version)
 212   "Verify that a sufficient version of GnuPG is installed."
 213   (let ((entry (assq 'version config))
 214         version)
 215     (unless (and entry
 216                  (stringp (cdr entry)))
 217       (error "Undetermined version: %S" entry))
 218     (setq version (epg-config--parse-version (cdr entry))
 219           minimum-version (epg-config--parse-version
 220                            (or minimum-version
 221                                epg-gpg-minimum-version)))
 222     (unless (>= (epg-config--compare-version version minimum-version) 0)
 223       (error "Unsupported version: %s" (cdr entry)))))
 224
 225 ;;;###autoload
 226 (defun epg-expand-group (config group)
 227   "Look at CONFIG and try to expand GROUP."
 228   (let ((entry (assq 'groups config)))
 229     (if (and entry
 230              (setq entry (assoc (downcase group) (cdr entry))))
 231         (cdr entry))))
 232
 233 (provide 'epg-config)
 234
 235 ;;; epg-config.el ends here