diff lisp/gnus/mml1991.el @ 82951:0fde48feb604

Import Gnus 5.10 from the v5_10 branch of the Gnus repository.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/mml1991.el	Thu Jul 22 16:45:51 2004 +0000
@@ -0,0 +1,307 @@
+;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
+;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Sascha Lüdecke <[e-mail]>,
+;;	Simon Josefsson <[e-mail]> (Mailcrypt interface, Gnus glue)
+;; Keywords PGP
+
+;; This file is 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:
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl)
+  (require 'mm-util))
+
+(autoload 'quoted-printable-decode-region "qp")
+(autoload 'quoted-printable-encode-region "qp")
+
+(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)
+    (pgg mml1991-pgg-sign
+	 mml1991-pgg-encrypt))
+  "Alist of PGP 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))
+    (unless (bobp)
+      (setq headers (buffer-string))
+      (delete-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-substring 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)
+      (delete-region (point-min) (point-max))
+      (if headers (insert headers))
+      (insert "\n")
+      (insert-buffer-substring signature)
+      (goto-char (point-max)))))
+
+(defun mml1991-mailcrypt-encrypt (cont &optional sign)
+  (let ((text (current-buffer))
+	(mc-pgp-always-sign
+	 (or mc-pgp-always-sign
+	     sign
+	     (eq t (or (message-options-get 'message-sign-encrypt)
+		       (message-options-set
+			'message-sign-encrypt
+			(or (y-or-n-p "Sign the message? ")
+			    'not))))
+	     'never))
+	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))
+    (unless (bobp)
+      (delete-region (point-min) (point)))
+    (mm-with-unibyte-current-buffer
+      (with-temp-buffer
+	(setq cipher (current-buffer))
+	(insert-buffer-substring 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)
+	(delete-region (point-min) (point-max))
+	;;(insert "Content-Type: application/pgp-encrypted\n\n")
+	;;(insert "Version: 1\n\n")
+	(insert "\n")
+	(insert-buffer-substring 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))
+    (unless (bobp)
+      (setq headers (buffer-string))
+      (delete-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)
+      (delete-region (point-min) (point-max))
+      (if headers (insert headers))
+      (insert "\n")
+      (insert-buffer-substring signature)
+      (goto-char (point-max)))))
+
+(defun mml1991-gpg-encrypt (cont &optional sign)
+  (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))
+    (unless (bobp)
+      (delete-region (point-min) (point)))
+    (mm-with-unibyte-current-buffer
+      (with-temp-buffer
+	(flet ((gpg-encrypt-func 
+		(sign plaintext ciphertext result recipients &optional
+		      passphrase sign-with-key armor textmode)
+		(if sign
+		    (gpg-sign-encrypt
+		     plaintext ciphertext result recipients passphrase
+		     sign-with-key armor textmode)
+		  (gpg-encrypt
+		   plaintext ciphertext result recipients passphrase
+		   armor textmode))))
+	  (unless (gpg-encrypt-func
+		   sign
+		   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)
+	(delete-region (point-min) (point-max))
+	;;(insert "Content-Type: application/pgp-encrypted\n\n")
+	;;(insert "Version: 1\n\n")
+	(insert "\n")
+	(insert-buffer-substring cipher)
+	(goto-char (point-max))))))
+
+;; pgg wrapper
+
+(defvar pgg-output-buffer)
+(defvar pgg-errors-buffer)
+
+(defun mml1991-pgg-sign (cont)
+  (let (headers cte)
+    ;; Don't sign headers.
+    (goto-char (point-min))
+    (while (not (looking-at "^$"))
+      (forward-line))
+    (unless (eobp) ;; no headers?
+      (setq headers (buffer-substring (point-min) (point)))
+      (forward-line) ;; skip header/body separator
+      (delete-region (point-min) (point)))
+    (when (string-match "^Content-Transfer-Encoding: \\(.+\\)" headers)
+      (setq cte (intern (match-string 1 headers))))
+    (mm-decode-content-transfer-encoding cte)
+    (unless (let ((pgg-default-user-id
+		   (or (message-options-get 'mml-sender)
+		       pgg-default-user-id)))
+	      (pgg-sign-region (point-min) (point-max) t))
+      (pop-to-buffer pgg-errors-buffer)
+      (error "Encrypt error"))
+    (delete-region (point-min) (point-max))
+    (mm-with-unibyte-current-buffer
+      (insert-buffer-substring pgg-output-buffer)
+      (goto-char (point-min))
+      (while (re-search-forward "\r+$" nil t)
+	(replace-match "" t t))
+      (mm-encode-content-transfer-encoding cte)
+      (goto-char (point-min))
+      (when headers
+	(insert headers))
+      (insert "\n"))
+    t))
+
+(defun mml1991-pgg-encrypt (cont &optional sign)
+  (let (cte)
+    ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+    (goto-char (point-min))
+    (while (looking-at "^Content[^ ]+:")
+      (when (looking-at "^Content-Transfer-Encoding: \\(.+\\)")
+	(setq cte (intern (match-string 1))))
+      (forward-line))
+    (unless (bobp)
+      (delete-region (point-min) (point)))
+    (mm-decode-content-transfer-encoding cte)
+    (unless (pgg-encrypt-region
+	     (point-min) (point-max) 
+	     (split-string
+	      (or
+	       (message-options-get 'message-recipients)
+	       (message-options-set 'message-recipients
+				    (read-string "Recipients: ")))
+	      "[ \f\t\n\r\v,]+")
+	     sign)
+      (pop-to-buffer pgg-errors-buffer)
+      (error "Encrypt error"))
+    (delete-region (point-min) (point-max))
+    ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+    ;;(insert "Version: 1\n\n")
+    (insert "\n")
+    (insert-buffer-substring pgg-output-buffer)
+    t))
+
+;;;###autoload
+(defun mml1991-encrypt (cont &optional sign)
+  (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
+    (if func
+	(funcall func cont sign)
+      (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)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706
+;;; mml1991.el ends here