1 ;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
6 ;; Author: Sascha Ldecke <sascha@meta-x.de>,
7 ;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
35 (autoload 'quoted-printable-decode-region "qp")
36 (autoload 'quoted-printable-encode-region "qp")
38 (defvar mml1991-use mml2015-use
39 "The package used for PGP.")
41 (defvar mml1991-function-alist
42 '((mailcrypt mml1991-mailcrypt-sign
43 mml1991-mailcrypt-encrypt)
48 "Alist of PGP functions.")
53 (autoload 'mc-sign-generic "mc-toplev"))
55 (defvar mml1991-decrypt-function 'mailcrypt-decrypt)
56 (defvar mml1991-verify-function 'mailcrypt-verify)
58 (defun mml1991-mailcrypt-sign (cont)
59 (let ((text (current-buffer))
61 (result-buffer (get-buffer-create "*GPG Result*")))
62 ;; Save MIME Content[^ ]+: headers from signing
63 (goto-char (point-min))
64 (while (looking-at "^Content[^ ]+:") (forward-line))
66 (setq headers (buffer-string))
67 (delete-region (point-min) (point)))
68 (goto-char (point-max))
71 (quoted-printable-decode-region (point-min) (point-max))
73 (setq signature (current-buffer))
74 (insert-buffer-substring text)
75 (unless (mc-sign-generic (message-options-get 'message-sender)
77 (unless (> (point-max) (point-min))
78 (pop-to-buffer result-buffer)
79 (error "Sign error")))
80 (goto-char (point-min))
81 (while (re-search-forward "\r+$" nil t)
82 (replace-match "" t t))
83 (quoted-printable-encode-region (point-min) (point-max))
85 (delete-region (point-min) (point-max))
86 (if headers (insert headers))
88 (insert-buffer-substring signature)
89 (goto-char (point-max)))))
91 (defun mml1991-mailcrypt-encrypt (cont &optional sign)
92 (let ((text (current-buffer))
94 (or mc-pgp-always-sign
96 (eq t (or (message-options-get 'message-sign-encrypt)
99 (or (y-or-n-p "Sign the message? ")
103 (result-buffer (get-buffer-create "*GPG Result*")))
104 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
105 (goto-char (point-min))
106 (while (looking-at "^Content[^ ]+:") (forward-line))
108 (delete-region (point-min) (point)))
109 (mm-with-unibyte-current-buffer
111 (setq cipher (current-buffer))
112 (insert-buffer-substring text)
113 (unless (mc-encrypt-generic
115 (message-options-get 'message-recipients)
116 (message-options-set 'message-recipients
117 (read-string "Recipients: ")))
119 (point-min) (point-max)
120 (message-options-get 'message-sender)
122 (unless (> (point-max) (point-min))
123 (pop-to-buffer result-buffer)
124 (error "Encrypt error")))
125 (goto-char (point-min))
126 (while (re-search-forward "\r+$" nil t)
127 (replace-match "" t t))
129 (delete-region (point-min) (point-max))
130 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
131 ;;(insert "Version: 1\n\n")
133 (insert-buffer-substring cipher)
134 (goto-char (point-max))))))
139 (autoload 'gpg-sign-cleartext "gpg"))
141 (defun mml1991-gpg-sign (cont)
142 (let ((text (current-buffer))
144 (result-buffer (get-buffer-create "*GPG Result*")))
145 ;; Save MIME Content[^ ]+: headers from signing
146 (goto-char (point-min))
147 (while (looking-at "^Content[^ ]+:") (forward-line))
149 (setq headers (buffer-string))
150 (delete-region (point-min) (point)))
151 (goto-char (point-max))
154 (quoted-printable-decode-region (point-min) (point-max))
156 (unless (gpg-sign-cleartext text (setq signature (current-buffer))
159 (message-options-get 'message-sender))
160 (unless (> (point-max) (point-min))
161 (pop-to-buffer result-buffer)
162 (error "Sign error")))
163 (goto-char (point-min))
164 (while (re-search-forward "\r+$" nil t)
165 (replace-match "" t t))
166 (quoted-printable-encode-region (point-min) (point-max))
168 (delete-region (point-min) (point-max))
169 (if headers (insert headers))
171 (insert-buffer-substring signature)
172 (goto-char (point-max)))))
174 (defun mml1991-gpg-encrypt (cont &optional sign)
175 (let ((text (current-buffer))
177 (result-buffer (get-buffer-create "*GPG Result*")))
178 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
179 (goto-char (point-min))
180 (while (looking-at "^Content[^ ]+:") (forward-line))
182 (delete-region (point-min) (point)))
183 (mm-with-unibyte-current-buffer
185 (flet ((gpg-encrypt-func
186 (sign plaintext ciphertext result recipients &optional
187 passphrase sign-with-key armor textmode)
190 plaintext ciphertext result recipients passphrase
191 sign-with-key armor textmode)
193 plaintext ciphertext result recipients passphrase
195 (unless (gpg-encrypt-func
197 text (setq cipher (current-buffer))
201 (message-options-get 'message-recipients)
202 (message-options-set 'message-recipients
203 (read-string "Recipients: ")))
206 (message-options-get 'message-sender)
207 t t) ; armor & textmode
208 (unless (> (point-max) (point-min))
209 (pop-to-buffer result-buffer)
210 (error "Encrypt error"))))
211 (goto-char (point-min))
212 (while (re-search-forward "\r+$" nil t)
213 (replace-match "" t t))
215 (delete-region (point-min) (point-max))
216 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
217 ;;(insert "Version: 1\n\n")
219 (insert-buffer-substring cipher)
220 (goto-char (point-max))))))
225 (defvar pgg-default-user-id)
226 (defvar pgg-errors-buffer)
227 (defvar pgg-output-buffer))
229 (defun mml1991-pgg-sign (cont)
231 ;; Don't sign headers.
232 (goto-char (point-min))
233 (while (not (looking-at "^$"))
235 (unless (eobp) ;; no headers?
236 (setq headers (buffer-substring (point-min) (point)))
237 (forward-line) ;; skip header/body separator
238 (delete-region (point-min) (point)))
239 (when (string-match "^Content-Transfer-Encoding: \\(.+\\)" headers)
240 (setq cte (intern (match-string 1 headers))))
241 (mm-decode-content-transfer-encoding cte)
242 (unless (let ((pgg-default-user-id
243 (or (message-options-get 'mml-sender)
244 pgg-default-user-id)))
245 (pgg-sign-region (point-min) (point-max) t))
246 (pop-to-buffer pgg-errors-buffer)
247 (error "Encrypt error"))
248 (delete-region (point-min) (point-max))
249 (mm-with-unibyte-current-buffer
250 (insert-buffer-substring pgg-output-buffer)
251 (goto-char (point-min))
252 (while (re-search-forward "\r+$" nil t)
253 (replace-match "" t t))
254 (mm-encode-content-transfer-encoding cte)
255 (goto-char (point-min))
261 (defun mml1991-pgg-encrypt (cont &optional sign)
263 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
264 (goto-char (point-min))
265 (while (looking-at "^Content[^ ]+:")
266 (when (looking-at "^Content-Transfer-Encoding: \\(.+\\)")
267 (setq cte (intern (match-string 1))))
270 (delete-region (point-min) (point)))
271 (mm-decode-content-transfer-encoding cte)
272 (unless (pgg-encrypt-region
273 (point-min) (point-max)
276 (message-options-get 'message-recipients)
277 (message-options-set 'message-recipients
278 (read-string "Recipients: ")))
281 (pop-to-buffer pgg-errors-buffer)
282 (error "Encrypt error"))
283 (delete-region (point-min) (point-max))
284 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
285 ;;(insert "Version: 1\n\n")
287 (insert-buffer-substring pgg-output-buffer)
291 (defun mml1991-encrypt (cont &optional sign)
292 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
294 (funcall func cont sign)
295 (error "Cannot find encrypt function"))))
298 (defun mml1991-sign (cont)
299 (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
302 (error "Cannot find sign function"))))
307 ;; coding: iso-8859-1
310 ;;; mml1991.el ends here