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