tm-parse.el

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