From 3df4a6d4f1ec9ca150d2aca4d36f1508102c1097 Mon Sep 17 00:00:00 2001 From: ShengHuo ZHU Date: Mon, 6 Nov 2000 17:57:27 +0000 Subject: [PATCH] 2000-11-06 13:51:37 ShengHuo ZHU * mm-decode.el (mime-security): New group. (mm-verify-function-alist): Add test function. (mm-decrypt-function-alist): Ditto. (mm-snarf-option): Set default value as nil. (mm-find-part-by-type): Recursive parameter. (mm-possibly-verify-or-decrypt): Support draft-ietf-openpgp-multsig. * mml2015.el: Support draft-ietf-openpgp-multsig. --- lisp/ChangeLog | 10 +++++++ lisp/mm-decode.el | 74 ++++++++++++++++++++++++++++++----------------- lisp/mml2015.el | 25 ++++++++++++---- 3 files changed, 76 insertions(+), 33 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a443d8abe..630d6a2cf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2000-11-06 13:51:37 ShengHuo ZHU + + * mm-decode.el (mime-security): New group. + (mm-verify-function-alist): Add test function. + (mm-decrypt-function-alist): Ditto. + (mm-snarf-option): Set default value as nil. + (mm-find-part-by-type): Recursive parameter. + (mm-possibly-verify-or-decrypt): Support draft-ietf-openpgp-multsig. + * mml2015.el: Support draft-ietf-openpgp-multsig. + 2000-11-06 13:01:27 ShengHuo ZHU * gnus-art.el (gnus-mime-view-part-as-charset): New function. diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 8267ef46d..a2e4d0db8 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -40,6 +40,13 @@ :group 'news :group 'multimedia) +(defgroup mime-security () + "MIME security in mail and news articles." + :link '(custom-manual "(emacs-mime)Customization") + :group 'mail + :group 'news + :group 'multimedia) + ;;; Convenience macros. (defmacro mm-handle-buffer (handle) @@ -230,12 +237,13 @@ to: (defvar mm-dissect-default-type "text/plain") (autoload 'mml2015-verify "mml2015") +(autoload 'mml2015-verify-test "mml2015") (autoload 'mml-smime-verify "mml-smime") (defvar mm-verify-function-alist - '(("application/pgp-signature" mml2015-verify "PGP") - ("application/pkcs7-signature" mml-smime-verify "S/MIME") - ("application/x-pkcs7-signature" mml-smime-verify "S/MIME"))) + '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test) + ("application/pkcs7-signature" mml-smime-verify "S/MIME" nil) + ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" nil))) (defcustom mm-verify-option 'known "Option of verifying signed parts. @@ -245,12 +253,13 @@ to: (item never) (item :tag "only known protocols" known) (item :tag "ask" nil)) - :group 'gnus-article) + :group 'mime-security) (autoload 'mml2015-decrypt "mml2015") +(autoload 'mml2015-decrypt-test "mml2015") (defvar mm-decrypt-function-alist - '(("application/pgp-encrypted" mml2015-decrypt "PGP"))) + '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test))) (defcustom mm-decrypt-option 'known "Option of decrypting signed parts. @@ -260,9 +269,9 @@ to: (item never) (item :tag "only known protocols" known) (item :tag "ask" nil)) - :group 'gnus-article) + :group 'mime-security) -(defcustom mm-snarf-option 'known +(defcustom mm-snarf-option nil "Option of snarfing PGP key. `never', not snarf; `always', always snarf; `known', only snarf known protocols. Otherwise, ask user." @@ -270,7 +279,7 @@ to: (item never) (item :tag "only known protocols" known) (item :tag "ask" nil)) - :group 'gnus-article) + :group 'mime-security) (defvar mm-viewer-completion-map (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) @@ -926,16 +935,21 @@ external if displayed external." (and (mm-valid-image-format-p format) (mm-image-fit-p handle))) -(defun mm-find-part-by-type (handles type &optional notp) +(defun mm-find-part-by-type (handles type &optional notp recursive) "Search in HANDLES for part with TYPE. -If NOTP, returns first non-matching part." +If NOTP, returns first non-matching part. +If RECURSIVE, search recursively." (let (handle) (while handles - (if (if notp - (not (equal (mm-handle-media-type (car handles)) type)) - (equal (mm-handle-media-type (car handles)) type)) - (setq handle (car handles) - handles nil)) + (if (and recursive (stringp (caar handles))) + (if (setq handle (mm-find-part-by-type (cdar handles) type + notp recursive)) + (setq handles nil)) + (if (if notp + (not (equal (mm-handle-media-type (car handles)) type)) + (equal (mm-handle-media-type (car handles)) type)) + (setq handle (car handles) + handles nil))) (setq handles (cdr handles))) handle)) @@ -982,23 +996,27 @@ If NOTP, returns first non-matching part." (defun mm-possibly-verify-or-decrypt (parts ctl) (let ((subtype (cadr (split-string (car ctl) "/"))) - protocol func) + protocol func functest) (cond ((equal subtype "signed") - (unless (setq protocol (mail-content-type-get ctl 'protocol)) - ;; The message is broken. - (let ((parts parts)) - (while parts - (if (assoc (mm-handle-media-type (car parts)) - mm-verify-function-alist) - (setq protocol (mm-handle-media-type (car parts)) - parts nil) - (setq parts (cdr parts)))))) + (unless (and (setq protocol (mail-content-type-get ctl 'protocol)) + (not (equal protocol "multipart/mixed"))) + ;; The message is broken or draft-ietf-openpgp-multsig-01. + (let ((protocols mm-verify-function-alist)) + (while protocols + (if (and (or (not (setq functest (nth 3 (car protocols)))) + (funcall functest parts ctl)) + (mm-find-part-by-type parts (caar protocols) nil t)) + (setq protocol (caar protocols) + protocols nil) + (setq protocols (cdr protocols)))))) (setq func (nth 1 (assoc protocol mm-verify-function-alist))) + (setq functest (nth 3 (assoc protocol mm-verify-function-alist))) (if (cond ((eq mm-verify-option 'never) nil) ((eq mm-verify-option 'always) t) - ((eq mm-verify-option 'known) func) + ((eq mm-verify-option 'known) + (and func (funcall functest parts ctl))) (t (y-or-n-p (format "Verify signed (%s) part? " (or (nth 2 (assoc protocol mm-verify-function-alist)) @@ -1022,10 +1040,12 @@ If NOTP, returns first non-matching part." parts nil) (setq parts (cdr parts)))))) (setq func (nth 1 (assoc protocol mm-decrypt-function-alist))) + (setq functest (nth 3 (assoc protocol mm-decrypt-function-alist))) (if (cond ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) - ((eq mm-decrypt-option 'known) func) + ((eq mm-decrypt-option 'known) + (and func (funcall functest parts ctl))) (t (y-or-n-p (format "Decrypt (%s) part? " (or (nth 2 (assoc protocol mm-decrypt-function-alist)) diff --git a/lisp/mml2015.el b/lisp/mml2015.el index e4bf3d951..04b523b18 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -82,8 +82,9 @@ (defun mml2015-mailcrypt-decrypt (handle ctl) (let (child handles result) - (unless (setq child (mm-find-part-by-type (cdr handle) - "application/octet-stream")) + (unless (setq child (mm-find-part-by-type + (cdr handle) + "application/octet-stream" nil t)) (error "Corrupted pgp-encrypted part.")) (with-temp-buffer (mm-insert-part child) @@ -111,7 +112,9 @@ (defun mml2015-mailcrypt-verify (handle ctl) (let (part) (unless (setq part (mm-find-raw-part-by-type - ctl "application/pgp-signature" t)) + ctl (or (mail-content-type-get ctl 'protocol) + "application/pgp-signature") + t)) (error "Corrupted pgp-signature part.")) (with-temp-buffer (insert "-----BEGIN PGP SIGNED MESSAGE-----\n") @@ -122,7 +125,7 @@ (insert part "\n") (goto-char (point-max)) (unless (setq part (mm-find-part-by-type - (cdr handle) "application/pgp-signature")) + (cdr handle) "application/pgp-signature" nil t)) (error "Corrupted pgp-signature part.")) (mm-insert-part part) (unless (funcall mml2015-verify-function) @@ -245,7 +248,9 @@ (defun mml2015-gpg-verify (handle ctl) (let (part message signature) (unless (setq part (mm-find-raw-part-by-type - ctl "application/pgp-signature" t)) + ctl (or (mail-content-type-get ctl 'protocol) + "application/pgp-signature") + t)) (error "Corrupted pgp-signature part.")) (with-temp-buffer (setq message (current-buffer)) @@ -253,7 +258,7 @@ (with-temp-buffer (setq signature (current-buffer)) (unless (setq part (mm-find-part-by-type - (cdr handle) "application/pgp-signature")) + (cdr handle) "application/pgp-signature" nil t)) (error "Corrupted pgp-signature part.")) (mm-insert-part part) (unless (gpg-verify message signature mml2015-result-buffer) @@ -356,6 +361,10 @@ (funcall func handle ctl) handle))) +;;;###autoload +(defun mml2015-decrypt-test (handle ctl) + mml2015-use) + ;;;###autoload (defun mml2015-verify (handle ctl) (mml2015-clean-buffer) @@ -364,6 +373,10 @@ (funcall func handle ctl) handle))) +;;;###autoload +(defun mml2015-verify-test (handle ctl) + mml2015-use) + ;;;###autoload (defun mml2015-encrypt (cont) (mml2015-clean-buffer) -- 2.34.1