1 ;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2003 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.
29 (defvar mml1991-use mml2015-use
30 "The package used for PGP.")
32 (defvar mml1991-function-alist
33 '((mailcrypt mml1991-mailcrypt-sign
34 mml1991-mailcrypt-encrypt)
39 "Alist of PGP functions.")
44 (autoload 'mc-sign-generic "mc-toplev"))
46 (defvar mml1991-decrypt-function 'mailcrypt-decrypt)
47 (defvar mml1991-verify-function 'mailcrypt-verify)
49 (defun mml1991-mailcrypt-sign (cont)
50 (let ((text (current-buffer))
52 (result-buffer (get-buffer-create "*GPG Result*")))
53 ;; Save MIME Content[^ ]+: headers from signing
54 (goto-char (point-min))
55 (while (looking-at "^Content[^ ]+:") (forward-line))
57 (setq headers (buffer-string))
58 (delete-region (point-min) (point)))
59 (goto-char (point-max))
62 (quoted-printable-decode-region (point-min) (point-max))
64 (setq signature (current-buffer))
65 (insert-buffer-substring text)
66 (unless (mc-sign-generic (message-options-get 'message-sender)
68 (unless (> (point-max) (point-min))
69 (pop-to-buffer result-buffer)
70 (error "Sign error")))
71 (goto-char (point-min))
72 (while (re-search-forward "\r+$" nil t)
73 (replace-match "" t t))
74 (quoted-printable-encode-region (point-min) (point-max))
76 (delete-region (point-min) (point-max))
77 (if headers (insert headers))
79 (insert-buffer-substring signature)
80 (goto-char (point-max)))))
82 (defun mml1991-mailcrypt-encrypt (cont &optional sign)
83 (let ((text (current-buffer))
85 (or mc-pgp-always-sign
87 (eq t (or (message-options-get 'message-sign-encrypt)
90 (or (y-or-n-p "Sign the message? ")
94 (result-buffer (get-buffer-create "*GPG Result*")))
95 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
96 (goto-char (point-min))
97 (while (looking-at "^Content[^ ]+:") (forward-line))
99 (delete-region (point-min) (point)))
100 (mm-with-unibyte-current-buffer-mule4
102 (setq cipher (current-buffer))
103 (insert-buffer-substring text)
104 (unless (mc-encrypt-generic
106 (message-options-get 'message-recipients)
107 (message-options-set 'message-recipients
108 (read-string "Recipients: ")))
110 (point-min) (point-max)
111 (message-options-get 'message-sender)
113 (unless (> (point-max) (point-min))
114 (pop-to-buffer result-buffer)
115 (error "Encrypt error")))
116 (goto-char (point-min))
117 (while (re-search-forward "\r+$" nil t)
118 (replace-match "" t t))
120 (delete-region (point-min) (point-max))
121 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
122 ;;(insert "Version: 1\n\n")
124 (insert-buffer-substring cipher)
125 (goto-char (point-max))))))
130 (autoload 'gpg-sign-cleartext "gpg"))
132 (defun mml1991-gpg-sign (cont)
133 (let ((text (current-buffer))
135 (result-buffer (get-buffer-create "*GPG Result*")))
136 ;; Save MIME Content[^ ]+: headers from signing
137 (goto-char (point-min))
138 (while (looking-at "^Content[^ ]+:") (forward-line))
140 (setq headers (buffer-string))
141 (delete-region (point-min) (point)))
142 (goto-char (point-max))
145 (quoted-printable-decode-region (point-min) (point-max))
147 (unless (gpg-sign-cleartext text (setq signature (current-buffer))
150 (message-options-get 'message-sender))
151 (unless (> (point-max) (point-min))
152 (pop-to-buffer result-buffer)
153 (error "Sign error")))
154 (goto-char (point-min))
155 (while (re-search-forward "\r+$" nil t)
156 (replace-match "" t t))
157 (quoted-printable-encode-region (point-min) (point-max))
159 (delete-region (point-min) (point-max))
160 (if headers (insert headers))
162 (insert-buffer-substring signature)
163 (goto-char (point-max)))))
165 (defun mml1991-gpg-encrypt (cont &optional sign)
166 (let ((text (current-buffer))
168 (result-buffer (get-buffer-create "*GPG Result*")))
169 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
170 (goto-char (point-min))
171 (while (looking-at "^Content[^ ]+:") (forward-line))
173 (delete-region (point-min) (point)))
174 (mm-with-unibyte-current-buffer-mule4
176 (flet ((gpg-encrypt-func
177 (sign plaintext ciphertext result recipients &optional
178 passphrase sign-with-key armor textmode)
181 plaintext ciphertext result recipients passphrase
182 sign-with-key armor textmode)
184 plaintext ciphertext result recipients passphrase
186 (unless (gpg-encrypt-func
188 text (setq cipher (current-buffer))
192 (message-options-get 'message-recipients)
193 (message-options-set 'message-recipients
194 (read-string "Recipients: ")))
197 (message-options-get 'message-sender)
198 t t) ; armor & textmode
199 (unless (> (point-max) (point-min))
200 (pop-to-buffer result-buffer)
201 (error "Encrypt error"))))
202 (goto-char (point-min))
203 (while (re-search-forward "\r+$" nil t)
204 (replace-match "" t t))
206 (delete-region (point-min) (point-max))
207 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
208 ;;(insert "Version: 1\n\n")
210 (insert-buffer-substring cipher)
211 (goto-char (point-max))))))
215 (defvar pgg-output-buffer)
216 (defvar pgg-errors-buffer)
218 (defun mml1991-pgg-sign (cont)
220 ;; Don't sign headers.
221 (goto-char (point-min))
222 (while (not (looking-at "^$"))
224 (unless (eobp) ;; no headers?
225 (setq headers (buffer-substring (point-min) (point)))
226 (forward-line) ;; skip header/body separator
227 (delete-region (point-min) (point)))
228 (quoted-printable-decode-region (point-min) (point-max))
229 (unless (let ((pgg-default-user-id
230 (or (message-options-get 'message-sender)
231 pgg-default-user-id)))
232 (pgg-sign-region (point-min) (point-max) t))
233 (pop-to-buffer pgg-errors-buffer)
234 (error "Encrypt error"))
235 (delete-region (point-min) (point-max))
236 (insert-buffer-substring pgg-output-buffer)
237 (goto-char (point-min))
238 (while (re-search-forward "\r+$" nil t)
239 (replace-match "" t t))
240 (quoted-printable-encode-region (point-min) (point-max))
241 (goto-char (point-min))
242 (if headers (insert headers))
246 (defun mml1991-pgg-encrypt (cont &optional sign)
248 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
249 (goto-char (point-min))
250 (while (looking-at "^Content[^ ]+:") (forward-line))
252 (delete-region (point-min) (point)))
253 (unless (pgg-encrypt-region
254 (point-min) (point-max)
257 (message-options-get 'message-recipients)
258 (message-options-set 'message-recipients
259 (read-string "Recipients: ")))
262 (pop-to-buffer pgg-errors-buffer)
263 (error "Encrypt error"))
264 (delete-region (point-min) (point-max))
265 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
266 ;;(insert "Version: 1\n\n")
268 (insert-buffer-substring pgg-output-buffer)
272 (defun mml1991-encrypt (cont &optional sign)
273 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
275 (funcall func cont sign)
276 (error "Cannot find encrypt function"))))
279 (defun mml1991-sign (cont)
280 (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
283 (error "Cannot find sign function"))))
288 ;; coding: iso-8859-1
291 ;;; mml1991.el ends here