Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-pgp.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents 0293115a14e9
children 131b0175ea99
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
2 2
3 ;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko 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 ;; Created: 1995/12/7 6 ;; Created: 1995/12/7
7 ;; Version: $Id: tm-pgp.el,v 1.4 1997/02/02 05:06:20 steve Exp $ 7 ;; Version: $Id: tm-pgp.el,v 1.5 1997/02/16 01:29:33 steve Exp $
8 ;; Keywords: mail, news, MIME, multimedia, PGP, security 8 ;; Keywords: mail, news, MIME, multimedia, PGP, security
9 9
10 ;; This file is part of tm (Tools for MIME). 10 ;; This file is part of tm (Tools for MIME).
11 11
12 ;; This program is free software; you can redistribute it and/or 12 ;; This program is free software; you can redistribute it and/or
40 40
41 ;;; Code: 41 ;;; Code:
42 42
43 (require 'tm-play) 43 (require 'tm-play)
44 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")
61
62 45
63 ;;; @ internal method for application/pgp 46 ;;; @ internal method for application/pgp
64 ;;; 47 ;;;
65 ;;; It is based on draft-kazu-pgp-mime-00.txt 48 ;;; It is based on draft-kazu-pgp-mime-00.txt
66 49
67 (defun mime-article/view-application/pgp (beg end cal) 50 (defun mime-article/view-application/pgp (beg end cal)
68 (let* ((cnum (mime-article/point-content-number beg)) 51 (let* ((cnum (mime-article/point-content-number beg))
69 (cur-buf (current-buffer)) 52 (cur-buf (current-buffer))
53 (p-win (or (get-buffer-window mime::article/preview-buffer)
54 (get-largest-window)))
70 (new-name (format "%s-%s" (buffer-name) cnum)) 55 (new-name (format "%s-%s" (buffer-name) cnum))
71 (mother mime::article/preview-buffer) 56 (mother mime::article/preview-buffer)
72 (mode major-mode) 57 (mode major-mode)
73 code-converter 58 code-converter
74 (str (buffer-substring beg end)) 59 (str (buffer-substring beg end))
75 ) 60 )
76 (switch-to-buffer new-name) 61 (set-buffer (get-buffer-create new-name))
77 (erase-buffer) 62 (erase-buffer)
78 (insert str) 63 (insert str)
79 (cond ((progn 64 (cond ((progn
80 (goto-char (point-min)) 65 (goto-char (point-min))
81 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) 66 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
82 ) 67 )
83 (funcall pgp-verify-function) 68 (funcall (pgp-function 'verify))
84 (goto-char (point-min)) 69 (goto-char (point-min))
85 (delete-region 70 (delete-region
86 (point-min) 71 (point-min)
87 (and 72 (and
88 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n") 73 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
104 ) 89 )
105 ((progn 90 ((progn
106 (goto-char (point-min)) 91 (goto-char (point-min))
107 (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t) 92 (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)
108 ) 93 )
109 (as-binary-process (funcall pgp-decrypt-function)) 94 (as-binary-process (funcall (pgp-function 'decrypt)))
110 (goto-char (point-min)) 95 (goto-char (point-min))
111 (delete-region (point-min) 96 (delete-region (point-min)
112 (and 97 (and
113 (search-forward "\n\n") 98 (search-forward "\n\n")
114 (match-end 0))) 99 (match-end 0)))
115 (setq code-converter (function mime-charset/decode-buffer)) 100 (setq code-converter (function mime-charset/decode-buffer))
116 )) 101 ))
117 (setq major-mode 'mime/show-message-mode) 102 (setq major-mode 'mime/show-message-mode)
118 (setq mime::article/code-converter code-converter) 103 (setq mime::article/code-converter code-converter)
119 (mime/viewer-mode mother) 104 (save-window-excursion (mime/viewer-mode mother))
105 (set-window-buffer p-win mime::article/preview-buffer)
120 )) 106 ))
121 107
122 (set-atype 'mime/content-decoding-condition 108 (set-atype 'mime/content-decoding-condition
123 '((type . "application/pgp") 109 '((type . "application/pgp")
124 (method . mime-article/view-application/pgp) 110 (method . mime-article/view-application/pgp)
239 (if (and pgp-id 225 (if (and pgp-id
240 (y-or-n-p 226 (y-or-n-p
241 (format "Key %s not found; attempt to fetch? " pgp-id)) 227 (format "Key %s not found; attempt to fetch? " pgp-id))
242 ) 228 )
243 (progn 229 (progn
244 (funcall pgp-fetch-key-function (cons nil pgp-id)) 230 (funcall (pgp-function 'fetch-key) (cons nil pgp-id))
245 (mime::article/call-pgp-to-check-signature 231 (mime::article/call-pgp-to-check-signature
246 mime/output-buffer-name orig-file) 232 mime/output-buffer-name orig-file)
247 )) 233 ))
248 )) 234 ))
249 (let ((other-window-scroll-buffer mime/output-buffer-name)) 235 (let ((other-window-scroll-buffer mime/output-buffer-name))
307 (goto-char (point-min)) 293 (goto-char (point-min))
308 (if (re-search-forward "^\n" nil t) 294 (if (re-search-forward "^\n" nil t)
309 (delete-region (point-min) (match-end 0)) 295 (delete-region (point-min) (match-end 0))
310 ) 296 )
311 (mime-decode-region (point-min)(point-max) encoding) 297 (mime-decode-region (point-min)(point-max) encoding)
312 (funcall pgp-snarf-keys-function) 298 (funcall (pgp-function 'snarf-keys))
313 (kill-buffer (current-buffer)) 299 (kill-buffer (current-buffer))
314 )) 300 ))
315 301
316 (set-atype 'mime/content-decoding-condition 302 (set-atype 'mime/content-decoding-condition
317 '((type . "application/pgp-keys") 303 '((type . "application/pgp-keys")