187e4ece6c6edee2f2b1965aafb4b820c6c3a8ef
[elisp/semi.git] / mime-pgp.el
1 ;;; mime-pgp.el --- mime-view internal methods for PGP.
2
3 ;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
4
5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
6 ;;      Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
7 ;; Created: 1995/12/7
8 ;;      Renamed: 1997/2/27 from tm-pgp.el
9 ;; Keywords: PGP, security, MIME, multimedia, mail, news
10
11 ;; This file is part of SEMI (Secure Emacs MIME Interface).
12
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
17
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 ;; 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; see the file COPYING.  If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
27
28 ;;; Commentary:
29
30 ;;    This module is based on
31
32 ;;      [security-multipart] RFC 1847: "Security Multiparts for MIME:
33 ;;          Multipart/Signed and Multipart/Encrypted" by
34 ;;          Jim Galvin <galvin@tis.com>, Sandy Murphy <sandy@tis.com>,
35 ;;          Steve Crocker <crocker@cybercash.com> and
36 ;;          Ned Freed <ned@innosoft.com> (1995/10)
37
38 ;;      [PGP/MIME] RFC 2015: "MIME Security with Pretty Good Privacy
39 ;;          (PGP)" by Michael Elkins <elkins@aero.org> (1996/6)
40
41 ;;      [PGP-kazu] draft-kazu-pgp-mime-00.txt: "PGP MIME Integration"
42 ;;          by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
43 ;;          expired)
44
45 ;;      [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
46 ;;          Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
47 ;;          <kazu@iijlab.net> (1998/1)
48
49 ;;; Code:
50
51 (require 'mime-play)
52 (require 'pgg-def)
53
54 (autoload 'pgg-decrypt-region "pgg"
55   "PGP decryption of current region." t)
56 (autoload 'pgg-verify-region "pgg"
57   "PGP verification of current region." t)
58 (autoload 'pgg-snarf-keys-region "pgg"
59   "Snarf PGP public keys in current region." t)
60 (autoload 'smime-decrypt-region "smime"
61   "S/MIME decryption of current region.")
62 (autoload 'smime-verify-region "smime"
63   "S/MIME verification of current region.")
64 (defvar smime-output-buffer)
65 (defvar smime-errors-buffer)
66
67
68 ;;; @ Internal method for multipart/signed
69 ;;;
70 ;;; It is based on RFC 1847 (security-multipart).
71
72 (defun mime-verify-multipart/signed (entity situation)
73   "Internal method to verify multipart/signed."
74   (mime-play-entity
75    (nth 1 (mime-entity-children entity)) ; entity-info of signature
76    (list (assq 'mode situation)) ; play-mode
77    ))
78
79
80 ;;; @ internal method for application/pgp
81 ;;;
82 ;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu).
83
84 (defun mime-view-application/pgp (entity situation)
85   (let* ((p-win (or (get-buffer-window (current-buffer))
86                     (get-largest-window)))
87          (new-name
88           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
89          (mother (current-buffer))
90          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
91          representation-type message-buf)
92     (set-buffer (setq message-buf (get-buffer-create new-name)))
93     (erase-buffer)
94     (mime-insert-entity entity)
95     (cond ((progn
96              (goto-char (point-min))
97              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
98            (pgg-verify-region (match-beginning 0)(point-max) nil 'fetch)
99            (goto-char (point-min))
100            (delete-region
101             (point-min)
102             (and
103              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
104              (match-end 0)))
105            (delete-region
106             (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
107                  (match-beginning 0))
108             (point-max))
109            (goto-char (point-min))
110            (while (re-search-forward "^- -" nil t)
111              (replace-match "-"))
112            (setq representation-type (if (mime-entity-cooked-p entity)
113                                          'cooked)))
114           ((progn
115              (goto-char (point-min))
116              (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
117            (pgg-decrypt-region (point-min)(point-max))
118            (delete-region (point-min)(point-max))
119            (insert-buffer pgg-output-buffer)
120            (setq representation-type 'binary)))
121     (setq major-mode 'mime-show-message-mode)
122     (save-window-excursion
123       (mime-view-buffer nil preview-buffer mother
124                         nil representation-type)
125       (make-local-variable 'mime-view-temp-message-buffer)
126       (setq mime-view-temp-message-buffer message-buf))
127     (set-window-buffer p-win preview-buffer)))
128
129
130 ;;; @ Internal method for application/pgp-signature
131 ;;;
132 ;;; It is based on RFC 2015 (PGP/MIME) and
133 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
134
135 (defun mime-verify-application/pgp-signature (entity situation)
136   "Internal method to check PGP/MIME signature."
137   (let* ((entity-node-id (mime-entity-node-id entity))
138          (mother (mime-entity-parent entity))
139          (knum (car entity-node-id))
140          (onum (if (> knum 0)
141                    (1- knum)
142                  (1+ knum)))
143          (orig-entity (nth onum (mime-entity-children mother)))
144          (sig-file (make-temp-file "tm" nil ".asc"))
145          status)
146     (save-excursion 
147       (mime-show-echo-buffer)
148       (set-buffer mime-echo-buffer-name)
149       (set-window-start 
150        (get-buffer-window mime-echo-buffer-name)
151        (point-max)))
152     (mime-write-entity-content entity sig-file)
153     (unwind-protect
154         (with-temp-buffer
155           (mime-insert-entity orig-entity)
156           (goto-char (point-min))
157           (while (progn (end-of-line) (not (eobp)))
158             (insert "\r")
159             (forward-line 1))
160           (setq status (pgg-verify-region (point-min)(point-max) 
161                                           sig-file 'fetch))
162           (save-excursion 
163             (set-buffer mime-echo-buffer-name)
164             (insert-buffer-substring (if status pgg-output-buffer
165                                        pgg-errors-buffer))))
166       (delete-file sig-file))))
167
168
169 ;;; @ Internal method for application/pgp-encrypted
170 ;;;
171 ;;; It is based on RFC 2015 (PGP/MIME) and
172 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
173
174 (defun mime-decrypt-application/pgp-encrypted (entity situation)
175   (let* ((entity-node-id (mime-entity-node-id entity))
176          (mother (mime-entity-parent entity))
177          (knum (car entity-node-id))
178          (onum (if (> knum 0)
179                    (1- knum)
180                  (1+ knum)))
181          (orig-entity (nth onum (mime-entity-children mother))))
182     (mime-view-application/pgp orig-entity situation)))
183
184
185 ;;; @ Internal method for application/pgp-keys
186 ;;;
187 ;;; It is based on RFC 2015 (PGP/MIME) and
188 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
189
190 (defun mime-add-application/pgp-keys (entity situation)
191   (save-excursion 
192     (mime-show-echo-buffer)
193     (set-buffer mime-echo-buffer-name)
194     (set-window-start 
195      (get-buffer-window mime-echo-buffer-name)
196      (point-max)))
197   (with-temp-buffer
198     (mime-insert-entity-content entity)
199     (mime-decode-region (point-min) (point-max)
200                         (cdr (assq 'encoding situation)))
201     (let ((status (pgg-snarf-keys-region (point-min)(point-max))))
202       (save-excursion 
203         (set-buffer mime-echo-buffer-name)
204         (insert-buffer-substring (if status pgg-output-buffer
205                                    pgg-errors-buffer))))))
206
207
208 ;;; @ Internal method for application/pkcs7-signature
209 ;;;
210 ;;; It is based on RFC 2633 (S/MIME version 3).
211
212 (defun mime-verify-application/pkcs7-signature (entity situation)
213   "Internal method to check S/MIME signature."
214   (let* ((entity-node-id (mime-entity-node-id entity))
215          (mother (mime-entity-parent entity))
216          (knum (car entity-node-id))
217          (onum (if (> knum 0)
218                    (1- knum)
219                  (1+ knum)))
220          (orig-entity (nth onum (mime-entity-children mother)))
221          (sig-file (make-temp-file "tm" nil ".asc"))
222          status)
223     (save-excursion 
224       (mime-show-echo-buffer)
225       (set-buffer mime-echo-buffer-name)
226       (set-window-start 
227        (get-buffer-window mime-echo-buffer-name)
228        (point-max)))
229     (mime-write-entity entity sig-file)
230     (unwind-protect
231         (with-temp-buffer
232           (mime-insert-entity orig-entity)
233           (goto-char (point-min))
234           (while (progn (end-of-line) (not (eobp)))
235             (insert "\r")
236             (forward-line 1))
237           (setq status (smime-verify-region (point-min)(point-max) 
238                                             sig-file))
239           (save-excursion 
240             (set-buffer mime-echo-buffer-name)
241             (insert-buffer-substring (if status smime-output-buffer
242                                        smime-errors-buffer))))
243       (delete-file sig-file))))
244
245
246 ;;; @ Internal method for application/pkcs7-mime
247 ;;;
248 ;;; It is based on RFC 2633 (S/MIME version 3).
249
250 (defun mime-view-application/pkcs7-mime (entity situation)
251   (let* ((p-win (or (get-buffer-window (current-buffer))
252                     (get-largest-window)))
253          (new-name
254           (format "%s-%s" (buffer-name) (mime-entity-number entity)))
255          (mother (current-buffer))
256          (preview-buffer (concat "*Preview-" (buffer-name) "*"))
257          message-buf)
258     (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data)
259                 '(enveloped-data signed-data))
260       (set-buffer (setq message-buf (get-buffer-create new-name)))
261       (let ((inhibit-read-only t)
262             buffer-read-only)
263         (erase-buffer)
264         (mime-insert-entity entity)
265         (smime-decrypt-region (point-min)(point-max))
266         (delete-region (point-min)(point-max))
267         (insert-buffer smime-output-buffer))
268       (setq major-mode 'mime-show-message-mode)
269       (save-window-excursion
270         (mime-view-buffer nil preview-buffer mother
271                           nil 'binary)
272         (make-local-variable 'mime-view-temp-message-buffer)
273         (setq mime-view-temp-message-buffer message-buf))
274       (set-window-buffer p-win preview-buffer))))
275
276
277 ;;; @ end
278 ;;;
279
280 (provide 'mime-pgp)
281
282 (run-hooks 'mime-pgp-load-hook)
283
284 ;;; mime-pgp.el ends here