cgit.sxemacs.org Git - gnus/blob - lisp/pgg-gpg.el

   1 ;;; pgg-gpg.el --- GnuPG support for PGG.
   2
   3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Daiki Ueno <ueno@unixuser.org>
   7 ;; Symmetric encryption and gpg-agent support added by:
   8 ;;   Sascha Wilde <wilde@sha-bang.de>
   9 ;; Created: 1999/10/28
  10 ;; Keywords: PGP, OpenPGP, GnuPG
  11 ;; Package: pgg
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software: you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation, either version 3 of the License, or
  18 ;; (at your option) any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 ;;; Code:
  29
  30 (eval-when-compile
  31   (require 'cl)                         ; for gpg macros
  32   (require 'pgg))
  33
  34 (defgroup pgg-gpg ()
  35   "GnuPG interface."
  36   :group 'pgg)
  37
  38 (defcustom pgg-gpg-program "gpg"
  39   "The GnuPG executable."
  40   :group 'pgg-gpg
  41   :type 'string)
  42
  43 (defcustom pgg-gpg-extra-args nil
  44   "Extra arguments for every GnuPG invocation."
  45   :group 'pgg-gpg
  46   :type '(repeat (string :tag "Argument")))
  47
  48 (defcustom pgg-gpg-recipient-argument "--recipient"
  49   "GnuPG option to specify recipient."
  50   :group 'pgg-gpg
  51   :type '(choice (const :tag "New `--recipient' option" "--recipient")
  52                  (const :tag "Old `--remote-user' option" "--remote-user")))
  53
  54 (defcustom pgg-gpg-use-agent t
  55   "Whether to use gnupg agent for key caching."
  56   :group 'pgg-gpg
  57   :type 'boolean)
  58
  59 (defvar pgg-gpg-user-id nil
  60   "GnuPG ID of your default identity.")
  61
  62 (defun pgg-gpg-process-region (start end passphrase program args)
  63   (let* ((use-agent (and (null passphrase) (pgg-gpg-use-agent-p)))
  64          (output-file-name (pgg-make-temp-file "pgg-output"))
  65          (args
  66           `("--status-fd" "2"
  67             ,@(if use-agent '("--use-agent")
  68                 (if passphrase '("--passphrase-fd" "0")))
  69             "--yes" ; overwrite
  70             "--output" ,output-file-name
  71             ,@pgg-gpg-extra-args ,@args))
  72          (output-buffer pgg-output-buffer)
  73          (errors-buffer pgg-errors-buffer)
  74          (orig-mode (default-file-modes))
  75          (process-connection-type nil)
  76          (inhibit-redisplay t)
  77          process status exit-status
  78          passphrase-with-newline
  79          encoded-passphrase-with-new-line)
  80     (with-current-buffer (get-buffer-create errors-buffer)
  81       (buffer-disable-undo)
  82       (erase-buffer))
  83     (unwind-protect
  84         (progn
  85           (set-default-file-modes 448)
  86           (let ((coding-system-for-write 'binary))
  87             (setq process
  88                   (apply #'start-process "*GnuPG*" errors-buffer
  89                          program args)))
  90           (set-process-sentinel process #'ignore)
  91           (when passphrase
  92             (setq passphrase-with-newline (concat passphrase "\n"))
  93             (if pgg-passphrase-coding-system
  94                 (progn
  95                   (setq encoded-passphrase-with-new-line
  96                         (encode-coding-string
  97                          passphrase-with-newline
  98                          (coding-system-change-eol-conversion
  99                           pgg-passphrase-coding-system 'unix)))
 100                   (pgg-clear-string passphrase-with-newline))
 101               (setq encoded-passphrase-with-new-line passphrase-with-newline
 102                     passphrase-with-newline nil))
 103             (process-send-string process encoded-passphrase-with-new-line))
 104           (process-send-region process start end)
 105           (process-send-eof process)
 106           (while (eq 'run (process-status process))
 107             (accept-process-output process 5))
 108           ;; Accept any remaining pending output coming after the
 109           ;; status change.
 110           (accept-process-output process 5)
 111           (setq status (process-status process)
 112                 exit-status (process-exit-status process))
 113           (delete-process process)
 114