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

   1 ;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
   2
   3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
   4 ;;   2009, 2010  Free Software Foundation, Inc.
   5
   6 ;; Author: Daiki Ueno <ueno@unixuser.org>
   7 ;; Created: 1999/11/02
   8 ;; Keywords: PGP, OpenPGP
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Code:
  26
  27 (eval-when-compile
  28   (require 'cl)                         ; for pgg macros
  29   (require 'pgg))
  30
  31 (defgroup pgg-pgp ()
  32   "PGP 2.* and 6.* interface."
  33   :group 'pgg)
  34
  35 (defcustom pgg-pgp-program "pgp"
  36   "PGP 2.* and 6.* executable."
  37   :group 'pgg-pgp
  38   :type 'string)
  39
  40 (defcustom pgg-pgp-shell-file-name "/bin/sh"
  41   "File name to load inferior shells from.
  42 Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
  43   :group 'pgg-pgp
  44   :type 'string)
  45
  46 (defcustom pgg-pgp-shell-command-switch "-c"
  47   "Switch used to have the shell execute its command line argument."
  48   :group 'pgg-pgp
  49   :type 'string)
  50
  51 (defcustom pgg-pgp-extra-args nil
  52   "Extra arguments for every PGP invocation."
  53   :group 'pgg-pgp
  54   :type '(choice
  55           (const :tag "None" nil)
  56           (string :tag "Arguments")))
  57
  58 (defvar pgg-pgp-user-id nil
  59   "PGP ID of your default identity.")
  60
  61 (defun pgg-pgp-process-region (start end passphrase program args)
  62   (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
  63          (args
  64           (concat args
  65                   pgg-pgp-extra-args
  66                   " 2>" (shell-quote-argument errors-file-name)))
  67          (shell-file-name pgg-pgp-shell-file-name)
  68          (shell-command-switch pgg-pgp-shell-command-switch)
  69          (process-environment process-environment)
  70          (output-buffer pgg-output-buffer)
  71          (errors-buffer pgg-errors-buffer)
  72          (process-connection-type nil)
  73          process status exit-status)
  74     (with-current-buffer (get-buffer-create output-buffer)
  75       (buffer-disable-undo)
  76       (erase-buffer))
  77     (when passphrase
  78       (setenv "PGPPASSFD" "0"))
  79     (unwind-protect
  80         (progn
  81           (let ((coding-system-for-read 'binary)
  82                 (coding-system-for-write 'binary))
  83             (setq process
  84                   (start-process-shell-command "*PGP*" output-buffer
  85                                                (concat program " " args))))
  86           (set-process-sentinel process #'ignore)
  87           (when passphrase
  88             (process-send-string process (concat passphrase "\n")))
  89           (process-send-region process start end)
  90           (process-send-eof process)
  91           (while (eq 'run (process-status process))
  92             (accept-process-output process 5))
  93           (setq status (process-status process)
  94                 exit-status (process-exit-status process))
  95           (delete-process process)
  96           (with-current-buffer output-buffer
  97             (pgg-convert-lbt-region (point-min)(point-max) 'LF)
  98
  99             (if (memq status '(stop signal))
 100                 (error "%s exited abnormally: '%s'" program exit-status))
 101             (if (= 127 exit-status)
 102                 (error "%s could not be found" program))
 103
 104             (set-buffer (get-buffer-create errors-buffer))
 105             (buffer-disable-undo)
 106             (erase-buffer)
 107             (insert-file-contents errors-file-name)))
 108       (if (and process (eq 'run (process-status process)))
 109           (interrupt-process process))
 110       (condition-case nil
 111           (delete-file errors-file-name)
 112         (file-error nil)))))
 113
 114 (defun pgg-pgp-lookup-key (string &optional type)
 115   "Search keys associated with STRING."
 116   (let ((args (list "+batchmode" "+language=en" "-kv" string)))
 117     (with-current-buffer (get-buffer-create pgg-output-buffer)
 118       (buffer-disable-undo)
 119       (erase-buffer)
 120       (apply #'call-process pgg-pgp-program nil t nil args)
 121       (goto-char (point-min))
 122       (cond
 123        ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
 124         (buffer-substring (point)(+ 8 (point))))
 125        ((re-search-forward "^Type" nil t);PGP 6.*
 126         (beginning-of-line 2)
 127         (substring
 128          (nth 2 (split-string
 129                  (buffer-substring (point)(progn (end-of-line) (point)))))
 130          2))))))
 131
 132 (defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase)
 133   "Encrypt the current region between START and END."
 134   (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
 135          (passphrase (or passphrase
 136                          (when sign
 137                            (pgg-read-passphrase
 138                             (format "PGP passphrase for %s: "
 139                                     pgg-pgp-user-id)
 140                             pgg-pgp-user-id))))
 141          (args
 142           (concat
 143            "+encrypttoself=off +verbose=1 +batchmode +language=us -fate "
 144            (if (or recipients pgg-encrypt-for-me)
 145                (mapconcat 'shell-quote-argument
 146                           (append recipients
 147                                   (if pgg-encrypt-for-me
 148                                       (list pgg-pgp-user-id))) " "))
 149            (if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id))))))
 150     (pgg-pgp-process-region start end nil pgg-pgp-program args)
 151     (pgg-process-when-success nil)))
 152
 153 (defun pgg-pgp-decrypt-region (start end &optional passphrase)
 154   "Decrypt the current region between START and END.
 155
 156 If optional PASSPHRASE is not specified, it will be obtained from the
 157 passphrase cache or user."
 158   (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
 159          (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))
 160          (passphrase
 161           (or passphrase
 162               (pgg-read-passphrase
 163                (format "PGP passphrase for %s: " pgg-pgp-user-id) key)))
 164          (args
 165           "+verbose=1 +batchmode +language=us -f"))
 166     (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
 167     (pgg-process-when-success
 168       (if pgg-cache-passphrase
 169           (pgg-add-passphrase-to-cache key passphrase)))))
 170
 171 (defun pgg-pgp-sign-region (start end &optional clearsign passphrase)
 172   "Make detached signature from text between START and END.
 173
 174 If optional PASSPHRASE is not specified, it will be obtained from the
 175 passphrase cache or user."
 176   (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
 177          (passphrase
 178           (or passphrase
 179               (pgg-read-passphrase
 180                (format "PGP passphrase for %s: " pgg-pgp-user-id)
 181                (pgg-pgp-lookup-key pgg-pgp-user-id 'sign))))
 182          (args
 183           (concat (if clearsign "-fast" "-fbast")
 184                 " +verbose=1 +language=us +batchmode"
 185                 " -u " (shell-quote-argument pgg-pgp-user-id))))
 186     (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
 187     (pgg-process-when-success
 188       (goto-char (point-min))
 189       (when (re-search-forward "^-+BEGIN PGP" nil t);XXX
 190         (let ((packet
 191                (cdr (assq 2 (pgg-parse-armor-region
 192                              (progn (beginning-of-line 2)
 193                                     (point))
 194                              (point-max))))))
 195           (if pgg-cache-passphrase
 196               (pgg-add-passphrase-to-cache
 197                (cdr (assq 'key-identifier packet))
 198                passphrase)))))))
 199
 200 (defun pgg-pgp-verify-region (start end &optional signature)
 201   "Verify region between START and END as the detached signature SIGNATURE."
 202   (let* ((orig-file (pgg-make-temp-file "pgg"))
 203          (args "+verbose=1 +batchmode +language=us")
 204          (orig-mode (default-file-modes)))
 205     (unwind-protect
 206         (progn
 207           (set-default-file-modes 448)
 208           (let ((coding-system-for-write 'binary)
 209                 jka-compr-compression-info-list jam-zcat-filename-list)
 210             (write-region start end orig-file)))
 211       (set-default-file-modes orig-mode))
 212     (if (stringp signature)
 213         (progn
 214           (copy-file signature (setq signature (concat orig-file ".asc")))
 215           (setq args (concat args " " (shell-quote-argument signature)))))
 216     (setq args (concat args " " (shell-quote-argument orig-file)))
 217     (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
 218     (delete-file orig-file)
 219     (if signature (delete-file signature))
 220     (pgg-process-when-success
 221       (goto-char (point-min))
 222       (let ((case-fold-search t))
 223         (while (re-search-forward "^warning: " nil t)
 224           (delete-region (match-beginning 0)
 225                          (progn (beginning-of-line 2) (point)))))
 226       (goto-char (point-min))
 227       (when (re-search-forward "^\\.$" nil t)
 228         (delete-region (point-min)
 229                        (progn (beginning-of-line 2)
 230                               (point)))))))
 231
 232 (defun pgg-pgp-insert-key ()
 233   "Insert public key at point."
 234   (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
 235          (args
 236           (concat "+verbose=1 +batchmode +language=us -kxaf "
 237                   (shell-quote-argument pgg-pgp-user-id))))
 238     (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
 239     (insert-buffer-substring pgg-output-buffer)))
 240
 241 (defun pgg-pgp-snarf-keys-region (start end)
 242   "Add all public keys in region between START and END to the keyring."
 243   (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
 244          (key-file (pgg-make-temp-file "pgg"))
 245          (args
 246           (concat "+verbose=1 +batchmode +language=us -kaf "
 247                   (shell-quote-argument key-file))))
 248     (let ((coding-system-for-write 'raw-text-dos))
 249       (write-region start end key-file))
 250     (pgg-pgp-process-region start end nil pgg-pgp-program args)
 251     (delete-file key-file)
 252     (pgg-process-when-success nil)))
 253
 254 (provide 'pgg-pgp)
 255
 256 ;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
 257 ;;; pgg-pgp.el ends here