comparison lisp/obsolete/pgg-pgp.el @ 112005:62f897baec0a

Mark PGG obsolete. * obsolete/pgg-parse.el, obsolete/pgg-pgp5.el, obsolete/pgg-pgp.el, * obsolete/pgg-gpg.el, obsolete/pgg-def.el, obsolete/pgg.el: Move from lisp/. * gnus/mml1991.el (pgg-sign-region, pgg-encrypt-region): * gnus/gnus-art.el (pgg-snarf-keys-region): Autoload since PGG is now obsolete in Emacs.
author Daiki Ueno <ueno@unixuser.org>
date Tue, 21 Dec 2010 11:30:36 +0900
parents lisp/pgg-pgp.el@8d09094063d0
children 0258e50dbf90
comparison
equal deleted inserted replaced
112004:7a4b15c4bbed 112005:62f897baec0a
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