From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Tue, 31 Jan 2012 18:35:21 +0000 (+0100)
Subject: Add support for viewing ms-tnef files, and possibly other archives.
X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=commitdiff_plain;h=7614d15141b55d710334ba47d9940081cd75b4b8

Add support for viewing ms-tnef files, and possibly other archives.

* mm-archive.el: New file.

* mm-decode.el (mm-dissect-singlepart): Use it to decode ms-tnef files.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 11bd23a0b..f4201a700 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2012-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
 
+	* mm-archive.el: New file.
+
+	* mm-decode.el (mm-dissect-singlepart): Use it to decode ms-tnef files.
+
 	* mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
 
 	* message.el (message-goto-*): Make all the `message-goto-*' commands
diff --git a/lisp/mm-archive.el b/lisp/mm-archive.el
new file mode 100644
index 000000000..dbe68af1e
--- /dev/null
+++ b/lisp/mm-archive.el
@@ -0,0 +1,75 @@
+;;; mm-archive.el --- Functions for parsing archive files as MIME
+
+;; Copyright (C) 2012  Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; 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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(defvar mm-archive-decoders
+  '(("application/ms-tnef" "tnef" "-f" "-" "-C")))
+
+(defun mm-dissect-archive (handle)
+  (let ((decoder (cdr (assoc (car (mm-handle-type handle))
+			     mm-archive-decoders)))
+	(dir (mm-make-temp-file
+	      (expand-file-name "emm." mm-tmp-directory) 'dir)))
+    (set-file-modes dir #o700)
+    (unwind-protect
+	(progn
+	  (mm-with-unibyte-buffer
+	    (mm-insert-part handle)
+	    (apply 'call-process-region (point-min) (point-max) (car decoder)
+		   nil (get-buffer-create "*tnef*")
+		   nil (append (cdr decoder) (list dir))))
+	  `("multipart/mixed"
+	    ,handle
+	    ,@(mm-archive-list-files dir)))
+      (dolist (file (directory-files dir))
+	(unless (member file '("." ".."))
+	  (ignore-errors
+	    (delete-file (expand-file-name file dir)))))
+      (ignore-errors
+	(delete-directory dir)))))
+
+(defun mm-archive-list-files (dir)
+  (let ((handles nil)
+	type)
+    (dolist (file (directory-files dir))
+      (unless (member file '("." ".."))
+	(with-temp-buffer
+	  (when (string-match "\\.\\([^.]+\\)$" file)
+	    (setq type (mailcap-extension-to-mime (match-string 1 file))))
+	  (unless type
+	    (setq type "application/octet-stream"))
+	  (insert (format "Content-type: %s\n" type))
+	  (insert "Content-Transfer-Encoding: 8bit\n\n")
+	  (insert-file-contents (expand-file-name file dir))
+	  (push
+	   (mm-make-handle (mm-copy-to-buffer)
+			   (list type)
+			   '8bit nil
+			   `("attachment" (filename . ,file))
+			   nil nil nil)
+	   handles))))
+    handles))
+
+(provide 'mm-archive)
+
+;; mm-archive.el ends here
diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index dd3eb6c9d..a66a9c559 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -29,6 +29,7 @@
 
 (require 'mail-parse)
 (require 'mm-bodies)
+(require 'mm-archive)
 (eval-when-compile (require 'cl)
 		   (require 'term))
 
@@ -653,8 +654,12 @@ Postpone undisplaying of viewers for types in
 	    (if (equal "text/plain" (car ctl))
 		(assoc 'format ctl)
 	      t))
-    (mm-make-handle
-     (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+    (let ((handle
+	   (mm-make-handle
+	    (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+      (if (member (car ctl) mm-archive-decoders)
+	  (mm-dissect-archive handle)
+	handle))))
 
 (defun mm-dissect-multipart (ctl from)
   (goto-char (point-min))