Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-pgp.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8fc7fe29b841
children c0c698873ce1
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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,1997 MORIOKA Tomohiko 3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
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>
6 ;; Created: 1995/12/7 7 ;; Created: 1995/12/7
7 ;; Version: $Id: tm-pgp.el,v 1.5 1997/02/16 01:29:33 steve Exp $ 8 ;; Version: $Id: tm-pgp.el,v 1.1.1.1 1996/12/18 22:43:38 steve Exp $
8 ;; Keywords: mail, news, MIME, multimedia, PGP, security 9 ;; Keywords: mail, news, MIME, multimedia, PGP, security
9 10
10 ;; This file is part of tm (Tools for MIME). 11 ;; This file is part of tm (Tools for MIME).
11 12
12 ;; This program is free software; you can redistribute it and/or 13 ;; This program is free software; you can redistribute it and/or
26 27
27 ;;; Commentary: 28 ;;; Commentary:
28 29
29 ;; This module is based on 2 drafts about PGP MIME integration: 30 ;; This module is based on 2 drafts about PGP MIME integration:
30 31
31 ;; - RFC 2015: "MIME Security with Pretty Good Privacy (PGP)" 32 ;; - draft-elkins-pem-pgp-04.txt
33 ;; ``MIME Security with Pretty Good Privacy (PGP)''
32 ;; by Michael Elkins <elkins@aero.org> (1996/6) 34 ;; by Michael Elkins <elkins@aero.org> (1996/6)
33 ;; 35 ;;
34 ;; - draft-kazu-pgp-mime-00.txt: "PGP MIME Integration" 36 ;; - draft-kazu-pgp-mime-00.txt
35 ;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> 37 ;; ``PGP MIME Integration''
36 ;; (1995/10; expired) 38 ;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10)
37 ;; 39 ;;
38 ;; These drafts may be contrary to each other. You should decide 40 ;; These drafts may be contrary to each other. You should decide
39 ;; which you support. (Maybe you should use PGP/MIME) 41 ;; which you support.
40 42
41 ;;; Code: 43 ;;; Code:
42 44
45 (require 'mailcrypt)
43 (require 'tm-play) 46 (require 'tm-play)
44 47
45 48
46 ;;; @ internal method for application/pgp 49 ;;; @ internal method for application/pgp
47 ;;; 50 ;;;
48 ;;; It is based on draft-kazu-pgp-mime-00.txt 51 ;;; It is based on draft-kazu-pgp-mime-00.txt
49 52
50 (defun mime-article/view-application/pgp (beg end cal) 53 (defun mime-article/view-application/pgp (beg end cal)
51 (let* ((cnum (mime-article/point-content-number beg)) 54 (let* ((cnum (mime-article/point-content-number beg))
52 (cur-buf (current-buffer)) 55 (cur-buf (current-buffer))
53 (p-win (or (get-buffer-window mime::article/preview-buffer)
54 (get-largest-window)))
55 (new-name (format "%s-%s" (buffer-name) cnum)) 56 (new-name (format "%s-%s" (buffer-name) cnum))
56 (mother mime::article/preview-buffer) 57 (mother mime::article/preview-buffer)
57 (mode major-mode) 58 (mode major-mode)
58 code-converter 59 code-converter str)
59 (str (buffer-substring beg end)) 60 (setq str (buffer-substring beg end))
60 ) 61 (switch-to-buffer new-name)
61 (set-buffer (get-buffer-create new-name))
62 (erase-buffer) 62 (erase-buffer)
63 (insert str) 63 (insert str)
64 (cond ((progn 64 (cond ((progn
65 (goto-char (point-min)) 65 (goto-char (point-min))
66 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) 66 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
67 ) 67 )
68 (funcall (pgp-function 'verify)) 68 (mc-verify)
69 (goto-char (point-min)) 69 (goto-char (point-min))
70 (delete-region 70 (delete-region
71 (point-min) 71 (point-min)
72 (and 72 (and
73 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n") 73 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
89 ) 89 )
90 ((progn 90 ((progn
91 (goto-char (point-min)) 91 (goto-char (point-min))
92 (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t) 92 (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)
93 ) 93 )
94 (as-binary-process (funcall (pgp-function 'decrypt))) 94 (as-binary-process (mc-decrypt))
95 (goto-char (point-min)) 95 (goto-char (point-min))
96 (delete-region (point-min) 96 (delete-region (point-min)
97 (and 97 (and
98 (search-forward "\n\n") 98 (search-forward "\n\n")
99 (match-end 0))) 99 (match-end 0)))
100 (setq code-converter (function mime-charset/decode-buffer)) 100 (setq code-converter (function mime-charset/decode-buffer))
101 )) 101 ))
102 (setq major-mode 'mime/show-message-mode) 102 (setq major-mode 'mime/show-message-mode)
103 (setq mime::article/code-converter code-converter) 103 (setq mime::article/code-converter code-converter)
104 (save-window-excursion (mime/viewer-mode mother)) 104 (mime/viewer-mode mother)
105 (set-window-buffer p-win mime::article/preview-buffer)
106 )) 105 ))
107 106
108 (set-atype 'mime/content-decoding-condition 107 (set-atype 'mime/content-decoding-condition
109 '((type . "application/pgp") 108 '((type . "application/pgp")
110 (method . mime-article/view-application/pgp) 109 (method . mime-article/view-application/pgp)
116 )) 115 ))
117 116
118 117
119 ;;; @ Internal method for application/pgp-signature 118 ;;; @ Internal method for application/pgp-signature
120 ;;; 119 ;;;
121 ;;; It is based on RFC 2015. 120 ;;; It is based on draft-elkins-pem-pgp-02.txt
122 121
123 (defvar tm-pgp::default-language 'en 122 (defvar tm-pgp::default-language 'en
124 "*Symbol of language for pgp. 123 "*Symbol of language for pgp.
125 It should be ISO 639 2 letter language code such as en, ja, ...") 124 It should be ISO 639 2 letter language code such as en, ja, ...")
126 125
185 (insert str) 184 (insert str)
186 (goto-char (point-min)) 185 (goto-char (point-min))
187 (while (re-search-forward "\n" nil t) 186 (while (re-search-forward "\n" nil t)
188 (replace-match "\r\n") 187 (replace-match "\r\n")
189 ) 188 )
190 (as-binary-output-file (write-file orig-file)) 189 (let ((mc-flag nil) ; for Mule
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 )
191 (kill-buffer (current-buffer)) 198 (kill-buffer (current-buffer))
192 ) 199 )
193 (save-excursion 200 (save-excursion
194 (mime-article/show-output-buffer) 201 (mime-article/show-output-buffer)
195 ) 202 )
201 (match-end 0))) 208 (match-end 0)))
202 end)) 209 end))
203 (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name))) 210 (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name)))
204 (insert str) 211 (insert str)
205 (mime-decode-region (point-min)(point-max) encoding) 212 (mime-decode-region (point-min)(point-max) encoding)
206 (as-binary-output-file (write-file sig-file)) 213 (let ((mc-flag nil) ; for Mule
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)
207 (or (mime::article/call-pgp-to-check-signature 223 (or (mime::article/call-pgp-to-check-signature
208 mime/output-buffer-name orig-file) 224 mime/output-buffer-name orig-file)
209 (let (pgp-id) 225 (let (pgp-id)
210 (save-excursion 226 (save-excursion
211 (set-buffer mime/output-buffer-name) 227 (set-buffer mime/output-buffer-name)
225 (if (and pgp-id 241 (if (and pgp-id
226 (y-or-n-p 242 (y-or-n-p
227 (format "Key %s not found; attempt to fetch? " pgp-id)) 243 (format "Key %s not found; attempt to fetch? " pgp-id))
228 ) 244 )
229 (progn 245 (progn
230 (funcall (pgp-function 'fetch-key) (cons nil pgp-id)) 246 (mc-pgp-fetch-key (cons nil pgp-id))
231 (mime::article/call-pgp-to-check-signature 247 (mime::article/call-pgp-to-check-signature
232 mime/output-buffer-name orig-file) 248 mime/output-buffer-name orig-file)
233 )) 249 ))
234 )) 250 ))
235 (let ((other-window-scroll-buffer mime/output-buffer-name)) 251 (let ((other-window-scroll-buffer mime/output-buffer-name))
246 )) 262 ))
247 263
248 264
249 ;;; @ Internal method for application/pgp-encrypted 265 ;;; @ Internal method for application/pgp-encrypted
250 ;;; 266 ;;;
251 ;;; It is based on RFC 2015. 267 ;;; It is based on draft-elkins-pem-pgp-02.txt
252 268
253 (defun mime-article/decrypt-pgp (beg end cal) 269 (defun mime-article/decrypt-pgp (beg end cal)
254 (let* ((cnum (mime-article/point-content-number beg)) 270 (let* ((cnum (mime-article/point-content-number beg))
255 (rcnum (reverse cnum)) 271 (rcnum (reverse cnum))
256 (rmcnum (cdr rcnum)) 272 (rmcnum (cdr rcnum))
272 )) 288 ))
273 289
274 290
275 ;;; @ Internal method for application/pgp-keys 291 ;;; @ Internal method for application/pgp-keys
276 ;;; 292 ;;;
277 ;;; It is based on RFC 2015. 293 ;;; It is based on draft-elkins-pem-pgp-02.txt
294
295 (autoload 'mc-snarf-keys "mc-toplev")
278 296
279 (defun mime-article/add-pgp-keys (beg end cal) 297 (defun mime-article/add-pgp-keys (beg end cal)
280 (let* ((cnum (mime-article/point-content-number beg)) 298 (let* ((cnum (mime-article/point-content-number beg))
281 (cur-buf (current-buffer)) 299 (cur-buf (current-buffer))
282 (new-name (format "%s-%s" (buffer-name) cnum)) 300 (new-name (format "%s-%s" (buffer-name) cnum))
293 (goto-char (point-min)) 311 (goto-char (point-min))
294 (if (re-search-forward "^\n" nil t) 312 (if (re-search-forward "^\n" nil t)
295 (delete-region (point-min) (match-end 0)) 313 (delete-region (point-min) (match-end 0))
296 ) 314 )
297 (mime-decode-region (point-min)(point-max) encoding) 315 (mime-decode-region (point-min)(point-max) encoding)
298 (funcall (pgp-function 'snarf-keys)) 316 (mc-snarf-keys)
299 (kill-buffer (current-buffer)) 317 (kill-buffer (current-buffer))
300 )) 318 ))
301 319
302 (set-atype 'mime/content-decoding-condition 320 (set-atype 'mime/content-decoding-condition
303 '((type . "application/pgp-keys") 321 '((type . "application/pgp-keys")