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