1;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML 2 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Sascha L�decke <sascha@meta-x.de>, 7;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue) 8;; Keywords PGP 9 10;; This file is part of GNU Emacs. 11 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) 15;; any later version. 16 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. 21 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. 26 27;;; Commentary: 28 29;;; Code: 30 31(eval-when-compile 32 (require 'cl) 33 (require 'mm-util)) 34 35(defvar mc-pgp-always-sign) 36 37(autoload 'quoted-printable-decode-region "qp") 38(autoload 'quoted-printable-encode-region "qp") 39 40(defvar mml1991-use mml2015-use 41 "The package used for PGP.") 42 43(defvar mml1991-function-alist 44 '((mailcrypt mml1991-mailcrypt-sign 45 mml1991-mailcrypt-encrypt) 46 (gpg mml1991-gpg-sign 47 mml1991-gpg-encrypt) 48 (pgg mml1991-pgg-sign 49 mml1991-pgg-encrypt)) 50 "Alist of PGP functions.") 51 52;;; mailcrypt wrapper 53 54(eval-and-compile 55 (autoload 'mc-sign-generic "mc-toplev")) 56 57(defvar mml1991-decrypt-function 'mailcrypt-decrypt) 58(defvar mml1991-verify-function 'mailcrypt-verify) 59 60(defun mml1991-mailcrypt-sign (cont) 61 (let ((text (current-buffer)) 62 headers signature 63 (result-buffer (get-buffer-create "*GPG Result*"))) 64 ;; Save MIME Content[^ ]+: headers from signing 65 (goto-char (point-min)) 66 (while (looking-at "^Content[^ ]+:") (forward-line)) 67 (unless (bobp) 68 (setq headers (buffer-string)) 69 (delete-region (point-min) (point))) 70 (goto-char (point-max)) 71 (unless (bolp) 72 (insert "\n")) 73 (quoted-printable-decode-region (point-min) (point-max)) 74 (with-temp-buffer 75 (setq signature (current-buffer)) 76 (insert-buffer-substring text) 77 (unless (mc-sign-generic (message-options-get 'message-sender) 78 nil nil nil nil) 79 (unless (> (point-max) (point-min)) 80 (pop-to-buffer result-buffer) 81 (error "Sign error"))) 82 (goto-char (point-min)) 83 (while (re-search-forward "\r+$" nil t) 84 (replace-match "" t t)) 85 (quoted-printable-encode-region (point-min) (point-max)) 86 (set-buffer text) 87 (delete-region (point-min) (point-max)) 88 (if headers (insert headers)) 89 (insert "\n") 90 (insert-buffer-substring signature) 91 (goto-char (point-max))))) 92 93(defun mml1991-mailcrypt-encrypt (cont &optional sign) 94 (let ((text (current-buffer)) 95 (mc-pgp-always-sign 96 (or mc-pgp-always-sign 97 sign 98 (eq t (or (message-options-get 'message-sign-encrypt) 99 (message-options-set 100 'message-sign-encrypt 101 (or (y-or-n-p "Sign the message? ") 102 'not)))) 103 'never)) 104 cipher 105 (result-buffer (get-buffer-create "*GPG Result*"))) 106 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED 107 (goto-char (point-min)) 108 (while (looking-at "^Content[^ ]+:") (forward-line)) 109 (unless (bobp) 110 (delete-region (point-min) (point))) 111 (mm-with-unibyte-current-buffer 112 (with-temp-buffer 113 (setq cipher (current-buffer)) 114 (insert-buffer-substring text) 115 (unless (mc-encrypt-generic 116 (or 117 (message-options-get 'message-recipients) 118 (message-options-set 'message-recipients 119 (read-string "Recipients: "))) 120 nil 121 (point-min) (point-max) 122 (message-options-get 'message-sender) 123 'sign) 124 (unless (> (point-max) (point-min)) 125 (pop-to-buffer result-buffer) 126 (error "Encrypt error"))) 127 (goto-char (point-min)) 128 (while (re-search-forward "\r+$" nil t) 129 (replace-match "" t t)) 130 (set-buffer text) 131 (delete-region (point-min) (point-max)) 132 ;;(insert "Content-Type: application/pgp-encrypted\n\n") 133 ;;(insert "Version: 1\n\n") 134 (insert "\n") 135 (insert-buffer-substring cipher) 136 (goto-char (point-max)))))) 137 138;;; gpg wrapper 139 140(eval-and-compile 141 (autoload 'gpg-sign-cleartext "gpg")) 142 143(defun mml1991-gpg-sign (cont) 144 (let ((text (current-buffer)) 145 headers signature 146 (result-buffer (get-buffer-create "*GPG Result*"))) 147 ;; Save MIME Content[^ ]+: headers from signing 148 (goto-char (point-min)) 149 (while (looking-at "^Content[^ ]+:") (forward-line)) 150 (unless (bobp) 151 (setq headers (buffer-string)) 152 (delete-region (point-min) (point))) 153 (goto-char (point-max)) 154 (unless (bolp) 155 (insert "\n")) 156 (quoted-printable-decode-region (point-min) (point-max)) 157 (with-temp-buffer 158 (unless (gpg-sign-cleartext text (setq signature (current-buffer)) 159 result-buffer 160 nil 161 (message-options-get 'message-sender)) 162 (unless (> (point-max) (point-min)) 163 (pop-to-buffer result-buffer) 164 (error "Sign error"))) 165 (goto-char (point-min)) 166 (while (re-search-forward "\r+$" nil t) 167 (replace-match "" t t)) 168 (quoted-printable-encode-region (point-min) (point-max)) 169 (set-buffer text) 170 (delete-region (point-min) (point-max)) 171 (if headers (insert headers)) 172 (insert "\n") 173 (insert-buffer-substring signature) 174 (goto-char (point-max))))) 175 176(defun mml1991-gpg-encrypt (cont &optional sign) 177 (let ((text (current-buffer)) 178 cipher 179 (result-buffer (get-buffer-create "*GPG Result*"))) 180 ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED 181 (goto-char (point-min)) 182 (while (looking-at "^Content[^ ]+:") (forward-line)) 183 (unless (bobp) 184 (delete-region (point-min) (point))) 185 (mm-with-unibyte-current-buffer 186 (with-temp-buffer 187 (flet ((gpg-encrypt-func 188 (sign plaintext ciphertext result recipients &optional 189 passphrase sign-with-key armor textmode) 190 (if sign 191 (gpg-sign-encrypt 192 plaintext ciphertext result recipients passphrase 193 sign-with-key armor textmode) 194 (gpg-encrypt 195 plaintext ciphertext result recipients passphrase 196 armor textmode)))) 197 (unless (gpg-encrypt-func 198 sign 199 text (setq cipher (current-buffer)) 200 result-buffer 201 (split-string 202 (or 203 (message-options-get 'message-recipients) 204 (message-options-set 'message-recipients 205 (read-string "Recipients: "))) 206 "[ \f\t\n\r\v,]+") 207 nil 208 (message-options-get 'message-sender) 209 t t) ; armor & textmode 210 (unless (> (point-max) (point-min)) 211 (pop-to-buffer result-buffer) 212 (error "Encrypt error")))) 213 (goto-char (point-min)) 214 (while (re-search-forward "\r+$" nil t) 215 (replace-match "" t t)) 216 (set-buffer text) 217 (delete-region (point-min) (point-max)) 218 ;;(insert "Content-Type: application/pgp-encrypted\n\n") 219 ;;(insert "Version: 1\n\n") 220 (insert "\n") 221 (insert-buffer-substring cipher) 222 (goto-char (point-max)))))) 223 224;; pgg wrapper 225 226(eval-when-compile 227 (defvar pgg-default-user-id) 228 (defvar pgg-errors-buffer) 229 (defvar pgg-output-buffer)) 230 231(defun mml1991-pgg-sign (cont) 232 (let ((pgg-text-mode t) 233 (pgg-default-user-id (or (message-options-get 'mml-sender) 234 pgg-default-user-id)) 235 headers cte) 236 ;; Don't sign headers. 237 (goto-char (point-min)) 238 (when (re-search-forward "^$" nil t) 239 (setq headers (buffer-substring (point-min) (point))) 240 (save-restriction 241 (narrow-to-region (point-min) (point)) 242 (setq cte (mail-fetch-field "content-transfer-encoding"))) 243 (forward-line 1) 244 (delete-region (point-min) (point)) 245 (when cte 246 (setq cte (intern (downcase cte))) 247 (mm-decode-content-transfer-encoding cte))) 248 (unless (pgg-sign-region (point-min) (point-max) t) 249 (pop-to-buffer pgg-errors-buffer) 250 (error "Encrypt error")) 251 (delete-region (point-min) (point-max)) 252 (mm-with-unibyte-current-buffer 253 (insert-buffer-substring pgg-output-buffer) 254 (goto-char (point-min)) 255 (while (re-search-forward "\r+$" nil t) 256 (replace-match "" t t)) 257 (when cte 258 (mm-encode-content-transfer-encoding cte)) 259 (goto-char (point-min)) 260 (when headers 261 (insert headers)) 262 (insert "\n")) 263 t)) 264 265(defun mml1991-pgg-encrypt (cont &optional sign) 266 (goto-char (point-min)) 267 (when (re-search-forward "^$" nil t) 268 (let ((cte (save-restriction 269 (narrow-to-region (point-min) (point)) 270 (mail-fetch-field "content-transfer-encoding")))) 271 ;; Strip MIME headers since it will be ASCII armoured. 272 (forward-line 1) 273 (delete-region (point-min) (point)) 274 (when cte 275 (mm-decode-content-transfer-encoding (intern (downcase cte)))))) 276 (unless (let ((pgg-text-mode t)) 277 (pgg-encrypt-region 278 (point-min) (point-max) 279 (split-string 280 (or 281 (message-options-get 'message-recipients) 282 (message-options-set 'message-recipients 283 (read-string "Recipients: "))) 284 "[ \f\t\n\r\v,]+") 285 sign)) 286 (pop-to-buffer pgg-errors-buffer) 287 (error "Encrypt error")) 288 (delete-region (point-min) (point-max)) 289 (insert "\n") 290 (insert-buffer-substring pgg-output-buffer) 291 t) 292 293;;;###autoload 294(defun mml1991-encrypt (cont &optional sign) 295 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist)))) 296 (if func 297 (funcall func cont sign) 298 (error "Cannot find encrypt function")))) 299 300;;;###autoload 301(defun mml1991-sign (cont) 302 (let ((func (nth 1 (assq mml1991-use mml1991-function-alist)))) 303 (if func 304 (funcall func cont) 305 (error "Cannot find sign function")))) 306 307(provide 'mml1991) 308 309;; Local Variables: 310;; coding: iso-8859-1 311;; End: 312 313;;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706 314;;; mml1991.el ends here 315