1 |
|
;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. |
2 |
|
|
3 |
|
;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
|
;; Author: Daiki Ueno <ueno@unixuser.org> |
6 |
|
;; Created: 1999/11/02 |
7 |
|
;; Keywords: PGP, OpenPGP |
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 2, or (at your option) |
14 |
|
;; 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; see the file COPYING. If not, write to the |
23 |
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
24 |
|
;; Boston, MA 02111-1307, USA. |
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 |
|
(append args |
66 |
|
pgg-pgp-extra-args |
67 |
|
(list (concat "2>" 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 |
|
(apply #'funcall |
86 |
|
#'start-process-shell-command "*PGP*" output-buffer |
87 |
|
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) |
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 |
|
(args |
138 |
|
`("+encrypttoself=off +verbose=1" "+batchmode" |
139 |
|
"+language=us" "-fate" |
140 |
|
,@(if recipients |
141 |
|
(mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) |
142 |
|
(append recipients |
143 |
|
(if pgg-encrypt-for-me |
144 |
|
(list pgg-pgp-user-id)))))))) |
145 |
|
(pgg-pgp-process-region start end nil pgg-pgp-program args) |
146 |
|
(pgg-process-when-success nil))) |
147 |
|
|
148 |
|
(defun pgg-pgp-decrypt-region (start end) |
149 |
|
"Decrypt the current region between START and END." |
150 |
|
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) |
151 |
|
(passphrase |
152 |
|
(pgg-read-passphrase |
153 |
|
(format "PGP passphrase for %s: " pgg-pgp-user-id) |
154 |
|
(pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))) |
155 |
|
(args |
156 |
|
'("+verbose=1" "+batchmode" "+language=us" "-f"))) |
157 |
|
(pgg-pgp-process-region start end passphrase pgg-pgp-program args) |
158 |
|
(pgg-process-when-success nil))) |
159 |
|
|
160 |
|
(defun pgg-pgp-sign-region (start end &optional clearsign) |
161 |
|
"Make detached signature from text between START and END." |
162 |
|
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) |
163 |
|
(passphrase |
164 |
|
(pgg-read-passphrase |
165 |
|
(format "PGP passphrase for %s: " pgg-pgp-user-id) |
166 |
|
(pgg-pgp-lookup-key pgg-pgp-user-id 'sign))) |
167 |
|
(args |
168 |
|
(list (if clearsign "-fast" "-fbast") |
169 |
|
"+verbose=1" "+language=us" "+batchmode" |
170 |
|
"-u" pgg-pgp-user-id))) |
171 |
|
(pgg-pgp-process-region start end passphrase pgg-pgp-program args) |
172 |
|
(pgg-process-when-success |
173 |
|
(goto-char (point-min)) |
174 |
|
(when (re-search-forward "^-+BEGIN PGP" nil t);XXX |
175 |
|
(let ((packet |
176 |
|
(cdr (assq 2 (pgg-parse-armor-region |
177 |
|
(progn (beginning-of-line 2) |
178 |
|
(point)) |
179 |
|
(point-max)))))) |
180 |
|
(if pgg-cache-passphrase |
181 |
|
(pgg-add-passphrase-cache |
182 |
|
(cdr (assq 'key-identifier packet)) |
183 |
|
passphrase))))))) |
184 |
|
|
185 |
|
(defun pgg-pgp-verify-region (start end &optional signature) |
186 |
|
"Verify region between START and END as the detached signature SIGNATURE." |
187 |
|
(let* ((orig-file (pgg-make-temp-file "pgg")) |
188 |
|
(args '("+verbose=1" "+batchmode" "+language=us")) |
189 |
|
(orig-mode (default-file-modes))) |
190 |
|
(unwind-protect |
191 |
|
(progn |
192 |
|
(set-default-file-modes 448) |
193 |
|
(let ((coding-system-for-write 'binary) |
194 |
|
jka-compr-compression-info-list jam-zcat-filename-list) |
195 |
|
(write-region start end orig-file))) |
196 |
|
(set-default-file-modes orig-mode)) |
197 |
|
(if (stringp signature) |
198 |
|
(progn |
199 |
|
(copy-file signature (setq signature (concat orig-file ".asc"))) |
200 |
|
(setq args (append args (list signature orig-file)))) |
201 |
|
(setq args (append args (list orig-file)))) |
202 |
|
(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args) |
203 |
|
(delete-file orig-file) |
204 |
|
(if signature (delete-file signature)) |
205 |
|
(pgg-process-when-success |
206 |
|
(goto-char (point-min)) |
207 |
|
(let ((case-fold-search t)) |
208 |
|
(while (re-search-forward "^warning: " nil t) |
209 |
|
(delete-region (match-beginning 0) |
210 |
|
(progn (beginning-of-line 2) (point))))) |
211 |
|
(goto-char (point-min)) |
212 |
|
(when (re-search-forward "^\\.$" nil t) |
213 |
|
(delete-region (point-min) |
214 |
|
(progn (beginning-of-line 2) |
215 |
|
(point))))))) |
216 |
|
|
217 |
|
(defun pgg-pgp-insert-key () |
218 |
|
"Insert public key at point." |
219 |
|
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) |
220 |
|
(args |
221 |
|
(list "+verbose=1" "+batchmode" "+language=us" "-kxaf" |
222 |
|
(concat "\"" pgg-pgp-user-id "\"")))) |
223 |
|
(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args) |
224 |
|
(insert-buffer-substring pgg-output-buffer))) |
225 |
|
|
226 |
|
(defun pgg-pgp-snarf-keys-region (start end) |
227 |
|
"Add all public keys in region between START and END to the keyring." |
228 |
|
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) |
229 |
|
(key-file (pgg-make-temp-file "pgg")) |
230 |
|
(args |
231 |
|
(list "+verbose=1" "+batchmode" "+language=us" "-kaf" |
232 |
|
key-file))) |
233 |
|
(let ((coding-system-for-write 'raw-text-dos)) |
234 |
|
(write-region start end key-file)) |
235 |
|
(pgg-pgp-process-region start end nil pgg-pgp-program args) |
236 |
|
(delete-file key-file) |
237 |
|
(pgg-process-when-success nil))) |
238 |
|
|
239 |
|
(provide 'pgg-pgp) |
240 |
|
|
241 |
|
;;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c |
242 |
|
;;; pgg-pgp.el ends here |