git.chise.org Git - elisp/gnus.git-/blob - lisp/mml1991.el

   1 ;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
   2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
   3
   4 ;; Author: Sascha Lüdecke <sascha@meta-x.de>,
   5 ;;      Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
   6 ;; Keywords PGP
   7
   8 ;; This file is (not yet) part of GNU Emacs.
   9
  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)
  13 ;; any later version.
  14
  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.
  19
  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.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (defvar mml1991-use mml2015-use
  30   "The package used for PGP.")
  31
  32 (defvar mml1991-function-alist
  33   '((mailcrypt mml1991-mailcrypt-sign
  34                mml1991-mailcrypt-encrypt)
  35     (gpg mml1991-gpg-sign
  36          mml1991-gpg-encrypt)
  37     (pgg mml1991-pgg-sign
  38          mml1991-pgg-encrypt))
  39   "Alist of PGP functions.")
  40
  41 ;;; mailcrypt wrapper
  42
  43 (eval-and-compile
  44   (autoload 'mc-sign-generic "mc-toplev"))
  45
  46 (defvar mml1991-decrypt-function 'mailcrypt-decrypt)
  47 (defvar mml1991-verify-function 'mailcrypt-verify)
  48
  49 (defun mml1991-mailcrypt-sign (cont)
  50   (let ((text (current-buffer))
  51         headers signature
  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     (unless (bobp)
  57       (setq headers (buffer-string))
  58       (delete-region (point-min) (point)))
  59     (goto-char (point-max))
  60     (unless (bolp)
  61       (insert "\n"))
  62     (quoted-printable-decode-region (point-min) (point-max))
  63     (with-temp-buffer
  64       (setq signature (current-buffer))
  65       (insert-buffer text)
  66       (unless (mc-sign-generic (message-options-get 'message-sender)
  67                                nil nil nil nil)
  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))
  75       (set-buffer text)
  76       (delete-region (point-min) (point-max))
  77       (if headers (insert headers))
  78       (insert "\n")
  79       (insert-buffer signature)
  80       (goto-char (point-max)))))
  81
  82 (defun mml1991-mailcrypt-encrypt (cont &optional sign)
  83   (let ((text (current-buffer))
  84         (mc-pgp-always-sign
  85          (or mc-pgp-always-sign
  86              sign
  87              (eq t (or (message-options-get 'message-sign-encrypt)
  88                        (message-options-set
  89                         'message-sign-encrypt
  90                         (or (y-or-n-p "Sign the message? ")
  91                             'not))))
  92              'never))
  93         cipher
  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))
  98     (unless (bobp)
  99       (delete-region (point-min) (point)))
 100     (mm-with-unibyte-current-buffer-mule4
 101       (with-temp-buffer
 102         (setq cipher (current-buffer))
 103         (insert-buffer text)
 104         (unless (mc-encrypt-generic
 105                  (or
 106                   (message-options-get 'message-recipients)
 107                   (message-options-set 'message-recipients
 108                                        (read-string "Recipients: ")))
 109                  nil
 110                  (point-min) (point-max)
 111                  (message-options-get 'message-sender)
 112                  'sign)
 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))
 119         (set-buffer text)
 120         (delete-region (point-min) (point-max))
 121         ;;(insert "Content-Type: application/pgp-encrypted\n\n")
 122         ;;(insert "Version: 1\n\n")
 123         (insert "\n")
 124         (insert-buffer cipher)
 125         (goto-char (point-max))))))
 126
 127 ;;; gpg wrapper
 128
 129 (eval-and-compile
 130   (autoload 'gpg-sign-cleartext "gpg"))
 131
 132 (defun mml1991-gpg-sign (cont)
 133   (let ((text (current-buffer))
 134         headers signature
 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))
 139     (unless (bobp)
 140       (setq headers (buffer-string))
 141       (delete-region (point-min) (point)))
 142     (goto-char (point-max))
 143     (unless (bolp)
 144       (insert "\n"))
 145     (quoted-printable-decode-region (point-min) (point-max))
 146     (with-temp-buffer
 147       (unless (gpg-sign-cleartext text (setq signature (current-buffer))
 148                                   result-buffer
 149                                   nil
 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))
 158       (set-buffer text)
 159       (delete-region (point-min) (point-max))
 160       (if headers (insert headers))
 161       (insert "\n")
 162       (insert-buffer signature)
 163       (goto-char (point-max)))))
 164
 165 (defun mml1991-gpg-encrypt (cont &optional sign)
 166   (let ((text (current-buffer))
 167         cipher
 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))
 172     (unless (bobp)
 173       (delete-region (point-min) (point)))
 174     (mm-with-unibyte-current-buffer-mule4
 175       (with-temp-buffer
 176         (flet ((gpg-encrypt-func
 177                 (sign plaintext ciphertext result recipients &optional
 178                       passphrase sign-with-key armor textmode)
 179                 (if sign
 180                     (gpg-sign-encrypt
 181                      plaintext ciphertext result recipients passphrase
 182                      sign-with-key armor textmode)
 183                   (gpg-encrypt
 184                    plaintext ciphertext result recipients passphrase
 185                    armor textmode))))
 186           (unless (gpg-encrypt-func
 187                    sign
 188                    text (setq cipher (current-buffer))
 189                    result-buffer
 190                    (split-string
 191                     (or
 192                      (message-options-get 'message-recipients)
 193                      (message-options-set 'message-recipients
 194                                           (read-string "Recipients: ")))
 195                     "[ \f\t\n\r\v,]+")
 196                    nil
 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))
 205         (set-buffer text)
 206         (delete-region (point-min) (point-max))
 207         ;;(insert "Content-Type: application/pgp-encrypted\n\n")
 208         ;;(insert "Version: 1\n\n")
 209         (insert "\n")
 210         (insert-buffer cipher)
 211         (goto-char (point-max))))))
 212
 213 ;; pgg wrapper
 214
 215 (defvar pgg-output-buffer)
 216 (defvar pgg-errors-buffer)
 217
 218 (defun mml1991-pgg-sign (cont)
 219   (let (headers)
 220     ;; Don't sign headers.
 221     (goto-char (point-min))
 222     (while (not (looking-at "^$"))
 223       (forward-line))
 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 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))
 243     (insert "\n")
 244     t))
 245
 246 (defun mml1991-pgg-encrypt (cont &optional sign)
 247   (let (headers)
 248     ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
 249     (goto-char (point-min))
 250     (while (looking-at "^Content[^ ]+:") (forward-line))
 251     (unless (bobp)
 252       (delete-region (point-min) (point)))
 253     (unless (pgg-encrypt-region
 254              (point-min) (point-max)
 255              (split-string
 256               (or
 257                (message-options-get 'message-recipients)
 258                (message-options-set 'message-recipients
 259                                     (read-string "Recipients: ")))
 260               "[ \f\t\n\r\v,]+")
 261              sign)
 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")
 267     (insert "\n")
 268     (insert-buffer pgg-output-buffer)
 269     t))
 270
 271 ;;;###autoload
 272 (defun mml1991-encrypt (cont &optional sign)
 273   (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
 274     (if func
 275         (funcall func cont sign)
 276       (error "Cannot find encrypt function"))))
 277
 278 ;;;###autoload
 279 (defun mml1991-sign (cont)
 280   (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
 281     (if func
 282         (funcall func cont)
 283       (error "Cannot find sign function"))))
 284
 285 (provide 'mml1991)
 286
 287 ;; Local Variables:
 288 ;; coding: iso-8859-1
 289 ;; End:
 290
 291 ;;; mml1991.el ends here