Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-pgp.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 49a24b4fd526
children 8fc7fe29b841
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; tm-pgp.el --- tm-view internal methods for PGP. 1 ;;; tm-pgp.el --- tm-view internal methods for PGP.
2 2
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
4 4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Created: 1995/12/7 6 ;; Created: 1995/12/7
8 ;; Version: $Id: tm-pgp.el,v 1.3 1996/12/29 00:15:14 steve Exp $ 7 ;; Version: $Id: tm-pgp.el,v 1.4 1997/02/02 05:06:20 steve Exp $
9 ;; Keywords: mail, news, MIME, multimedia, PGP, security 8 ;; Keywords: mail, news, MIME, multimedia, PGP, security
10 9
11 ;; This file is part of tm (Tools for MIME). 10 ;; This file is part of tm (Tools for MIME).
12 11
13 ;; This program is free software; you can redistribute it and/or 12 ;; This program is free software; you can redistribute it and/or
27 26
28 ;;; Commentary: 27 ;;; Commentary:
29 28
30 ;; This module is based on 2 drafts about PGP MIME integration: 29 ;; This module is based on 2 drafts about PGP MIME integration:
31 30
32 ;; - draft-elkins-pem-pgp-04.txt 31 ;; - RFC 2015: "MIME Security with Pretty Good Privacy (PGP)"
33 ;; ``MIME Security with Pretty Good Privacy (PGP)''
34 ;; by Michael Elkins <elkins@aero.org> (1996/6) 32 ;; by Michael Elkins <elkins@aero.org> (1996/6)
35 ;; 33 ;;
36 ;; - draft-kazu-pgp-mime-00.txt 34 ;; - draft-kazu-pgp-mime-00.txt: "PGP MIME Integration"
37 ;; ``PGP MIME Integration'' 35 ;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp>
38 ;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10) 36 ;; (1995/10; expired)
39 ;; 37 ;;
40 ;; These drafts may be contrary to each other. You should decide 38 ;; These drafts may be contrary to each other. You should decide
41 ;; which you support. 39 ;; which you support. (Maybe you should use PGP/MIME)
42 40
43 ;;; Code: 41 ;;; Code:
44 42
45 (require 'mailcrypt)
46 (require 'tm-play) 43 (require 'tm-play)
44
45 (defvar pgp-verify-function
46 'mc-verify "*PGP verify function.")
47
48 (defvar pgp-decrypt-function
49 'mc-decrypt "*PGP decrypt function.")
50
51 (defvar pgp-fetch-key-function
52 'mc-pgp-fetch-key "*PGP fetch key function.")
53
54 (defvar pgp-snarf-keys-function
55 'mc-snarf-keys "*PGP snarf keys function.")
56
57 (autoload pgp-verify-function "mc-toplev")
58 (autoload pgp-decrypt-function "mc-toplev")
59 (autoload pgp-fetch-key-function "mc-toplev")
60 (autoload pgp-snarf-keys-function "mc-toplev")
47 61
48 62
49 ;;; @ internal method for application/pgp 63 ;;; @ internal method for application/pgp
50 ;;; 64 ;;;
51 ;;; It is based on draft-kazu-pgp-mime-00.txt 65 ;;; It is based on draft-kazu-pgp-mime-00.txt
54 (let* ((cnum (mime-article/point-content-number beg)) 68 (let* ((cnum (mime-article/point-content-number beg))
55 (cur-buf (current-buffer)) 69 (cur-buf (current-buffer))
56 (new-name (format "%s-%s" (buffer-name) cnum)) 70 (new-name (format "%s-%s" (buffer-name) cnum))
57 (mother mime::article/preview-buffer) 71 (mother mime::article/preview-buffer)
58 (mode major-mode) 72 (mode major-mode)
59 code-converter str) 73 code-converter
60 (setq str (buffer-substring beg end)) 74 (str (buffer-substring beg end))
75 )
61 (switch-to-buffer new-name) 76 (switch-to-buffer new-name)
62 (erase-buffer) 77 (erase-buffer)
63 (insert str) 78 (insert str)
64 (cond ((progn 79 (cond ((progn
65 (goto-char (point-min)) 80 (goto-char (point-min))
66 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) 81 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
67 ) 82 )
68 (mc-verify) 83 (funcall pgp-verify-function)
69 (goto-char (point-min)) 84 (goto-char (point-min))
70 (delete-region 85 (delete-region
71 (point-min) 86 (point-min)
72 (and 87 (and
73 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n") 88 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
89 ) 104 )
90 ((progn 105 ((progn
91 (goto-char (point-min)) 106 (goto-char (point-min))
92 (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t) 107 (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)
93 ) 108 )
94 (as-binary-process (mc-decrypt)) 109 (as-binary-process (funcall pgp-decrypt-function))
95 (goto-char (point-min)) 110 (goto-char (point-min))
96 (delete-region (point-min) 111 (delete-region (point-min)
97 (and 112 (and
98 (search-forward "\n\n") 113 (search-forward "\n\n")
99 (match-end 0))) 114 (match-end 0)))
115 )) 130 ))
116 131
117 132
118 ;;; @ Internal method for application/pgp-signature 133 ;;; @ Internal method for application/pgp-signature
119 ;;; 134 ;;;
120 ;;; It is based on draft-elkins-pem-pgp-02.txt 135 ;;; It is based on RFC 2015.
121 136
122 (defvar tm-pgp::default-language 'en 137 (defvar tm-pgp::default-language 'en
123 "*Symbol of language for pgp. 138 "*Symbol of language for pgp.
124 It should be ISO 639 2 letter language code such as en, ja, ...") 139 It should be ISO 639 2 letter language code such as en, ja, ...")
125 140
184 (insert str) 199 (insert str)
185 (goto-char (point-min)) 200 (goto-char (point-min))
186 (while (re-search-forward "\n" nil t) 201 (while (re-search-forward "\n" nil t)
187 (replace-match "\r\n") 202 (replace-match "\r\n")
188 ) 203 )
189 (let ((mc-flag nil) ; for Mule 204 (as-binary-output-file (write-file orig-file))
190 (file-coding-system *noconv*)
191 kanji-flag ; for NEmacs
192 (emx-binary-mode t) ; for OS/2
193 jka-compr-compression-info-list ; for jka-compr
194 jam-zcat-filename-list ; for jam-zcat
195 require-final-newline)
196 (write-file orig-file)
197 )
198 (kill-buffer (current-buffer)) 205 (kill-buffer (current-buffer))
199 ) 206 )
200 (save-excursion 207 (save-excursion
201 (mime-article/show-output-buffer) 208 (mime-article/show-output-buffer)
202 ) 209 )
208 (match-end 0))) 215 (match-end 0)))
209 end)) 216 end))
210 (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name))) 217 (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name)))
211 (insert str) 218 (insert str)
212 (mime-decode-region (point-min)(point-max) encoding) 219 (mime-decode-region (point-min)(point-max) encoding)
213 (let ((mc-flag nil) ; for Mule 220 (as-binary-output-file (write-file sig-file))
214 (file-coding-system *noconv*)
215 kanji-flag ; for NEmacs
216 (emx-binary-mode t) ; for OS/2
217 jka-compr-compression-info-list ; for jka-compr
218 jam-zcat-filename-list ; for jam-zcat
219 require-final-newline)
220 (write-file sig-file)
221 )
222 ;;(get-buffer-create mime/output-buffer-name)
223 (or (mime::article/call-pgp-to-check-signature 221 (or (mime::article/call-pgp-to-check-signature
224 mime/output-buffer-name orig-file) 222 mime/output-buffer-name orig-file)
225 (let (pgp-id) 223 (let (pgp-id)
226 (save-excursion 224 (save-excursion
227 (set-buffer mime/output-buffer-name) 225 (set-buffer mime/output-buffer-name)
241 (if (and pgp-id 239 (if (and pgp-id
242 (y-or-n-p 240 (y-or-n-p
243 (format "Key %s not found; attempt to fetch? " pgp-id)) 241 (format "Key %s not found; attempt to fetch? " pgp-id))
244 ) 242 )
245 (progn 243 (progn
246 (mc-pgp-fetch-key (cons nil pgp-id)) 244 (funcall pgp-fetch-key-function (cons nil pgp-id))
247 (mime::article/call-pgp-to-check-signature 245 (mime::article/call-pgp-to-check-signature
248 mime/output-buffer-name orig-file) 246 mime/output-buffer-name orig-file)
249 )) 247 ))
250 )) 248 ))
251 (let ((other-window-scroll-buffer mime/output-buffer-name)) 249 (let ((other-window-scroll-buffer mime/output-buffer-name))
262 )) 260 ))
263 261
264 262
265 ;;; @ Internal method for application/pgp-encrypted 263 ;;; @ Internal method for application/pgp-encrypted
266 ;;; 264 ;;;
267 ;;; It is based on draft-elkins-pem-pgp-02.txt 265 ;;; It is based on RFC 2015.
268 266
269 (defun mime-article/decrypt-pgp (beg end cal) 267 (defun mime-article/decrypt-pgp (beg end cal)
270 (let* ((cnum (mime-article/point-content-number beg)) 268 (let* ((cnum (mime-article/point-content-number beg))
271 (rcnum (reverse cnum)) 269 (rcnum (reverse cnum))
272 (rmcnum (cdr rcnum)) 270 (rmcnum (cdr rcnum))
288 )) 286 ))
289 287
290 288
291 ;;; @ Internal method for application/pgp-keys 289 ;;; @ Internal method for application/pgp-keys
292 ;;; 290 ;;;
293 ;;; It is based on draft-elkins-pem-pgp-02.txt 291 ;;; It is based on RFC 2015.
294
295 (autoload 'mc-snarf-keys "mc-toplev")
296 292
297 (defun mime-article/add-pgp-keys (beg end cal) 293 (defun mime-article/add-pgp-keys (beg end cal)
298 (let* ((cnum (mime-article/point-content-number beg)) 294 (let* ((cnum (mime-article/point-content-number beg))
299 (cur-buf (current-buffer)) 295 (cur-buf (current-buffer))
300 (new-name (format "%s-%s" (buffer-name) cnum)) 296 (new-name (format "%s-%s" (buffer-name) cnum))
311 (goto-char (point-min)) 307 (goto-char (point-min))
312 (if (re-search-forward "^\n" nil t) 308 (if (re-search-forward "^\n" nil t)
313 (delete-region (point-min) (match-end 0)) 309 (delete-region (point-min) (match-end 0))
314 ) 310 )
315 (mime-decode-region (point-min)(point-max) encoding) 311 (mime-decode-region (point-min)(point-max) encoding)
316 (mc-snarf-keys) 312 (funcall pgp-snarf-keys-function)
317 (kill-buffer (current-buffer)) 313 (kill-buffer (current-buffer))
318 )) 314 ))
319 315
320 (set-atype 'mime/content-decoding-condition 316 (set-atype 'mime/content-decoding-condition
321 '((type . "application/pgp-keys") 317 '((type . "application/pgp-keys")