tm-parse.el

   1 ;;; tm-parse.el --- MIME message parser
   2
   3 ;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version:
   7 ;;      $Id: tm-parse.el,v 7.11 1996/08/30 06:20:52 morioka Exp $
   8 ;; Keywords: mail, news, MIME, multimedia
   9
  10 ;; This file is part of tm (Tools for MIME).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'tl-822)
  30 (require 'tl-misc)
  31 (require 'tm-def)
  32
  33
  34 ;;; @ field parser
  35 ;;;
  36
  37 (defconst mime::parameter-regexp
  38   (concat "^[ \t]*\;[ \t]*\\(" mime/token-regexp "\\)"
  39           "[ \t]*=[ \t]*\\(" mime/content-parameter-value-regexp "\\)"))
  40
  41 (defun mime/parse-parameter (str)
  42   (if (string-match mime::parameter-regexp str)
  43       (let ((e (match-end 2)))
  44         (cons
  45          (cons (downcase (substring str (match-beginning 1) (match-end 1)))
  46                (rfc822/strip-quoted-string
  47                 (substring str (match-beginning 2) e))
  48                )
  49          (substring str e)
  50          ))))
  51
  52 (defconst mime::ctype-regexp (concat "^" mime/content-type-subtype-regexp))
  53
  54 (defun mime/parse-Content-Type (string)
  55   "Parse STRING as field-body of Content-Type field. [tm-parse.el]"
  56   (setq string (std11-unfold-string string))
  57   (if (string-match mime::ctype-regexp string)
  58       (let* ((e (match-end 0))
  59              (ctype (downcase (substring string 0 e)))
  60              ret dest)
  61         (setq string (substring string e))
  62         (while (setq ret (mime/parse-parameter string))
  63           (setq dest (cons (car ret) dest)
  64                 string (cdr ret))
  65           )
  66         (cons ctype (nreverse dest))
  67         )))
  68
  69 (defconst mime::dtype-regexp (concat "^" mime/disposition-type-regexp))
  70
  71 (defun mime/parse-Content-Disposition (string)
  72   "Parse STRING as field-body of Content-Disposition field. [tm-parse.el]"
  73   (setq string (std11-unfold-string string))
  74   (if (string-match mime::dtype-regexp string)
  75       (let* ((e (match-end 0))
  76              (ctype (downcase (substring string 0 e)))
  77              ret dest)
  78         (setq string (substring string e))
  79         (while (setq ret (mime/parse-parameter string))
  80           (setq dest (cons (car ret) dest)
  81                 string (cdr ret))
  82           )
  83         (cons ctype (nreverse dest))
  84         )))
  85
  86
  87 ;;; @ field reader
  88 ;;;
  89
  90 (defun mime/Content-Type ()
  91   "Read field-body of Content-Type field from current-buffer,
  92 and return parsed it. [tm-parse.el]"
  93   (let ((str (std11-field-body "Content-Type")))
  94     (if str
  95         (mime/parse-Content-Type str)
  96       )))
  97
  98 (defun mime/Content-Transfer-Encoding (&optional default-encoding)
  99   "Read field-body of Content-Transfer-Encoding field from
 100 current-buffer, and return it.
 101 If is is not found, return DEFAULT-ENCODING. [tm-parse.el]"
 102   (let ((str (std11-field-body "Content-Transfer-Encoding")))
 103     (if str
 104         (progn
 105           (if (string-match "[ \t\n\r]+$" str)
 106               (setq str (substring str 0 (match-beginning 0)))
 107             )
 108           (downcase str)
 109           )
 110       default-encoding)
 111     ))
 112
 113 (defun mime/Content-Disposition ()
 114   "Read field-body of Content-Disposition field from current-buffer,
 115 and return parsed it. [tm-parse.el]"
 116   (let ((str (std11-field-body "Content-Disposition")))
 117     (if str
 118         (mime/parse-Content-Disposition str)
 119       )))
 120
 121
 122 ;;; @ message parser
 123 ;;;
 124
 125 (define-structure mime::content-info
 126   rcnum point-min point-max type parameters encoding children)
 127
 128
 129 (defun mime/parse-multipart (boundary ctype params encoding rcnum)
 130   (goto-char (point-min))
 131   (let* ((dash-boundary   (concat "--" boundary))
 132          (delimiter       (concat "\n" (regexp-quote dash-boundary)))
 133          (close-delimiter (concat delimiter "--[ \t]*$"))
 134          (beg (point-min))
 135          (end (progn
 136                 (goto-char (point-max))
 137                 (if (re-search-backward close-delimiter nil t)
 138                     (match-beginning 0)
 139                   (point-max)
 140                   )))
 141          (rsep (concat delimiter "[ \t]*\n"))
 142          (dc-ctl
 143           (if (string-equal ctype "multipart/digest")
 144               '("message/rfc822")
 145             '("text/plain")
 146             ))
 147          cb ce ct ret ncb children (i 0))
 148     (save-restriction
 149       (narrow-to-region beg end)
 150       (goto-char beg)
 151       (re-search-forward rsep nil t)
 152       (setq cb (match-end 0))
 153       (while (re-search-forward rsep nil t)
 154         (setq ce (match-beginning 0))
 155         (setq ncb (match-end 0))
 156         (save-restriction
 157           (narrow-to-region cb ce)
 158           (setq ret (mime/parse-message dc-ctl "7bit" (cons i rcnum)))
 159           )
 160         (setq children (cons ret children))
 161         (goto-char (mime::content-info/point-max ret))
 162         (goto-char (setq cb ncb))
 163         (setq i (1+ i))
 164         )
 165       (setq ce (point-max))
 166       (save-restriction
 167         (narrow-to-region cb ce)
 168         (setq ret (mime/parse-message dc-ctl "7bit" (cons i rcnum)))
 169         )
 170       (setq children (cons ret children))
 171       )
 172     (mime::content-info/create rcnum beg (point-max)
 173                                ctype params encoding
 174                                (nreverse children))
 175     ))
 176
 177 (defun mime/parse-message (&optional ctl encoding rcnum)
 178   "Parse current-buffer as a MIME message. [tm-parse.el]"
 179   (setq ctl (or (mime/Content-Type) ctl))
 180   (setq encoding (or (mime/Content-Transfer-Encoding) encoding))
 181   (let ((ctype (car ctl))
 182         (params (cdr ctl))
 183         )
 184     (let ((boundary (assoc "boundary" params)))
 185       (cond (boundary
 186              (setq boundary (rfc822/strip-quoted-string (cdr boundary)))
 187              (mime/parse-multipart boundary ctype params encoding rcnum)
 188              )
 189             ((string-equal ctype "message/rfc822")
 190              (goto-char (point-min))
 191              (mime::content-info/create rcnum
 192                                         (point-min) (point-max)
 193                                         ctype params encoding
 194                                         (save-restriction
 195                                           (narrow-to-region
 196                                            (if (re-search-forward "^$" nil t)
 197                                                (1+ (match-end 0))
 198                                              (point-min)
 199                                              )
 200                                            (point-max))
 201                                           (list (mime/parse-message
 202                                                  nil nil (cons 0 rcnum)))
 203                                           )
 204                                         )
 205              )
 206             (t
 207              (mime::content-info/create rcnum (point-min) (point-max)
 208                                         ctype params encoding nil)
 209              ))
 210       )))
 211
 212
 213 ;;; @ end
 214 ;;;
 215
 216 (provide 'tm-parse)
 217
 218 ;;; tm-parse.el ends here