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 Ldecke <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))
56 (if (> (point) (point-min))
58 (setq headers (buffer-substring (point-min) (point)))
59 (kill-region (point-min) (point))))
60 (goto-char (point-max))
63 (quoted-printable-decode-region (point-min) (point-max))
65 (setq signature (current-buffer))
67 (unless (mc-sign-generic (message-options-get 'message-sender)
69 (unless (> (point-max) (point-min))
70 (pop-to-buffer result-buffer)
71 (error "Sign error")))
72 (goto-char (point-min))
73 (while (re-search-forward "\r+$" nil t)
74 (replace-match "" t t))
75 (quoted-printable-encode-region (point-min) (point-max))
77 (kill-region (point-min) (point-max))
78 (if headers (insert headers))
80 (insert-buffer signature)
81 (goto-char (point-max)))))
83 (defun mml1991-mailcrypt-encrypt (cont &optional sign)
84 (let ((text (current-buffer))
86 (or mc-pgp-always-sign
88 (eq t (or (message-options-get 'message-sign-encrypt)
91 (or (y-or-n-p "Sign the message? ")
95 (result-buffer (get-buffer-create "*GPG Result*")))
96 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
97 (goto-char (point-min))
98 (while (looking-at "^Content[^ ]+:") (forward-line))
99 (if (> (point) (point-min))
101 (kill-region (point-min) (point))))
102 (mm-with-unibyte-current-buffer-mule4
104 (setq cipher (current-buffer))
106 (unless (mc-encrypt-generic
108 (message-options-get 'message-recipients)
109 (message-options-set 'message-recipients
110 (read-string "Recipients: ")))
112 (point-min) (point-max)
113 (message-options-get 'message-sender)
115 (unless (> (point-max) (point-min))
116 (pop-to-buffer result-buffer)
117 (error "Encrypt error")))
118 (goto-char (point-min))
119 (while (re-search-forward "\r+$" nil t)
120 (replace-match "" t t))
122 (kill-region (point-min) (point-max))
123 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
124 ;;(insert "Version: 1\n\n")
126 (insert-buffer cipher)
127 (goto-char (point-max))))))
132 (autoload 'gpg-sign-cleartext "gpg"))
134 (defun mml1991-gpg-sign (cont)
135 (let ((text (current-buffer))
137 (result-buffer (get-buffer-create "*GPG Result*")))
138 ;; Save MIME Content[^ ]+: headers from signing
139 (goto-char (point-min))
140 (while (looking-at "^Content[^ ]+:") (forward-line))
141 (if (> (point) (point-min))
143 (setq headers (buffer-substring (point-min) (point)))
144 (kill-region (point-min) (point))))
145 (goto-char (point-max))
148 (quoted-printable-decode-region (point-min) (point-max))
150 (unless (gpg-sign-cleartext text (setq signature (current-buffer))
153 (message-options-get 'message-sender))
154 (unless (> (point-max) (point-min))
155 (pop-to-buffer result-buffer)
156 (error "Sign error")))
157 (goto-char (point-min))
158 (while (re-search-forward "\r+$" nil t)
159 (replace-match "" t t))
160 (quoted-printable-encode-region (point-min) (point-max))
162 (kill-region (point-min) (point-max))
163 (if headers (insert headers))
165 (insert-buffer signature)
166 (goto-char (point-max)))))
168 (defun mml1991-gpg-encrypt (cont &optional sign)
169 (let ((text (current-buffer))
171 (result-buffer (get-buffer-create "*GPG Result*")))
172 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
173 (goto-char (point-min))
174 (while (looking-at "^Content[^ ]+:") (forward-line))
175 (if (> (point) (point-min))
177 (kill-region (point-min) (point))))
178 (mm-with-unibyte-current-buffer-mule4
180 (flet ((gpg-encrypt-func
181 (sign plaintext ciphertext result recipients &optional
182 passphrase sign-with-key armor textmode)
185 plaintext ciphertext result recipients passphrase
186 sign-with-key armor textmode)
188 plaintext ciphertext result recipients passphrase
190 (unless (gpg-encrypt-func
192 text (setq cipher (current-buffer))
196 (message-options-get 'message-recipients)
197 (message-options-set 'message-recipients
198 (read-string "Recipients: ")))
201 (message-options-get 'message-sender)
202 t t) ; armor & textmode
203 (unless (> (point-max) (point-min))
204 (pop-to-buffer result-buffer)
205 (error "Encrypt error"))))
206 (goto-char (point-min))
207 (while (re-search-forward "\r+$" nil t)
208 (replace-match "" t t))
210 (kill-region (point-min) (point-max))
211 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
212 ;;(insert "Version: 1\n\n")
214 (insert-buffer cipher)
215 (goto-char (point-max))))))
219 (defvar pgg-output-buffer)
220 (defvar pgg-errors-buffer)
222 (defun mml1991-pgg-sign (cont)
224 ;; Don't sign headers.
225 (goto-char (point-min))
226 (while (not (looking-at "^$"))
228 (unless (eobp) ;; no headers?
229 (setq headers (buffer-substring (point-min) (point)))
230 (forward-line) ;; skip header/body separator
231 (kill-region (point-min) (point)))
232 (quoted-printable-decode-region (point-min) (point-max))
233 (unless (let ((pgg-default-user-id
234 (or (message-options-get 'message-sender)
235 pgg-default-user-id)))
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 (goto-char (point-min))
242 (while (re-search-forward "\r+$" nil t)
243 (replace-match "" t t))
244 (quoted-printable-encode-region (point-min) (point-max))
245 (goto-char (point-min))
246 (if headers (insert headers))
250 (defun mml1991-pgg-encrypt (cont &optional sign)
252 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
253 (goto-char (point-min))
254 (while (looking-at "^Content[^ ]+:") (forward-line))
255 (if (> (point) (point-min))
257 (kill-region (point-min) (point))))
258 (unless (pgg-encrypt-region
259 (point-min) (point-max)
262 (message-options-get 'message-recipients)
263 (message-options-set 'message-recipients
264 (read-string "Recipients: ")))
267 (pop-to-buffer pgg-errors-buffer)
268 (error "Encrypt error"))
269 (kill-region (point-min) (point-max))
270 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
271 ;;(insert "Version: 1\n\n")
273 (insert-buffer pgg-output-buffer)
277 (defun mml1991-encrypt (cont &optional sign)
278 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
280 (funcall func cont sign)
281 (error "Cannot find encrypt function"))))
284 (defun mml1991-sign (cont)
285 (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
288 (error "Cannot find sign function"))))
293 ;; coding: iso-8859-1
296 ;;; mml1991.el ends here