1 ;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2005
3 ;; Free Software Foundation, Inc.
5 ;; Author: Sascha Lüdecke <sascha@meta-x.de>,
6 ;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
34 (autoload 'quoted-printable-decode-region
"qp")
35 (autoload 'quoted-printable-encode-region
"qp")
37 (defvar mml1991-use mml2015-use
38 "The package used for PGP.")
40 (defvar mml1991-function-alist
41 '((mailcrypt mml1991-mailcrypt-sign
42 mml1991-mailcrypt-encrypt
)
47 "Alist of PGP functions.")
52 (autoload 'mc-sign-generic
"mc-toplev"))
54 (defvar mml1991-decrypt-function
'mailcrypt-decrypt
)
55 (defvar mml1991-verify-function
'mailcrypt-verify
)
57 (defun mml1991-mailcrypt-sign (cont)
58 (let ((text (current-buffer))
60 (result-buffer (get-buffer-create "*GPG Result*")))
61 ;; Save MIME Content[^ ]+: headers from signing
62 (goto-char (point-min))
63 (while (looking-at "^Content[^ ]+:") (forward-line))
65 (setq headers
(buffer-string))
66 (delete-region (point-min) (point)))
67 (goto-char (point-max))
70 (quoted-printable-decode-region (point-min) (point-max))
72 (setq signature
(current-buffer))
73 (insert-buffer-substring text
)
74 (unless (mc-sign-generic (message-options-get 'message-sender
)
76 (unless (> (point-max) (point-min))
77 (pop-to-buffer result-buffer
)
78 (error "Sign error")))
79 (goto-char (point-min))
80 (while (re-search-forward "\r+$" nil t
)
81 (replace-match "" t t
))
82 (quoted-printable-encode-region (point-min) (point-max))
84 (delete-region (point-min) (point-max))
85 (if headers
(insert headers
))
87 (insert-buffer-substring signature
)
88 (goto-char (point-max)))))
90 (defun mml1991-mailcrypt-encrypt (cont &optional sign
)
91 (let ((text (current-buffer))
93 (or mc-pgp-always-sign
95 (eq t
(or (message-options-get 'message-sign-encrypt
)
98 (or (y-or-n-p "Sign the message? ")
102 (result-buffer (get-buffer-create "*GPG Result*")))
103 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
104 (goto-char (point-min))
105 (while (looking-at "^Content[^ ]+:") (forward-line))
107 (delete-region (point-min) (point)))
108 (mm-with-unibyte-current-buffer
110 (setq cipher
(current-buffer))
111 (insert-buffer-substring text
)
112 (unless (mc-encrypt-generic
114 (message-options-get 'message-recipients
)
115 (message-options-set 'message-recipients
116 (read-string "Recipients: ")))
118 (point-min) (point-max)
119 (message-options-get 'message-sender
)
121 (unless (> (point-max) (point-min))
122 (pop-to-buffer result-buffer
)
123 (error "Encrypt error")))
124 (goto-char (point-min))
125 (while (re-search-forward "\r+$" nil t
)
126 (replace-match "" t t
))
128 (delete-region (point-min) (point-max))
129 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
130 ;;(insert "Version: 1\n\n")
132 (insert-buffer-substring cipher
)
133 (goto-char (point-max))))))
138 (autoload 'gpg-sign-cleartext
"gpg"))
140 (defun mml1991-gpg-sign (cont)
141 (let ((text (current-buffer))
143 (result-buffer (get-buffer-create "*GPG Result*")))
144 ;; Save MIME Content[^ ]+: headers from signing
145 (goto-char (point-min))
146 (while (looking-at "^Content[^ ]+:") (forward-line))
148 (setq headers
(buffer-string))
149 (delete-region (point-min) (point)))
150 (goto-char (point-max))
153 (quoted-printable-decode-region (point-min) (point-max))
155 (unless (gpg-sign-cleartext text
(setq signature
(current-buffer))
158 (message-options-get 'message-sender
))
159 (unless (> (point-max) (point-min))
160 (pop-to-buffer result-buffer
)
161 (error "Sign error")))
162 (goto-char (point-min))
163 (while (re-search-forward "\r+$" nil t
)
164 (replace-match "" t t
))
165 (quoted-printable-encode-region (point-min) (point-max))
167 (delete-region (point-min) (point-max))
168 (if headers
(insert headers
))
170 (insert-buffer-substring signature
)
171 (goto-char (point-max)))))
173 (defun mml1991-gpg-encrypt (cont &optional sign
)
174 (let ((text (current-buffer))
176 (result-buffer (get-buffer-create "*GPG Result*")))
177 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
178 (goto-char (point-min))
179 (while (looking-at "^Content[^ ]+:") (forward-line))
181 (delete-region (point-min) (point)))
182 (mm-with-unibyte-current-buffer
184 (flet ((gpg-encrypt-func
185 (sign plaintext ciphertext result recipients
&optional
186 passphrase sign-with-key armor textmode
)
189 plaintext ciphertext result recipients passphrase
190 sign-with-key armor textmode
)
192 plaintext ciphertext result recipients passphrase
194 (unless (gpg-encrypt-func
196 text
(setq cipher
(current-buffer))
200 (message-options-get 'message-recipients
)
201 (message-options-set 'message-recipients
202 (read-string "Recipients: ")))
205 (message-options-get 'message-sender
)
206 t t
) ; armor & textmode
207 (unless (> (point-max) (point-min))
208 (pop-to-buffer result-buffer
)
209 (error "Encrypt error"))))
210 (goto-char (point-min))
211 (while (re-search-forward "\r+$" nil t
)
212 (replace-match "" t t
))
214 (delete-region (point-min) (point-max))
215 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
216 ;;(insert "Version: 1\n\n")
218 (insert-buffer-substring cipher
)
219 (goto-char (point-max))))))
224 (defvar pgg-default-user-id
)
225 (defvar pgg-errors-buffer
)
226 (defvar pgg-output-buffer
))
228 (defun mml1991-pgg-sign (cont)
230 ;; Don't sign headers.
231 (goto-char (point-min))
232 (while (not (looking-at "^$"))
234 (unless (eobp) ;; no headers?
235 (setq headers
(buffer-substring (point-min) (point)))
236 (forward-line) ;; skip header/body separator
237 (delete-region (point-min) (point)))
238 (when (string-match "^Content-Transfer-Encoding: \\(.+\\)" headers
)
239 (setq cte
(intern (match-string 1 headers
))))
240 (mm-decode-content-transfer-encoding cte
)
241 (unless (let ((pgg-default-user-id
242 (or (message-options-get 'mml-sender
)
243 pgg-default-user-id
)))
244 (pgg-sign-region (point-min) (point-max) t
))
245 (pop-to-buffer pgg-errors-buffer
)
246 (error "Encrypt error"))
247 (delete-region (point-min) (point-max))
248 (mm-with-unibyte-current-buffer
249 (insert-buffer-substring pgg-output-buffer
)
250 (goto-char (point-min))
251 (while (re-search-forward "\r+$" nil t
)
252 (replace-match "" t t
))
253 (mm-encode-content-transfer-encoding cte
)
254 (goto-char (point-min))
260 (defun mml1991-pgg-encrypt (cont &optional sign
)
262 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
263 (goto-char (point-min))
264 (while (looking-at "^Content[^ ]+:")
265 (when (looking-at "^Content-Transfer-Encoding: \\(.+\\)")
266 (setq cte
(intern (match-string 1))))
269 (delete-region (point-min) (point)))
270 (mm-decode-content-transfer-encoding cte
)
271 (unless (pgg-encrypt-region
272 (point-min) (point-max)
275 (message-options-get 'message-recipients
)
276 (message-options-set 'message-recipients
277 (read-string "Recipients: ")))
280 (pop-to-buffer pgg-errors-buffer
)
281 (error "Encrypt error"))
282 (delete-region (point-min) (point-max))
283 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
284 ;;(insert "Version: 1\n\n")
286 (insert-buffer-substring pgg-output-buffer
)
290 (defun mml1991-encrypt (cont &optional sign
)
291 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist
))))
293 (funcall func cont sign
)
294 (error "Cannot find encrypt function"))))
297 (defun mml1991-sign (cont)
298 (let ((func (nth 1 (assq mml1991-use mml1991-function-alist
))))
301 (error "Cannot find sign function"))))
306 ;; coding: iso-8859-1
309 ;;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706
310 ;;; mml1991.el ends here