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