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

   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.
   3
   4 ;; Author: Sascha Ldecke <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     (if (> (point) (point-min))
  57         (progn
  58           (setq headers (buffer-substring (point-min) (point)))
  59           (kill-region (point-min) (point))))
  60     (goto-char (point-max))
  61     (unless (bolp)
  62       (insert "\n"))
  63     (quoted-printable-decode-region (point-min) (point-max))
  64     (with-temp-buffer
  65       (setq signature (current-buffer))
  66       (insert-buffer text)
  67       (unless (mc-sign-generic (message-options-get 'message-sender)
  68                                nil nil nil nil)
  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))
  76       (set-buffer text)
  77       (kill-region (point-min) (point-max))
  78       (if headers (insert headers))
  79       (insert "\n")
  80       (insert-buffer signature)
  81       (goto-char (point-max)))))
  82
  83 (defun mml1991-mailcrypt-encrypt (cont &optional sign)
  84   (let ((text (current-buffer))
  85         (mc-pgp-always-sign
  86          (or mc-pgp-always-sign
  87              sign
  88              (eq t (or (message-options-get 'message-sign-encrypt)
  89                        (message-options-set
  90                         'message-sign-encrypt
  91                         (or (y-or-n-p "Sign the message? ")
  92                             'not))))
  93              'never))
  94         cipher
  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))
 100         (progn
 101           (kill-region (point-min) (point))))
 102     (mm-with-unibyte-current-buffer-mule4
 103       (with-temp-buffer
 104         (setq cipher (current-buffer))
 105         (insert-buffer text)
 106         (unless (mc-encrypt-generic
 107                  (or
 108                   (message-options-get 'message-recipients)
 109                   (message-options-set 'message-recipients
 110                                        (read-string "Recipients: ")))
 111                  nil
 112                  (point-min) (point-max)
 113                  (message-options-get 'message-sender)
 114                  'sign)
 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))
 121         (set-buffer text)
 122         (kill-region (point-min) (point-max))
 123         ;;(insert "Content-Type: application/pgp-encrypted\n\n")
 124         ;;(insert "Version: 1\n\n")
 125         (insert "\n")
 126         (insert-buffer cipher)
 127         (goto-char (point-max))))))
 128
 129 ;;; gpg wrapper
 130
 131 (eval-and-compile
 132   (autoload 'gpg-sign-cleartext "gpg"))
 133
 134 (defun mml1991-gpg-sign (cont)
 135   (let ((text (current-buffer))
 136         headers signature
 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))
 142         (progn
 143           (setq headers (buffer-substring (point-min) (point)))
 144           (kill-region (point-min) (point))))
 145     (goto-char (point-max))
 146     (unless (bolp)
 147       (insert "\n"))
 148     (quoted-printable-decode-region (point-min) (point-max))
 149     (with-temp-buffer
 150       (unless (gpg-sign-cleartext text (setq signature (current-buffer))
 151                                   result-buffer
 152                                   nil
 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))
 161       (set-buffer text)
 162       (kill-region (point-min) (point-max))
 163       (if headers (insert headers))
 164       (insert "\n")
 165       (insert-buffer signature)
 166       (goto-char (point-max)))))
 167
 168 (defun mml1991-gpg-encrypt (cont &optional sign)
 169   (let ((text (current-buffer))
 170         cipher
 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))
 176         (progn
 177           (kill-region (point-min) (point))))
 178     (mm-with-unibyte-current-buffer-mule4
 179       (with-temp-buffer
 180         (flet ((gpg-encrypt-func
 181                 (sign plaintext ciphertext result recipients &optional
 182                       passphrase sign-with-key armor textmode)
 183                 (if sign
 184                     (gpg-sign-encrypt
 185                      plaintext ciphertext result recipients passphrase
 186                      sign-with-key armor textmode)
 187                   (gpg-encrypt
 188                    plaintext ciphertext result recipients passphrase
 189                    armor textmode))))
 190           (unless (gpg-encrypt-func
 191                    sign
 192                    text (setq cipher (current-buffer))
 193                    result-buffer
 194                    (split-string
 195                     (or
 196                      (message-options-get 'message-recipients)
 197                      (message-options-set 'message-recipients
 198                                           (read-string "Recipients: ")))
 199                     "[ \f\t\n\r\v,]+")
 200                    nil
 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))
 209         (set-buffer text)
 210         (kill-region (point-min) (point-max))
 211         ;;(insert "Content-Type: application/pgp-encrypted\n\n")
 212         ;;(insert "Version: 1\n\n")
 213         (insert "\n")
 214         (insert-buffer cipher)
 215         (goto-char (point-max))))))
 216
 217 ;; pgg wrapper
 218
 219 (defvar pgg-output-buffer)
 220 (defvar pgg-errors-buffer)
 221
 222 (defun mml1991-pgg-sign (cont)
 223   (let (headers)
 224     ;; Don't sign headers.
 225     (goto-char (point-min))
 226     (while (not (looking-at "^$"))
 227       (forward-line))
 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 (message-options-get 'message-sender)))
 234               (pgg-sign-region (point-min) (point-max) t))
 235       (pop-to-buffer pgg-errors-buffer)
 236       (error "Encrypt error"))
 237     (kill-region (point-min) (point-max))
 238     (insert-buffer pgg-output-buffer)
 239     (quoted-printable-encode-region (point-min) (point-max))
 240     (goto-char (point-min))
 241     (if headers (insert headers))
 242     (insert "\n")
 243     t))
 244
 245 (defun mml1991-pgg-encrypt (cont &optional sign)
 246   (let (headers)
 247     ;; Don't sign headers.
 248     (goto-char (point-min))
 249     (while (not (looking-at "^$"))
 250       (forward-line))
 251     (unless (eobp) ;; no headers?
 252       (setq headers (buffer-substring (point-min) (point)))
 253       (forward-line) ;; skip header/body separator
 254       (kill-region (point-min) (point)))
 255     (unless (pgg-encrypt-region
 256              (point-min) (point-max)
 257              (split-string
 258               (or
 259                (message-options-get 'message-recipients)
 260                (message-options-set 'message-recipients
 261                                     (read-string "Recipients: ")))
 262               "[ \f\t\n\r\v,]+")
 263              sign)
 264       (pop-to-buffer pgg-errors-buffer)
 265       (error "Encrypt error"))
 266     (kill-region (point-min) (point-max))
 267     (if headers (insert headers))
 268     (insert "\n")
 269     (insert-buffer pgg-output-buffer)
 270     t))
 271
 272 ;;;###autoload
 273 (defun mml1991-encrypt (cont &optional sign)
 274   (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
 275     (if func
 276         (funcall func cont sign)
 277       (error "Cannot find encrypt function"))))
 278
 279 ;;;###autoload
 280 (defun mml1991-sign (cont)
 281   (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
 282     (if func
 283         (funcall func cont)
 284       (error "Cannot find sign function"))))
 285
 286 (provide 'mml1991)
 287
 288 ;; Local Variables:
 289 ;; coding: iso-8859-1
 290 ;; End:
 291
 292 ;;; mml1991.el ends here