1 ;;; mm-archive.el --- Functions for parsing archive files as MIME
3 ;; Copyright (C) 2012 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; This file is part of GNU Emacs.
8 ;; GNU Emacs is free software: you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 (defvar mm-archive-decoders
26 '(("application/ms-tnef" "tnef" "-f" "-" "-C")
27 ("application/x-gtar-compressed" "tar" "xzf" "-" "-C")
28 ("application/x-tar" "tar" "xf" "-" "-C")))
30 (defun mm-dissect-archive (handle)
31 (let ((decoder (cdr (assoc (car (mm-handle-type handle))
32 mm-archive-decoders)))
33 (dir (mm-make-temp-file
34 (expand-file-name "emm." mm-tmp-directory) 'dir)))
35 (set-file-modes dir #o700)
38 (mm-with-unibyte-buffer
39 (mm-insert-part handle)
40 (apply 'call-process-region (point-min) (point-max) (car decoder)
41 nil (get-buffer-create "*tnef*")
42 nil (append (cdr decoder) (list dir))))
45 ,@(mm-archive-list-files (gnus-recursive-directory-files dir))))
46 (delete-directory dir t))))
48 (defun mm-archive-list-files (files)
53 (when (string-match "\\.\\([^.]+\\)$" file)
54 (setq type (mailcap-extension-to-mime (match-string 1 file))))
56 (setq type "application/octet-stream"))
58 (if (string-match "^image/\\|^text/" type)
61 (insert (format "Content-type: %s\n" type))
62 (insert "Content-Transfer-Encoding: 8bit\n\n")
63 (insert-file-contents (expand-file-name file dir))
65 (mm-make-handle (mm-copy-to-buffer)
68 `(,disposition (filename . ,file))
75 ;; mm-archive.el ends here