cgit.sxemacs.org Git - gnus/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 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 ;; RCS: $Id: mml1991.el,v 6.11 2002/10/05 05:31:37 jas Exp $
  28
  29 ;;; Code:
  30
  31 (defvar mml1991-use mml2015-use
  32   "The package used for PGP.")
  33
  34 (defvar mml1991-function-alist
  35   '((mailcrypt mml1991-mailcrypt-sign
  36                mml1991-mailcrypt-encrypt)
  37     (gpg mml1991-gpg-sign
  38          mml1991-gpg-encrypt)
  39     (pgg mml1991-pgg-sign
  40          mml1991-pgg-encrypt))
  41   "Alist of PGP functions.")
  42
  43 ;;; mailcrypt wrapper
  44
  45 (eval-and-compile
  46   (autoload 'mc-sign-generic "mc-toplev"))
  47
  48 (defvar mml1991-decrypt-function 'mailcrypt-decrypt)
  49 (defvar mml1991-verify-function 'mailcrypt-verify)
  50
  51 (defun mml1991-mailcrypt-sign (cont)
  52   (let ((text (current-buffer))
  53         headers signature
  54         (result-buffer (get-buffer-create "*GPG Result*")))
  55     ;; Save MIME Content[^ ]+: headers from signing
  56     (goto-char (point-min))
  57     (while (looking-at "^Content[^ ]+:") (forward-line))
  58     (if (> (point) (point-min))
  59         (progn
  60           (setq headers (buffer-substring (point-min) (point)))
  61           (kill-region (point-min) (point))))
  62     (goto-char (point-max))
  63     (unless (bolp)
  64       (insert "\n"))
  65     (quoted-printable-decode-region (point-min) (point-max))
  66     (with-temp-buffer
  67       (setq signature (current-buffer))
  68       (insert-buffer text)
  69       (unless (mc-sign-generic (message-options-get 'message-sender)
  70                                nil nil nil nil)
  71         (unless (> (point-max) (point-min))
  72           (pop-to-buffer result-buffer)
  73           (error "Sign error")))
  74       (goto-char (point-min))
  75       (while (re-search-forward "\r+$" nil t)
  76         (replace-match "" t t))
  77       (quoted-printable-encode-region (point-min) (point-max))
  78       (set-buffer text)
  79       (kill-region (point-min) (point-max))
  80       (if headers (insert headers))
  81       (insert "\n")
  82       (insert-buffer signature)
  83       (goto-char (point-max)))))
  84
  85 (defun mml1991-mailcrypt-encrypt (cont)
  86   (let ((text (current-buffer))
  87         cipher
  88         (result-buffer (get-buffer-create "*GPG Result*")))
  89     ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
  90     (goto-char (point-min))
  91     (while (looking-at "^Content[^ ]+:") (forward-line))
  92     (if (> (point) (point-min))
  93         (progn
  94           (kill-region (point-min) (point))))
  95     (mm-with-unibyte-current-buffer-mule4
  96       (with-temp-buffer
  97         (setq cipher (current-buffer))
  98         (insert-buffer text)
  99         (unless (mc-encrypt-generic
 100                  (or
 101                   (message-options-get 'message-recipients)
 102                   (message-options-set 'message-recipients
 103                                        (read-string "Recipients: ")))
 104                  nil
 105                  (point-min) (point-max)
 106                  (message-options-get 'message-sender)
 107                  'sign)
 108           (unless (> (point-max) (point-min))
 109             (pop-to-buffer result-buffer)
 110             (error "Encrypt error")))
 111         (goto-char (point-min))
 112         (while (re-search-forward "\r+$" nil t)
 113           (replace-match "" t t))
 114         (set-buffer text)
 115         (kill-region (point-min) (point-max))
 116         ;;(insert "Content-Type: application/pgp-encrypted\n\n")
 117         ;;(insert "Version: 1\n\n")
 118         (insert "\n")
 119         (insert-buffer cipher)
 120         (goto-char (point-max))))))
 121
 122 ;;; gpg wrapper
 123
 124 (eval-and-compile
 125   (autoload 'gpg-sign-cleartext "gpg"))
 126
 127 (defun mml1991-gpg-sign (cont)
 128   (let ((text (current-buffer))
 129         headers signature
 130         (result-buffer (get-buffer-create "*GPG Result*")))
 131     ;; Save MIME Content[^ ]+: headers from signing
 132     (goto-char (point-min))
 133     (while (looking-at "^Content[^ ]+:") (forward-line))
 134     (if (> (point) (point-min))
 135         (progn
 136           (setq headers (buffer-substring (point-min) (point)))
 137           (kill-region (point-min) (point))))
 138     (goto-char (point-max))
 139     (unless (bolp)
 140       (insert "\n"))
 141     (quoted-printable-decode-region (point-min) (point-max))
 142     (with-temp-buffer
 143       (unless (gpg-sign-cleartext text (setq signature (current-buffer))
 144                                   result-buffer
 145                                   nil
 146                                   (message-options-get 'message-sender))
 147         (unless (> (point-max) (point-min))
 148           (pop-to-buffer result-buffer)
 149           (error "Sign error")))
 150       (goto-char (point-min))
 151       (while (re-search-forward "\r+$" nil t)
 152         (replace-match "" t t))
 153       (quoted-printable-encode-region (point-min) (point-max))
 154       (set-buffer text)
 155       (kill-region (point-min) (point-max))
 156       (if headers (insert headers))
 157       (insert "\n")
 158       (insert-buffer signature)
 159       (goto-char (point-max)))))
 160
 161 (defun mml1991-gpg-encrypt (cont)
 162   (let ((text (current-buffer))
 163         cipher
 164         (result-buffer (get-buffer-create "*GPG Result*")))
 165     ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
 166     (goto-char (point-min))
 167     (while (looking-at "^Content[^ ]+:") (forward-line))
 168     (if (> (point) (point-min))
 169         (progn
 170           (kill-region (point-min) (point))))
 171     (mm-with-unibyte-current-buffer-mule4
 172       (with-temp-buffer
 173         (unless (gpg-sign-encrypt
 174                  text (setq cipher (current-buffer))
 175                  result-buffer
 176                  (split-string
 177                   (or
 178                    (message-options-get 'message-recipients)
 179                    (message-options-set 'message-recipients
 180                                         (read-string "Recipients: ")))
 181                   "[ \f\t\n\r\v,]+")
 182                  nil
 183                  (message-options-get 'message-sender)
 184                  t t) ; armor & textmode
 185           (unless (> (point-max) (point-min))
 186             (pop-to-buffer result-buffer)
 187             (error "Encrypt error")))
 188         (goto-char (point-min))
 189         (while (re-search-forward "\r+$" nil t)
 190           (replace-match "" t t))
 191         (set-buffer text)
 192         (kill-region (point-min) (point-max))
 193         ;;(insert "Content-Type: application/pgp-encrypted\n\n")
 194         ;;(insert "Version: 1\n\n")
 195         (insert "\n")
 196         (insert-buffer cipher)
 197         (goto-char (point-max))))))
 198
 199 ;; pgg wrapper
 200
 201 (defvar pgg-output-buffer)
 202 (defvar pgg-errors-buffer)
 203
 204 (defun mml1991-pgg-sign (cont)
 205   (let (headers)
 206     ;; Don't sign headers.
 207     (goto-char (point-min))
 208     (while (not (looking-at "^$"))
 209       (forward-line))
 210     (unless (eobp) ;; no headers?
 211       (setq headers (buffer-substring (point-min) (point)))
 212       (forward-line) ;; skip header/body separator
 213       (kill-region (point-min) (point)))
 214     (quoted-printable-decode-region (point-min) (point-max))
 215     (unless (let ((pgg-default-user-id (message-options-get 'message-sender)))
 216               (pgg-sign-region (point-min) (point-max) t))
 217       (pop-to-buffer pgg-errors-buffer)
 218       (error "Encrypt error"))
 219     (kill-region (point-min) (point-max))
 220     (insert-buffer pgg-output-buffer)
 221     (quoted-printable-encode-region (point-min) (point-max))
 222     (goto-char (point-min))
 223     (if headers (insert headers))
 224     (insert "\n")
 225     t))
 226
 227 (defun mml1991-pgg-encrypt (cont)
 228   (let (headers)
 229     ;; Don't sign headers.
 230     (goto-char (point-min))
 231     (while (not (looking-at "^$"))
 232       (forward-line))
 233     (unless (eobp) ;; no headers?
 234       (setq headers (buffer-substring (point-min) (point)))
 235       (forward-line) ;; skip header/body separator
 236       (kill-region (point-min) (point)))
 237     (unless (pgg-encrypt-region
 238              (point-min) (point-max)
 239              (split-string
 240               (or
 241                (message-options-get 'message-recipients)
 242                (message-options-set 'message-recipients
 243                                     (read-string "Recipients: ")))
 244               "[ \f\t\n\r\v,]+"))
 245       (pop-to-buffer pgg-errors-buffer)
 246       (error "Encrypt error"))
 247     (kill-region (point-min) (point-max))
 248     (if headers (insert headers))
 249     (insert "\n")
 250     (insert-buffer pgg-output-buffer)
 251     t))
 252
 253 ;;;###autoload
 254 (defun mml1991-encrypt (cont)
 255   (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
 256     (if func
 257         (funcall func cont)
 258       (error "Cannot find encrypt function"))))
 259
 260 ;;;###autoload
 261 (defun mml1991-sign (cont)
 262   (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
 263     (if func
 264         (funcall func cont)
 265       (error "Cannot find sign function"))))
 266
 267 (provide 'mml1991)
 268
 269 ;; Local Variables:
 270 ;; coding: iso-8859-1
 271 ;; End:
 272
 273 ;;; mml1991.el ends here