66383
|
1 ;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
|
|
2
|
|
3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
|
75347
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
66383
|
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
|
78236
|
14 ;; the Free Software Foundation; either version 3, or (at your option)
|
66383
|
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.
|
|
44 Bourne 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
|
74165
|
66 (concat args
|
66383
|
67 pgg-pgp-extra-args
|
74165
|
68 " 2>" (shell-quote-argument errors-file-name)))
|
66383
|
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
|
74165
|
86 (start-process-shell-command "*PGP*" output-buffer
|
|
87 (concat program " " args))))
|
66383
|
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
|
66697
|
134 (defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase)
|
66383
|
135 "Encrypt the current region between START and END."
|
|
136 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
|
66697
|
137 (passphrase (or passphrase
|
71262
|
138 (when sign
|
|
139 (pgg-read-passphrase
|
|
140 (format "PGP passphrase for %s: "
|
|
141 pgg-pgp-user-id)
|
|
142 pgg-pgp-user-id))))
|
66383
|
143 (args
|
74165
|
144 (concat
|
|
145 "+encrypttoself=off +verbose=1 +batchmode +language=us -fate "
|
76110
|
146 (if (or recipients pgg-encrypt-for-me)
|
74165
|
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))))))
|
66383
|
152 (pgg-pgp-process-region start end nil pgg-pgp-program args)
|
|
153 (pgg-process-when-success nil)))
|
|
154
|
66697
|
155 (defun pgg-pgp-decrypt-region (start end &optional passphrase)
|
|
156 "Decrypt the current region between START and END.
|
|
157
|
|
158 If optional PASSPHRASE is not specified, it will be obtained from the
|
|
159 passphrase cache or user."
|
66383
|
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
|
71262
|
163 (or passphrase
|
|
164 (pgg-read-passphrase
|
|
165 (format "PGP passphrase for %s: " pgg-pgp-user-id) key)))
|
66383
|
166 (args
|
74165
|
167 "+verbose=1 +batchmode +language=us -f"))
|
66383
|
168 (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
|
|
169 (pgg-process-when-success
|
|
170 (if pgg-cache-passphrase
|
66697
|
171 (pgg-add-passphrase-to-cache key passphrase)))))
|
66383
|
172
|
66697
|
173 (defun pgg-pgp-sign-region (start end &optional clearsign passphrase)
|
|
174 "Make detached signature from text between START and END.
|
|
175
|
|
176 If optional PASSPHRASE is not specified, it will be obtained from the
|
|
177 passphrase cache or user."
|
66383
|
178 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
|
|
179 (passphrase
|
71262
|
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))))
|
66383
|
184 (args
|
74165
|
185 (concat (if clearsign "-fast" "-fbast")
|
|
186 " +verbose=1 +language=us +batchmode"
|
|
187 " -u " (shell-quote-argument pgg-pgp-user-id))))
|
66383
|
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
|
66697
|
198 (pgg-add-passphrase-to-cache
|
66383
|
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"))
|
74165
|
205 (args "+verbose=1 +batchmode +language=us")
|
66383
|
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")))
|
74165
|
217 (setq args (concat args " " (shell-quote-argument signature)))))
|
|
218 (setq args (concat args " " (shell-quote-argument orig-file)))
|
66383
|
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
|
74165
|
238 (concat "+verbose=1 +batchmode +language=us -kxaf "
|
|
239 (shell-quote-argument pgg-pgp-user-id))))
|
66383
|
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
|
74165
|
248 (concat "+verbose=1 +batchmode +language=us -kaf "
|
|
249 (shell-quote-argument key-file))))
|
66383
|
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
|
74165
|
258 ;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
|
66383
|
259 ;;; pgg-pgp.el ends here
|