|
|
1.1 root 1: ;;; -*-Emacs-Lisp-*-
2:
3: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4: ;;; File: rat-pgp.el v 1.4
5: ;;; Description: PGP Public Key system front-end for GNU Emacs
6: ;;; Author: Richard Pieri, [email protected]
7: ;;; Some additional code Dan Rich, [email protected]
8: ;;; Created: Fri Dec 25 12:25:42 1992
9: ;;; FTP: The latest version of rat-pgp.el can be anonymously FTP'ed
10: ;;; from ftp.ccs.neu.edu:/pub/ratinox/emacs-lisp/rat-pgp.el
11: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12:
13: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14: ;;; Caveat: it is inherently insecure to use PGP or any other encryption
15: ;;; system on a multi-user system. There are just too many ways for someone
16: ;;; to spy on what you are doing. It is highly recommended that you keep
17: ;;; your private keys (secring.pgp) on write-protected mountable floppies
18: ;;; and you keep these disks in a secure place.
19: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20:
21: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
22: ;;; Known Bugs:
23: ;;; + There is no checking to see if you have entered an invalid pass
24: ;;; phrase in pgp-decrypt-message. If you do, then everything will seem
25: ;;; to freeze as PGP awaits a valid pass phrase. Typing C-g will unlock
26: ;;; things, and you can check the *PGP-Log* buffer for any errors.
27: ;;; + When decrypting, informational messages get copied into the message
28: ;;; buffer instead of remaining in the *PGP-Log* buffer.
29: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30:
31: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32: ;;; History:
33: ;;; * Richard Pieri, Feb 25, 1993: rewrote the decryption code based on
34: ;;; suggestions and code written by Robert Anderson
35: ;;; <[email protected]>.
36: ;;; * Richard Pieri, Jun 7, 1993: incorporated Dan Rich's code, made
37: ;;; clearing temporary files a bit more reasonable.
38: ;;; * Richard Pieri, Jun 18, 1993: changed the name to "rat-pgp" to avoid
39: ;;; confusion with other PGP front-ends for GNU Emacs. Output from PGP
40: ;;; commands now is kept in the buffer *PGP-Log*, so you can see what
41: ;;; went right or wrong. Re-wrote the passphrase handling code. Made lots
42: ;;; of improvements.
43: ;;; * Richard Pieri, June 22, 1993: fixed a bug in pgp-set-passphrase.
44: ;;; * Richard Pieri, June 22, 1993: fixed all the problems created by the
45: ;;; last edit. Maybe that will teach me not to code when caffeine sober.
46: ;;; * Richard Pieri, June 25, 1993: added pgp-validate-signature.
47: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48:
49: ;; This is free software; you can redistribute it and/or modify
50: ;; it under the terms of the GNU General Public License as published by
51: ;; the Free Software Foundation.
52:
53: ;; This software is distributed in the hope that it will be useful,
54: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
55: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
56: ;; GNU General Public License for more details.
57:
58: ;; For a copy of the GNU General Public License write to
59: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
60:
61: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62: ;;; Installation:
63: ;;;
64: ;;; Make sure that the PGP executable is in your PATH, then byte-compile
65: ;;; this file, put it in your load-path. Add the command:
66: ;;; (autoload 'pgp-insinuate-keys "pgp" "Add PGP key bindings to a mode" nil)
67: ;;; then update your approprate setup hooks (ie, mail-setup-hook) to call
68: ;;; pgp-insinuate-keys.
69: ;;;
70: ;;; You will probably also want to configure config.txt to do things like
71: ;;; automatically add keys to your keyrings and such.
72: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73:
74: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75: ;;; Variables
76: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
77:
78: (defvar pgp-program "pgp"
79: "PGP program. This should be in your PATH environment variable somewhere.")
80:
81: (defvar pgp-path (getenv "PGPPATH")
82: "This should match your PGPPATH environment variable.")
83:
84: (defvar pgp-tmp (concat pgp-path "/pgptmp.pgp")
85: "Scratch file used by pgp -f.")
86:
87: (defvar pgp-asc (concat pgp-path "/pgptmp.asc")
88: "Scratch ascii-armor file created by pgp.")
89:
90: (defvar pgp-passphrase nil
91: "PGP passphrase.")
92:
93: (defvar pgp-always-clear-passphrase nil
94: "If t, clear the pass phrase from memory every time PGP finishes using it.
95: This is the secure, but inconvenient option.
96: Anything else will cause the current pass to remain in memory. This is the
97: less secure, but more convenient option.")
98:
99: (defconst pgp-flags nil
100: "Flags to be used with all PGP commands.")
101:
102: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103: ;;; Functions
104: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
105:
106: (defun pgp-delete-files ()
107: "Delete pgp-tmp and pgptmp.asc if they exist. Smart enough to check for
108: temporary files in whatever directory you are currently in."
109: (if (file-exists-p pgp-tmp)
110: (delete-file pgp-tmp))
111: (if (file-exists-p pgp-asc)
112: (delete-file pgp-asc))
113: (if (file-exists-p "pgptemp.asc")
114: (delete-file "pgptemp.asc"))
115: (if (file-exists-p "pgptemp.pgp")
116: (delete-file "pgptemp.pgp"))
117: )
118:
119: ;;; This still needs a bit of work because it won't work as a filter.
120: ;;; At least I haven't figured out how to make it works as a filter...
121: (defun pgp-insert-public-key-block ()
122: "Insert your PGP Public Key Block at point."
123: (interactive)
124: (pgp-delete-files)
125: (save-window-excursion
126: ;; extract key into temp file
127: (let ((this-buffer (current-buffer))
128: (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
129: (set-buffer pgp-log-buffer)
130: (message "PGP: inserting public-key block...")
131: (shell-command (concat pgp-program " -kxa $USER " pgp-asc) t)
132: (goto-char (point-max))
133: ))
134: (insert-file pgp-asc)
135: (pgp-delete-files)
136: (message "PGP: inserting public-key block... done.")
137: )
138:
139: (defun pgp-sign-message ()
140: "Sign the message at point."
141: (interactive)
142: (pgp-delete-files)
143: (save-window-excursion
144: (save-excursion
145: (pgp-set-passphrase pgp-passphrase)
146: (let ((buffer-status buffer-read-only))
147: (setq buffer-read-only nil)
148: (goto-char (point-min))
149: (search-forward mail-header-separator)
150: (forward-char 1)
151: (let ((start (point))
152: (end (point-max))
153: (this-buffer (current-buffer))
154: (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
155: (kill-region start end)
156: (set-buffer pgp-log-buffer)
157: (yank)
158: (message "PGP: signing message...")
159: (shell-command-on-region (point) (mark)
160: (concat pgp-program
161: " -fast +clearsig=on") t)
162: (search-backward "-----BEGIN PGP SIGNED MESSAGE-----")
163: (kill-region (point) (point-max))
164: (goto-char (point-max))
165: (set-buffer this-buffer)
166: (goto-char (point-max))
167: (yank)
168: (setq buffer-read-only buffer-status))
169: )))
170: (if pgp-always-clear-passphrase
171: (pgp-clear-passphrase))
172: (pgp-delete-files)
173: (message "PGP: signing message... done.")
174: )
175:
176: (defun pgp-extract-public-key ()
177: "Extract the public key from a message and put it into your public keyring."
178: (interactive)
179: (pgp-delete-files)
180: (save-window-excursion
181: (save-excursion
182: (let ((buffer-status buffer-read-only))
183: (setq buffer-read-only nil)
184: (goto-char (point-min))
185: (search-forward "-----BEGIN PGP PUBLIC KEY BLOCK-----")
186: (beginning-of-line)
187: (push-mark)
188: (search-forward "-----END PGP PUBLIC KEY BLOCK-----")
189: (forward-char 1)
190: (let ((this-buffer (current-buffer))
191: (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
192: (copy-region-as-kill (point) (mark))
193: (set-buffer pgp-log-buffer)
194: (yank)
195: (write-region (point) (mark) pgp-tmp)
196: (message "PGP: extracting public-key block...")
197: (shell-command (concat pgp-program " -ka " pgp-tmp) t)
198: (goto-char (point-max))
199: (setq buffer-read-only buffer-status))
200: )))
201: (pgp-delete-files)
202: (message "PGP: extracting public-key block... done.")
203: )
204:
205: (defun pgp-encrypt-message (userid)
206: "Encrypt from mail-header-separator to (point-max), replacing clear text
207: with cyphertext and the Public Key message delimiters."
208: (interactive "sRecipient's userid: ")
209: (pgp-delete-files)
210: (save-window-excursion
211: (save-excursion
212: (goto-char (point-min))
213: (search-forward mail-header-separator)
214: (forward-char 1)
215: (let ((start (point))
216: (end (point-max))
217: (this-buffer (current-buffer))
218: (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
219: (kill-region start end)
220: (set-buffer pgp-log-buffer)
221: (yank)
222: (message "PGP: encrypting message...")
223: (shell-command-on-region
224: (point) (mark) (concat pgp-program " -fea " userid) t)
225: (search-backward "-----BEGIN PGP MESSAGE-----")
226: (push-mark)
227: (search-forward "-----END PGP MESSAGE-----")
228: (forward-char 1)
229: (kill-region (point) (mark))
230: (goto-char (point-max))
231: (set-buffer this-buffer)
232: (yank)
233: )))
234: (pgp-delete-files)
235: (message "PGP: encrypting message... done.")
236: )
237:
238: (defun pgp-sign-and-encrypt-message (userid)
239: "Sign the message at point."
240: (interactive "sRecipient's userid: ")
241: (pgp-delete-files)
242: (save-window-excursion
243: (save-excursion
244: (pgp-set-passphrase pgp-passphrase)
245: (let ((buffer-status buffer-read-only))
246: (setq buffer-read-only nil)
247: (goto-char (point-min))
248: (search-forward mail-header-separator)
249: (forward-char 1)
250: (let ((start (point))
251: (end (point-max))
252: (this-buffer (current-buffer))
253: (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
254: (kill-region start end)
255: (set-buffer pgp-log-buffer)
256: (yank)
257: (message "PGP: signing and encrypting message...")
258: (shell-command-on-region (point) (mark)
259: (concat pgp-program
260: " -safe " userid) t)
261: (search-backward "-----BEGIN PGP MESSAGE-----")
262: (kill-region (point) (point-max))
263: (goto-char (point-max))
264: (set-buffer this-buffer)
265: (yank)
266: (setq buffer-read-only buffer-status))
267: )))
268: (if pgp-always-clear-passphrase
269: (pgp-clear-passphrase))
270: (pgp-delete-files)
271: (message "PGP: signing and encrypting message... done.")
272: )
273:
274: (defun pgp-validate-signature ()
275: "Validate the signature on the current message. An error will occour if the
276: public key from the sender does not exist on your key ring."
277: (interactive)
278: (save-window-excursion
279: (save-restriction
280: (let ((buffer-status buffer-read-only))
281: (setq buffer-read-only nil)
282: (goto-char (point-min))
283: (search-forward "-----BEGIN PGP SIGNED MESSAGE-----")
284: (beginning-of-line)
285: (push-mark)
286: (search-forward "-----END PGP SIGNATURE-----")
287: (forward-char 1)
288: (let ((this-buffer (current-buffer))
289: (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
290: (copy-region-as-kill (point) (mark))
291: (set-buffer pgp-log-buffer)
292: (yank)
293: (message "PGP: validating signature...")
294: (shell-command-on-region (point) (mark)
295: (concat pgp-program " -f ") t)
296: (goto-char (point-max))
297: (or
298: (re-search-backward "WARNING: " 0 t)
299: (re-search-backward "^Good signature" 0 t))
300: (push-mark)
301: (beginning-of-line)
302: (next-line 1)
303: (if (search-forward "Signature made" (point-max) t)
304: (progn
305: (beginning-of-line)
306: (next-line 1)
307: (copy-region-as-kill (point) (mark)))
308: (copy-region-as-kill (point) (mark)))
309: (delete-region (point) (point-max))
310: (goto-char (point-max))
311: (set-buffer this-buffer)
312: (exchange-point-and-mark)
313: (yank)
314: (setq buffer-read-only buffer-status))
315: )))
316: (message "PGP: validating signature... done.")
317: )
318:
319: (defun pgp-decrypt-message ()
320: "Decrypt the PGP message between the BEGIN/END PGP MESSAGE delimiters,
321: replacing cyphertext with clear text in the current buffer.
322:
323: Note that this function may be a security hole. If a pass phrase is in
324: memory when GNU Emacs crashes, it will appear in the core file. Anyone with
325: a half-decent grasp of hash tables will be able to extract your pass phrase
326: from the core file."
327: (interactive)
328: (pgp-delete-files)
329: (save-window-excursion
330: (save-excursion
331: (pgp-set-passphrase pgp-passphrase)
332: (let ((buffer-status buffer-read-only))
333: (setq buffer-read-only nil)
334: (goto-char (point-min))
335: (search-forward "-----BEGIN PGP MESSAGE-----")
336: (beginning-of-line)
337: (push-mark)
338: (search-forward "-----END PGP MESSAGE-----")
339: (forward-char 1)
340: (let ((this-buffer (current-buffer))
341: (pgp-log-buffer (get-buffer-create "*PGP-Log*")))
342: (kill-region (point) (mark))
343: (set-buffer pgp-log-buffer)
344: (yank)
345: (message "PGP: decrypting message...")
346: (shell-command-on-region
347: (point) (mark) (concat pgp-program " -f") t)
348: (kill-region (point) (mark))
349: (goto-char (point-max))
350: (set-buffer this-buffer)
351: (yank)
352: (setq buffer-read-only buffer-status)
353: ))))
354: (if (eq pgp-always-clear-passphrase t)
355: (pgp-clear-passphrase))
356: (pgp-delete-files)
357: (message "PGP: decrypting message... done.")
358: )
359:
360: (defun pgp-insinuate-keys ()
361: "Call from various mode setup hooks to bind PGP keys."
362: (local-set-key "\C-cpc" 'pgp-clear-passphrase)
363: (local-set-key "\C-cpd" 'pgp-decrypt-message)
364: (local-set-key "\C-cpe" 'pgp-encrypt-message)
365: (local-set-key "\C-cph" 'pgp-help)
366: (local-set-key "\C-cpi" 'pgp-insert-public-key-block)
367: (local-set-key "\C-cpp" 'pgp-set-passphrase)
368: (local-set-key "\C-cps" 'pgp-sign-message)
369: (local-set-key "\C-cpS" 'pgp-sign-and-encrypt-message)
370: (local-set-key "\C-cpv" 'pgp-validate-signature)
371: (local-set-key "\C-cpx" 'pgp-extract-public-key)
372: )
373:
374: (defun pgp-help ()
375: "Describe the rat-pgp key bindings.
376:
377: Key Command Name Description
378: ======= ============================ ========================================
379: C-c p c pgp-clear-passphrase Clears the current PGP passphrase from
380: memory (see security note below).
381: C-c p d pgp-decrypt-message Decrypts the PGP encrypted message in
382: the current buffer. Asks for passphrase.
383: C-c p e pgp-encrypt-message Encrypts the message in the current
384: buffer. Asks for recipient.
385: C-c p h pgp-help What you are reading right now.
386:
387: C-c p i pgp-insert-public-key-block Inserts your PGP Public Key Block at
388: point.
389: C-c p p pgp-set-passphrase Sets your PGP passphrase (see security
390: note below).
391: C-c p s pgp-sign-message Signs the message in the current buffer.
392: Uses CLEARSIG, asks for passphrase.
393: C-c p v pgp-validate-signature Checks the validity of the signature on
394: the message in the current buffer.
395: C-c p S pgp-sign-and-encrypt-message Signs and encrypts the message in the
396: current buffer.
397: C-c p x pgp-extract-public-key Attempts to add the PGP Public Key Block
398: in the current buffer to your keyring.
399:
400: WARNING! Security Holes:
401: People can see your PGP passphrase if:
402:
403: * You set pgp-passphrase via a setq.
404:
405: * Emacs crashes and leaves a core file; anyone with even a partial
406: understanding of hash tables can extract your pass phrase from the core.
407:
408: * Plus all the other normal Unix and/or X-Windows security holes.
409: "
410: (interactive)
411: (describe-function 'pgp-help))
412:
413:
414: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
415: ;;; Passphrase support. Some of this is blatantly taken from ange-ftp.el
416: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
417:
418: (defun pgp-read-passphrase (prompt &optional default)
419: "Read a password from the user. Echos a . for each character typed.
420: End with RET, LFD, or ESC. DEL or C-h rubs out. ^U kills line.
421: Optional DEFAULT is password to start with."
422: (let ((pass (if default default ""))
423: (c 0)
424: (echo-keystrokes 0)
425: (cursor-in-echo-area t))
426: (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
427: (message "%s%s"
428: prompt
429: (make-string (length pass) ?.))
430: (setq c (read-char))
431: (if (= c ?\C-u)
432: (setq pass "")
433: (if (and (/= c ?\b) (/= c ?\177))
434: (setq pass (concat pass (char-to-string c)))
435: (if (> (length pass) 0)
436: (setq pass (substring pass 0 -1))))))
437: (pgp-repaint-minibuffer)
438: (substring pass 0 -1)))
439:
440: (defun pgp-repaint-minibuffer ()
441: "Gross hack to set minibuf_message = 0, so that the contents of the
442: minibuffer will show."
443: (if (eq (selected-window) (minibuffer-window))
444: (if (fboundp 'allocate-event)
445: ;; lemacs
446: (let ((unread-command-event (character-to-event ?\C-m
447: (allocate-event)))
448: (enable-recursive-minibuffers t))
449: (read-from-minibuffer "" nil pgp-tmp-keymap nil))
450: ;; v18 GNU Emacs
451: (let ((unread-command-char ?\C-m)
452: (enable-recursive-minibuffers t))
453: (read-from-minibuffer "" nil pgp-tmp-keymap nil)))))
454:
455: (defun stripstrlist (l str)
456: "Strip from list-of-strings L any string which matches STR."
457: (cond (l (cond ((string-match str (car l))
458: (stripstrlist (cdr l) str))
459: (t (cons (car l) (stripstrlist (cdr l) str)))))))
460:
461: (defun pgp-set-passphrase (arg)
462: "Set PGPPASS environment variable from argument."
463: (interactive)
464: (setq arg
465: (pgp-read-passphrase "Enter pass phrase: " pgp-passphrase))
466: (setq process-environment
467: (cons (concat "PGPPASS=" arg)
468: (stripstrlist process-environment "^PGPPASS=")))
469: (setq pgp-passphrase arg)
470: )
471:
472: (defun pgp-clear-passphrase ()
473: "Clear PGPPASS environment variable."
474: (interactive)
475: (setq process-environment (stripstrlist process-environment "^PGPPASS="))
476: (setq pgp-passphrase nil)
477: )
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.