This commit was generated by cvs2svn to compensate for changes in r272,
[elisp/tm.git] / tm-pgp.el
1 ;;;
2 ;;; tm-pgp.el --- tm-view internal methods for PGP.
3 ;;;
4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;;; Copyright (C) 1995 MORIOKA Tomohiko
6 ;;;
7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
9 ;;; Created: 1995/12/7
10 ;;; Version:
11 ;;;     $Id: tm-pgp.el,v 4.0 1995/12/09 08:37:21 morioka Exp $
12 ;;; Keywords: mail, news, MIME, multimedia, PGP, security
13 ;;;
14 ;;; This file is part of tm (Tools for MIME).
15 ;;;
16 ;;; This program is free software; you can redistribute it and/or
17 ;;; modify it under the terms of the GNU General Public License as
18 ;;; published by the Free Software Foundation; either version 2, or
19 ;;; (at your option) any later version.
20 ;;;
21 ;;; This program is distributed in the hope that it will be useful,
22 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
24 ;;; General Public License for more details.
25 ;;;
26 ;;; You should have received a copy of the GNU General Public License
27 ;;; along with This program.  If not, write to the Free Software
28 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
29 ;;;
30 ;;; Commentary:
31 ;;;    This module is based on 2 drafts about PGP MIME integration:
32 ;;;     - draft-elkins-pem-pgp-01.txt
33 ;;;             ``MIME Security with Pretty Good Privacy (PGP)''
34 ;;;             by Michael Elkins <elkins@aero.org> (1995/9)
35 ;;;     - draft-kazu-pgp-mime-00.txt
36 ;;;             ``PGP MIME Integration''
37 ;;;             by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10)
38 ;;;    These drafts may be contrary to each other. You should decide
39 ;;;  which you support.
40 ;;;
41 ;;; Code:
42
43 (require 'mailcrypt)
44 (require 'tm-play)
45
46
47 ;;; @ internal method for application/pgp
48 ;;;
49 ;;; It is based on draft-kazu-pgp-mime-00.txt
50
51 (defun mime-article/view-application/pgp (beg end cal)
52   (let* ((cnum (mime-article/point-content-number beg))
53          (cur-buf (current-buffer))
54          (new-name (format "%s-%s" (buffer-name) cnum))
55          (mother mime::article/preview-buffer)
56          (code-converter
57           (or (cdr (assq major-mode mime-viewer/code-converter-alist))
58               'mime-viewer/default-code-convert-region))
59          str)
60     (setq str (buffer-substring beg end))
61     (switch-to-buffer new-name)
62     (erase-buffer)
63     (insert str)
64     (cond ((progn
65              (goto-char (point-min))
66              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
67              )
68            (mc-verify)
69            (goto-char (point-min))
70            (delete-region
71             (point-min)
72             (and
73              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
74              (match-end 0))
75             )
76            (delete-region
77             (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
78                  (match-beginning 0))
79             (point-max)
80             )
81            (goto-char (point-min))
82            (while (re-search-forward "^- -" nil t)
83              (replace-match "-")
84              )
85            )
86           ((progn
87              (goto-char (point-min))
88              (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)
89              )
90            (mc-decrypt)
91            (goto-char (point-min))
92            (delete-region (point-min)
93                           (and
94                            (search-forward "\n\n")
95                            (match-end 0)))
96            ))
97     (setq major-mode 'mime/show-message-mode)
98     (setq mime::article/code-converter code-converter)
99     (mime/viewer-mode mother)
100     ))
101
102 (set-atype 'mime/content-decoding-condition
103            '((type . "application/pgp")
104              (method . mime-article/view-application/pgp)
105              ))
106
107
108 ;;; @ Internal method for application/pgp-signature
109 ;;;
110 ;;; It is based on draft-elkins-pem-pgp-01.txt
111
112 (defun mime-article/check-pgp-signature (beg end cal)
113   (let* ((cnum (mime-article/point-content-number beg))
114          (rcnum (reverse cnum))
115          (rmcnum (cdr rcnum))
116          (knum (car rcnum))
117          (onum (if (>= knum 0)
118                    (1- knum)
119                  (1+ knum)))
120          (oinfo (mime-article/rcnum-to-cinfo (cons onum rmcnum)
121                                              mime::article/content-info))
122          status str kbuf
123          (basename (expand-file-name "tm" mime/tmp-dir))
124          (orig-file (make-temp-name basename))
125          (sig-file (concat orig-file ".sig"))
126          )
127     (save-excursion
128       (setq str (buffer-substring
129                  (mime::content-info/point-min oinfo)
130                  (mime::content-info/point-max oinfo)
131                  ))
132       (set-buffer (get-buffer-create mime/temp-buffer-name))
133       (insert str)
134       (goto-char (point-min))
135       (while (re-search-forward "\n" nil t)
136         (replace-match "\r\n")
137         )
138       (write-file orig-file)
139       (kill-buffer (current-buffer))
140       )
141     (save-excursion
142       (setq str (buffer-substring
143                  (save-excursion
144                    (goto-char beg)
145                    (and (search-forward "\n\n")
146                         (match-end 0)))
147                  end))
148       (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name)))
149       (insert str)
150       (base64-decode-region (point-min)(point-max))
151       (let ((file-coding-system *noconv*)
152             jka-compr-compression-info-list
153             jam-zcat-filename-list)
154         (write-file sig-file)
155         )
156       ;;(define-program-coding-system (current-buffer) "pgp" *noconv*)
157       (mime-article/show-output-buffer)
158       (setq status
159             (call-process-region (point-min)(point-max)
160                                  "pgp"
161                                  nil mime/output-buffer-name nil
162                                  orig-file))
163       (kill-buffer kbuf)
164       (let ((other-window-scroll-buffer mime/output-buffer-name))
165         (scroll-other-window 8)
166         )
167       ;; (if (= status 0)
168       ;;     (message "Good signature!")
169       ;;   (message "Bad signature!")
170       ;;   )
171       (delete-file orig-file)
172       (delete-file sig-file)
173       )))
174
175 (set-atype 'mime/content-decoding-condition
176            '((type . "application/pgp-signature")
177              (method . mime-article/check-pgp-signature)
178              ))
179
180          
181 ;;; @ end
182 ;;;
183
184 (provide 'tm-pgp)