From: Simon Josefsson Date: Mon, 12 Nov 2001 21:33:12 +0000 (+0000) Subject: 2001-11-12 Simon Josefsson X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=commitdiff_plain;h=54f6b436f382d2c787dcd41282d108732b455bd9 2001-11-12 Simon Josefsson * mml1991.el (mml1991-use, mml1991-function-alist): New variables. (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from `mml1991-sign' and `mml1991-encrypt'. (mml1991-encrypt, mml1991-sign): New glue functions. (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions. * mml.el (mml-mode-map): `C-c RET o' map for PGP. (mml-menu): Add PGP to menu. * mml-sec.el (top-level): Require mml1991. Don't require smime. (mml-sign-alist, mml-encrypt-alist): Add "pgp". (mml-pgp-sign-buffer, mml-pgp-encrypt-buffer) (mml-secure-sign-pgp, mml-secure-encrypt-pgp): New glue functions. * mml2015.el: Mention RFC 3156. * mml1991.el: New file. From Sascha Lüdecke . --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2b91c9e77..a4ec655a1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2001-11-12 Simon Josefsson + + * mml1991.el (mml1991-use, mml1991-function-alist): New variables. + (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from + `mml1991-sign' and `mml1991-encrypt'. + (mml1991-encrypt, mml1991-sign): New glue functions. + (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions. + + * mml.el (mml-mode-map): `C-c RET o' map for PGP. + (mml-menu): Add PGP to menu. + + * mml-sec.el (top-level): Require mml1991. Don't require smime. + (mml-sign-alist, mml-encrypt-alist): Add "pgp". + (mml-pgp-sign-buffer, mml-pgp-encrypt-buffer) + (mml-secure-sign-pgp, mml-secure-encrypt-pgp): New glue functions. + + * mml2015.el: Mention RFC 3156. + + * mml1991.el: New file. From Sascha L,A|(Bdecke . + 2001-11-12 13:00:00 ShengHuo ZHU * gnus-start.el (gnus-auto-subscribed-groups): Use ^nnml. diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el index fbd92c789..3d3060289 100644 --- a/lisp/mml-sec.el +++ b/lisp/mml-sec.el @@ -23,13 +23,14 @@ ;;; Code: -(require 'smime) (require 'mml2015) +(require 'mml1991) (require 'mml-smime) (eval-when-compile (require 'cl)) (defvar mml-sign-alist '(("smime" mml-smime-sign-buffer mml-smime-sign-query) + ("pgp" mml-pgp-sign-buffer list) ("pgpmime" mml-pgpmime-sign-buffer list)) "Alist of MIME signer functions.") @@ -38,6 +39,7 @@ (defvar mml-encrypt-alist '(("smime" mml-smime-encrypt-buffer mml-smime-encrypt-query) + ("pgp" mml-pgp-encrypt-buffer list) ("pgpmime" mml-pgpmime-encrypt-buffer list)) "Alist of MIME encryption functions.") @@ -54,6 +56,14 @@ (or (mml-smime-encrypt cont) (error "Encryption failed... inspect message logs for errors"))) +(defun mml-pgp-sign-buffer (cont) + (or (mml1991-sign cont) + (error "Signing failed... inspect message logs for errors"))) + +(defun mml-pgp-encrypt-buffer (cont) + (or (mml1991-encrypt cont) + (error "Encryption failed... inspect message logs for errors"))) + (defun mml-pgpmime-sign-buffer (cont) (or (mml2015-sign cont) (error "Signing failed... inspect message logs for errors"))) @@ -87,6 +97,11 @@ (cons method tags)))) (t (error "The message is corrupted. No mail header separator")))))) +(defun mml-secure-sign-pgp () + "Add MML tags to PGP sign this MML part." + (interactive) + (mml-secure-part "pgp" 'sign)) + (defun mml-secure-sign-pgpmime () "Add MML tags to PGP/MIME sign this MML part." (interactive) @@ -97,6 +112,11 @@ (interactive) (mml-secure-part "smime" 'sign)) +(defun mml-secure-encrypt-pgp () + "Add MML tags to PGP encrypt this MML part." + (interactive) + (mml-secure-part "pgp")) + (defun mml-secure-encrypt-pgpmime () "Add MML tags to PGP/MIME encrypt this MML part." (interactive) diff --git a/lisp/mml.el b/lisp/mml.el index 9b28344f5..52d0d6314 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -705,8 +705,10 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (map (make-sparse-keymap)) (main (make-sparse-keymap))) (define-key sign "p" 'mml-secure-sign-pgpmime) + (define-key sign "o" 'mml-secure-sign-pgp) (define-key sign "s" 'mml-secure-sign-smime) (define-key encrypt "p" 'mml-secure-encrypt-pgpmime) + (define-key encrypt "o" 'mml-secure-encrypt-pgp) (define-key encrypt "s" 'mml-secure-encrypt-smime) (define-key map "f" 'mml-attach-file) (define-key map "b" 'mml-attach-buffer) @@ -734,6 +736,8 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Insert Multipart" mml-insert-multipart t] ["PGP/MIME Sign" mml-secure-sign-pgpmime t] ["PGP/MIME Encrypt" mml-secure-encrypt-pgpmime t] + ["PGP Sign" mml-secure-sign-pgp t] + ["PGP Encrypt" mml-secure-encrypt-pgp t] ["S/MIME Sign" mml-secure-sign-smime t] ["S/MIME Encrypt" mml-secure-encrypt-smime t] ;;["Narrow" mml-narrow-to-part t] diff --git a/lisp/mml1991.el b/lisp/mml1991.el new file mode 100644 index 000000000..8f2dcdfe1 --- /dev/null +++ b/lisp/mml1991.el @@ -0,0 +1,213 @@ +;;; mml-gpg-old.el --- Old PGP message format (RFC 1991) support for MML +;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. + +;; Author: Sascha Lüdecke , +;; Simon Josefsson (Mailcrypt interface, Gnus glue) +;; Keywords PGP + +;; This file is (not yet) part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; RCS: $Id: mml-gpg-old.el,v 1.2 2001/10/23 09:15:17 saschal Exp saschal $ + +;;; Code: + +(defvar mml1991-use mml2015-use + "The package used for PGP.") + +(defvar mml1991-function-alist + '((mailcrypt mml1991-mailcrypt-sign + mml1991-mailcrypt-encrypt) + (gpg mml1991-gpg-sign + mml1991-gpg-encrypt)) + "Alist of PGP/MIME functions.") + +;;; mailcrypt wrapper + +(eval-and-compile + (autoload 'mc-sign-generic "mc-toplev")) + +(defvar mml1991-decrypt-function 'mailcrypt-decrypt) +(defvar mml1991-verify-function 'mailcrypt-verify) + +(defun mml1991-mailcrypt-sign (cont) + (let ((text (current-buffer)) + headers signature + (result-buffer (get-buffer-create "*GPG Result*"))) + ;; Save MIME Content[^ ]+: headers from signing + (goto-char (point-min)) + (while (looking-at "^Content[^ ]+:") (forward-line)) + (if (> (point) (point-min)) + (progn + (setq headers (buffer-substring (point-min) (point))) + (kill-region (point-min) (point)))) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (quoted-printable-decode-region (point-min) (point-max)) + (with-temp-buffer + (setq signature (current-buffer)) + (insert-buffer text) + (unless (mc-sign-generic (message-options-get 'message-sender) + nil nil nil nil) + (unless (> (point-max) (point-min)) + (pop-to-buffer result-buffer) + (error "Sign error"))) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (quoted-printable-encode-region (point-min) (point-max)) + (set-buffer text) + (kill-region (point-min) (point-max)) + (if headers (insert headers)) + (insert "\n") + (insert-buffer signature) + (goto-char (point-max))))) + +(defun mml1991-mailcrypt-encrypt (cont) + (let ((text (current-buffer)) + cipher + (result-buffer (get-buffer-create "*GPG Result*"))) + ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED + (goto-char (point-min)) + (while (looking-at "^Content[^ ]+:") (forward-line)) + (if (> (point) (point-min)) + (progn + (kill-region (point-min) (point)))) + (mm-with-unibyte-current-buffer-mule4 + (with-temp-buffer + (setq cipher (current-buffer)) + (insert-buffer text) + (unless (mc-encrypt-generic + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + nil + (point-min) (point-max) + (message-options-get 'message-sender) + 'sign) + (unless (> (point-max) (point-min)) + (pop-to-buffer result-buffer) + (error "Encrypt error"))) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (set-buffer text) + (kill-region (point-min) (point-max)) + ;;(insert "Content-Type: application/pgp-encrypted\n\n") + ;;(insert "Version: 1\n\n") + (insert "\n") + (insert-buffer cipher) + (goto-char (point-max)))))) + +;;; gpg wrapper + +(eval-and-compile + (autoload 'gpg-sign-cleartext "gpg")) + +(defun mml1991-gpg-sign (cont) + (let ((text (current-buffer)) + headers signature + (result-buffer (get-buffer-create "*GPG Result*"))) + ;; Save MIME Content[^ ]+: headers from signing + (goto-char (point-min)) + (while (looking-at "^Content[^ ]+:") (forward-line)) + (if (> (point) (point-min)) + (progn + (setq headers (buffer-substring (point-min) (point))) + (kill-region (point-min) (point)))) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (quoted-printable-decode-region (point-min) (point-max)) + (with-temp-buffer + (unless (gpg-sign-cleartext text (setq signature (current-buffer)) + result-buffer + nil + (message-options-get 'message-sender)) + (unless (> (point-max) (point-min)) + (pop-to-buffer result-buffer) + (error "Sign error"))) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (quoted-printable-encode-region (point-min) (point-max)) + (set-buffer text) + (kill-region (point-min) (point-max)) + (if headers (insert headers)) + (insert "\n") + (insert-buffer signature) + (goto-char (point-max))))) + +(defun mml1991-gpg-encrypt (cont) + (let ((text (current-buffer)) + cipher + (result-buffer (get-buffer-create "*GPG Result*"))) + ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED + (goto-char (point-min)) + (while (looking-at "^Content[^ ]+:") (forward-line)) + (if (> (point) (point-min)) + (progn + (kill-region (point-min) (point)))) + (mm-with-unibyte-current-buffer-mule4 + (with-temp-buffer + (unless (gpg-sign-encrypt + text (setq cipher (current-buffer)) + result-buffer + (split-string + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+") + nil + (message-options-get 'message-sender) + t t) ; armor & textmode + (unless (> (point-max) (point-min)) + (pop-to-buffer result-buffer) + (error "Encrypt error"))) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (set-buffer text) + (kill-region (point-min) (point-max)) + ;;(insert "Content-Type: application/pgp-encrypted\n\n") + ;;(insert "Version: 1\n\n") + (insert "\n") + (insert-buffer cipher) + (goto-char (point-max)))))) + +;;;###autoload +(defun mml1991-encrypt (cont) + (let ((func (nth 2 (assq mml1991-use mml1991-function-alist)))) + (if func + (funcall func cont) + (error "Cannot find encrypt function")))) + +;;;###autoload +(defun mml1991-sign (cont) + (let ((func (nth 1 (assq mml1991-use mml1991-function-alist)))) + (if func + (funcall func cont) + (error "Cannot find sign function")))) + +(provide 'mml1991) + +;;; mml1991.el ends here diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 5989e3f8a..5c88821b9 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -23,6 +23,9 @@ ;;; Commentary: +;; RFC 2015 is updated by RFC 3156, this file should be compatible +;; with both. + ;;; Code: (eval-when-compile (require 'cl))