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-configuration-find (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           (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)
 139   (let (config groups type args)
 140     (with-temp-buffer
 141       (apply #'call-process program nil (list t nil) nil
 142              (append (if epg-gpg-home-directory
 143                          (list "--homedir" epg-gpg-home-directory))
 144                      '("--with-colons" "--list-config")))
 145       (goto-char (point-min))
 146       (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t)
 147         (setq type (intern (match-string 1))
 148               args (match-string 2))
 149         (cond
 150          ((eq type 'group)
 151           (if (string-match "\\`\\([^:]+\\):" args)
 152                   (setq groups
 153                         (cons (cons (downcase (match-string 1 args))
 154                                     (delete "" (split-string
 155                                                 (substring args
 156                                                            (match-end 0))
 157                                                 ";")))
 158                               groups))
 159             (if epg-debug
 160                 (message "Invalid group configuration: %S" args))))
 161          ((memq type '(pubkey cipher digest compress))
 162           (if (string-match "\\`\\([0-9]+\\)\\(;[0-9]+\\)*" args)
 163               (setq config
 164                     (cons (cons type
 165                                 (mapcar #'string-to-number
 166                                         (delete "" (split-string args ";"))))
 167                           config))
 168             (if epg-debug
 169                 (message "Invalid %S algorithm configuration: %S"
 170                          type args))))
 171          (t
 172           (setq config (cons (cons type args) config))))))
 173     (push (cons 'program program) config)
 174     (if groups
 175         (cons (cons 'groups groups) config)
 176       config)))
 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
 197 (defun epg-config--parse-version (string)
 198   (let ((index 0)
 199         version)
 200     (while (eq index (string-match "\\([0-9]+\\)\\.?" string index))
 201       (setq version (cons (string-to-number (match-string 1 string))
 202                           version)
 203             index (match-end 0)))
 204     (nreverse version)))
 205
 206 (defun epg-config--compare-version (v1 v2)
 207   (while (and v1 v2 (= (car v1) (car v2)))
 208     (setq v1 (cdr v1) v2 (cdr v2)))
 209   (- (or (car v1) 0) (or (car v2) 0)))
 210
 211 ;;;###autoload
 212 (defun epg-check-configuration (config &optional minimum-version)
 213   "Verify that a sufficient version of GnuPG is installed."
 214   (let ((entry (assq 'version config))
 215         version)
 216     (unless (and entry
 217                  (stringp (cdr entry)))
 218       (error "Undetermined version: %S" entry))
 219     (setq version (epg-config--parse-version (cdr entry))
 220           minimum-version (epg-config--parse-version
 221                            (or minimum-version
 222                                epg-gpg-minimum-version)))
 223     (unless (>= (epg-config--compare-version version minimum-version) 0)
 224       (error "Unsupported version: %s" (cdr entry)))))
 225
 226 ;;;###autoload
 227 (defun epg-expand-group (config group)
 228   "Look at CONFIG and try to expand GROUP."
 229   (let ((entry (assq 'groups config)))
 230     (if (and entry
 231              (setq entry (assoc (downcase group) (cdr entry))))
 232         (cdr entry))))
 233
 234 (provide 'epg-config)
 235
 236 ;;; epg-config.el ends here