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/zip" "unzip" "-j" "-x" "%f" "-d")
28 ("application/x-gtar-compressed" "tar" "xzf" "-" "-C")
29 ("application/x-tar" "tar" "xf" "-" "-C")))
31 (defun mm-dissect-archive (handle)
32 (let ((decoder (cdr (assoc (car (mm-handle-type handle))
33 mm-archive-decoders)))
34 (dir (mm-make-temp-file
35 (expand-file-name "emm." mm-tmp-directory) 'dir)))
36 (set-file-modes dir #o700)
39 (mm-with-unibyte-buffer
40 (mm-insert-part handle)
41 (if (member "%f" decoder)
42 (let ((file (expand-file-name "mail.zip" dir)))
43 (write-region (point-min) (point-max) file nil 'silent)
44 (setq decoder (copy-sequence decoder))
45 (setcar (member "%f" decoder) file)
46 (apply 'call-process (car decoder) nil nil nil
47 (append (cdr decoder) (list dir)))
49 (apply 'call-process-region (point-min) (point-max) (car decoder)
50 nil (get-buffer-create "*tnef*")
51 nil (append (cdr decoder) (list dir)))))
54 ,@(mm-archive-list-files (gnus-recursive-directory-files dir))))
55 (delete-directory dir t))))
57 (defun mm-archive-list-files (files)
62 (when (string-match "\\.\\([^.]+\\)$" file)
63 (setq type (mailcap-extension-to-mime (match-string 1 file))))
65 (setq type "application/octet-stream"))
67 (if (string-match "^image/\\|^text/" type)
70 (insert (format "Content-type: %s\n" type))
71 (insert "Content-Transfer-Encoding: 8bit\n\n")
72 (insert-file-contents file)
74 (mm-make-handle (mm-copy-to-buffer)
77 `(,disposition (filename . ,file))
84 ;; mm-archive.el ends here