X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-view.el;h=5d4d3fc2c6e920d113cff198eabc8577e3ea9b1d;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=524b815b8a55896708000b0c5e3a7c2a7ab8c988;hpb=d0e319b544eb439c3afd135775d6deaebdea3b49;p=elisp%2Fgnus.git-

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index 524b815..5d4d3fc 100644
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -1,4 +1,4 @@
-;;; mm-view.el --- Functions for viewing MIME objects
+;;; mm-view.el --- functions for viewing MIME objects
 ;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -34,7 +34,8 @@
   (autoload 'vcard-parse-string "vcard")
   (autoload 'vcard-format-string "vcard")
   (autoload 'fill-flowed "flow-fill")
-  (autoload 'diff-mode "diff-mode"))
+  (unless (fboundp 'diff-mode)
+    (autoload 'diff-mode "diff-mode" "" t nil)))
 
 ;;;
 ;;; Functions for displaying various formats inline
@@ -150,24 +151,16 @@
 			      '(background background-pixmap foreground)))
 		  (delete-region ,(point-min-marker)
 				 ,(point-max-marker)))))))))
-     ((or (equal type "enriched")
-	  (equal type "richtext"))
-      (save-excursion
-	(mm-with-unibyte-buffer
-	  (mm-insert-part handle)
-	  (save-window-excursion
-	    (enriched-decode (point-min) (point-max))
-	    (setq text (buffer-string)))))
-      (mm-insert-inline handle text))
      ((equal type "x-vcard")
       (mm-insert-inline
        handle
        (concat "\n-- \n"
-	       (if (fboundp 'vcard-pretty-print)
-		   (vcard-pretty-print (mm-get-part handle))
-		 (vcard-format-string
-		  (vcard-parse-string (mm-get-part handle)
-				      'vcard-standard-filter))))))
+	       (ignore-errors
+		 (if (fboundp 'vcard-pretty-print)
+		     (vcard-pretty-print (mm-get-part handle))
+		   (vcard-format-string
+		    (vcard-parse-string (mm-get-part handle)
+					'vcard-standard-filter)))))))
      (t
       (let ((b (point))
 	    (charset (mail-content-type-get
@@ -192,6 +185,9 @@
 	(save-restriction
 	  (narrow-to-region b (point))
 	  (set-text-properties (point-min) (point-max) nil)
+	  (when (or (equal type "enriched")
+		    (equal type "richtext"))
+	    (enriched-decode (point-min) (point-max)))
 	  (mm-handle-set-undisplayer
 	   handle
 	   `(lambda ()
@@ -319,6 +315,58 @@
 (defun mm-display-elisp-inline (handle)
   (mm-display-inline-fontify handle 'emacs-lisp-mode))
 
+;;      id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
+;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
+(defvar mm-pkcs7-signed-magic
+  (mm-string-as-unibyte
+   (apply 'concat
+	  (mapcar 'char-to-string
+		  (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
+			?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
+			?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
+			?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02)))))
+
+;;      id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
+;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
+(defvar mm-pkcs7-enveloped-magic
+  (mm-string-as-unibyte
+   (apply 'concat
+	  (mapcar 'char-to-string
+		  (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
+			?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
+			?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
+			?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03)))))
+
+(defun mm-view-pkcs7-get-type (handle)
+  (mm-with-unibyte-buffer
+   (mm-insert-part handle)
+   (cond ((looking-at mm-pkcs7-enveloped-magic)
+	  'enveloped)
+	 ((looking-at mm-pkcs7-signed-magic)
+	  'signed)
+	 (t
+	  (error "Could not identify PKCS#7 type")))))
+
+(defun mm-view-pkcs7 (handle)
+  (case (mm-view-pkcs7-get-type handle)
+    (enveloped (mm-view-pkcs7-decrypt handle))
+    (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
+
+(defun mm-view-pkcs7-decrypt (handle)
+  (insert-buffer (mm-handle-buffer handle))
+  (goto-char (point-min))
+  (insert "MIME-Version: 1.0\n")
+  (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
+  (smime-decrypt-region
+   (point-min) (point-max)
+   (if (= (length smime-keys) 1)
+       (cadar smime-keys)
+     (smime-get-key-by-email
+      (completing-read "Decrypt this part with which key? "
+		       smime-keys nil nil
+		       (and (listp (car-safe smime-keys))
+			    (caar smime-keys)))))))
+
 (provide 'mm-view)
 
 ;;; mm-view.el ends here