1 ;;; mml-gpg-old.el --- Old PGP message format (RFC 1991) support for MML
2 ;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
4 ;; Author: Sascha Lüdecke <sascha@meta-x.de>,
5 ;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
8 ;; This file is (not yet) part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; RCS: $Id: mml1991.el,v 6.12 2002/10/09 22:43:59 jas Exp $
31 (defvar mml1991-use mml2015-use
32 "The package used for PGP.")
34 (defvar mml1991-function-alist
35 '((mailcrypt mml1991-mailcrypt-sign
36 mml1991-mailcrypt-encrypt)
41 "Alist of PGP functions.")
46 (autoload 'mc-sign-generic "mc-toplev"))
48 (defvar mml1991-decrypt-function 'mailcrypt-decrypt)
49 (defvar mml1991-verify-function 'mailcrypt-verify)
51 (defun mml1991-mailcrypt-sign (cont)
52 (let ((text (current-buffer))
54 (result-buffer (get-buffer-create "*GPG Result*")))
55 ;; Save MIME Content[^ ]+: headers from signing
56 (goto-char (point-min))
57 (while (looking-at "^Content[^ ]+:") (forward-line))
58 (if (> (point) (point-min))
60 (setq headers (buffer-substring (point-min) (point)))
61 (kill-region (point-min) (point))))
62 (goto-char (point-max))
65 (quoted-printable-decode-region (point-min) (point-max))
67 (setq signature (current-buffer))
69 (unless (mc-sign-generic (message-options-get 'message-sender)
71 (unless (> (point-max) (point-min))
72 (pop-to-buffer result-buffer)
73 (error "Sign error")))
74 (goto-char (point-min))
75 (while (re-search-forward "\r+$" nil t)
76 (replace-match "" t t))
77 (quoted-printable-encode-region (point-min) (point-max))
79 (kill-region (point-min) (point-max))
80 (if headers (insert headers))
82 (insert-buffer signature)
83 (goto-char (point-max)))))
85 (defun mml1991-mailcrypt-encrypt (cont &optional sign)
86 (let ((text (current-buffer))
88 (or mc-pgp-always-sign
90 (eq t (or (message-options-get 'message-sign-encrypt)
93 (or (y-or-n-p "Sign the message? ")
97 (result-buffer (get-buffer-create "*GPG Result*")))
98 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
99 (goto-char (point-min))
100 (while (looking-at "^Content[^ ]+:") (forward-line))
101 (if (> (point) (point-min))
103 (kill-region (point-min) (point))))
104 (mm-with-unibyte-current-buffer-mule4
106 (setq cipher (current-buffer))
108 (unless (mc-encrypt-generic
110 (message-options-get 'message-recipients)
111 (message-options-set 'message-recipients
112 (read-string "Recipients: ")))
114 (point-min) (point-max)
115 (message-options-get 'message-sender)
117 (unless (> (point-max) (point-min))
118 (pop-to-buffer result-buffer)
119 (error "Encrypt error")))
120 (goto-char (point-min))
121 (while (re-search-forward "\r+$" nil t)
122 (replace-match "" t t))
124 (kill-region (point-min) (point-max))
125 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
126 ;;(insert "Version: 1\n\n")
128 (insert-buffer cipher)
129 (goto-char (point-max))))))
134 (autoload 'gpg-sign-cleartext "gpg"))
136 (defun mml1991-gpg-sign (cont)
137 (let ((text (current-buffer))
139 (result-buffer (get-buffer-create "*GPG Result*")))
140 ;; Save MIME Content[^ ]+: headers from signing
141 (goto-char (point-min))
142 (while (looking-at "^Content[^ ]+:") (forward-line))
143 (if (> (point) (point-min))
145 (setq headers (buffer-substring (point-min) (point)))
146 (kill-region (point-min) (point))))
147 (goto-char (point-max))
150 (quoted-printable-decode-region (point-min) (point-max))
152 (unless (gpg-sign-cleartext text (setq signature (current-buffer))
155 (message-options-get 'message-sender))
156 (unless (> (point-max) (point-min))
157 (pop-to-buffer result-buffer)
158 (error "Sign error")))
159 (goto-char (point-min))
160 (while (re-search-forward "\r+$" nil t)
161 (replace-match "" t t))
162 (quoted-printable-encode-region (point-min) (point-max))
164 (kill-region (point-min) (point-max))
165 (if headers (insert headers))
167 (insert-buffer signature)
168 (goto-char (point-max)))))
170 (defun mml1991-gpg-encrypt (cont &optional sign)
171 (let ((text (current-buffer))
173 (result-buffer (get-buffer-create "*GPG Result*")))
174 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
175 (goto-char (point-min))
176 (while (looking-at "^Content[^ ]+:") (forward-line))
177 (if (> (point) (point-min))
179 (kill-region (point-min) (point))))
180 (mm-with-unibyte-current-buffer-mule4
182 (flet ((gpg-encrypt-func
183 (sign plaintext ciphertext result recipients &optional
184 passphrase sign-with-key armor textmode)
187 plaintext ciphertext result recipients passphrase
188 sign-with-key armor textmode)
190 plaintext ciphertext result recipients passphrase
192 (unless (gpg-encrypt-func
194 text (setq cipher (current-buffer))
198 (message-options-get 'message-recipients)
199 (message-options-set 'message-recipients
200 (read-string "Recipients: ")))
203 (message-options-get 'message-sender)
204 t t) ; armor & textmode
205 (unless (> (point-max) (point-min))
206 (pop-to-buffer result-buffer)
207 (error "Encrypt error"))))
208 (goto-char (point-min))
209 (while (re-search-forward "\r+$" nil t)
210 (replace-match "" t t))
212 (kill-region (point-min) (point-max))
213 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
214 ;;(insert "Version: 1\n\n")
216 (insert-buffer cipher)
217 (goto-char (point-max))))))
221 (defvar pgg-output-buffer)
222 (defvar pgg-errors-buffer)
224 (defun mml1991-pgg-sign (cont)
226 ;; Don't sign headers.
227 (goto-char (point-min))
228 (while (not (looking-at "^$"))
230 (unless (eobp) ;; no headers?
231 (setq headers (buffer-substring (point-min) (point)))
232 (forward-line) ;; skip header/body separator
233 (kill-region (point-min) (point)))
234 (quoted-printable-decode-region (point-min) (point-max))
235 (unless (let ((pgg-default-user-id (message-options-get 'message-sender)))
236 (pgg-sign-region (point-min) (point-max) t))
237 (pop-to-buffer pgg-errors-buffer)
238 (error "Encrypt error"))
239 (kill-region (point-min) (point-max))
240 (insert-buffer pgg-output-buffer)
241 (quoted-printable-encode-region (point-min) (point-max))
242 (goto-char (point-min))
243 (if headers (insert headers))
247 (defun mml1991-pgg-encrypt (cont &optional sign)
249 ;; Don't sign headers.
250 (goto-char (point-min))
251 (while (not (looking-at "^$"))
253 (unless (eobp) ;; no headers?
254 (setq headers (buffer-substring (point-min) (point)))
255 (forward-line) ;; skip header/body separator
256 (kill-region (point-min) (point)))
257 (unless (pgg-encrypt-region
258 (point-min) (point-max)
261 (message-options-get 'message-recipients)
262 (message-options-set 'message-recipients
263 (read-string "Recipients: ")))
266 (pop-to-buffer pgg-errors-buffer)
267 (error "Encrypt error"))
268 (kill-region (point-min) (point-max))
269 (if headers (insert headers))
271 (insert-buffer pgg-output-buffer)
275 (defun mml1991-encrypt (cont &optional sign)
276 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
278 (funcall func cont sign)
279 (error "Cannot find encrypt function"))))
282 (defun mml1991-sign (cont)
283 (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
286 (error "Cannot find sign function"))))
291 ;; coding: iso-8859-1
294 ;;; mml1991.el ends here