From b19dd4e48267b5a2565e45c9bda684e726a14458 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 14 Feb 2002 03:45:08 +0000
Subject: [PATCH] .

original commit: c2fa57b5d916546df9f1aacd4ae6ce75a2a18e08
---
 collects/net/mime-unit.ss | 63 +++++++++++++++++++--------------------
 1 file changed, 30 insertions(+), 33 deletions(-)

diff --git a/collects/net/mime-unit.ss b/collects/net/mime-unit.ss
index 53194ce..dd741e0 100644
--- a/collects/net/mime-unit.ss
+++ b/collects/net/mime-unit.ss
@@ -33,7 +33,8 @@
 	   "head-sig.ss"
            "mime-util.ss"
            (lib "unitsig.ss")
-           (lib "etc.ss"))
+           (lib "etc.ss")
+           (lib "string.ss"))
 
   (provide net:mime@)
   (define net:mime@
@@ -69,6 +70,7 @@
       (define ietf-extensions '())
       (define iana-extensions '(;; text
                                 ("plain" . plain)
+                                ("html" . html)
                                 ("richtext"  . richtext)
                                 ("tab-separated-values" . tab-separated-values)
                                 ;; Multipart
@@ -279,38 +281,33 @@
       ;; Returns a list of input ports, each one containing the correspongind part.
       (define multipart-body
         (lambda (input boundary)
-          (letrec ((eat-part (lambda ()
-                               (let-values ([(pin pout) (make-pipe)])
-                                 (let loop ((ln (read-line input)))
-                                   (cond ((eof-object? ln)
-                                          (close-output-port pout)
-                                          (values pin;; part
-                                                  #f;; close-delimiter?
-                                                  #t;; eof reached?
-                                                  ))
-                                         ((regexp-match
-                                           (regexp (string-append "^--"
-                                                                  boundary
-                                                                  "--"
-                                                                  )) ln)
-					  (close-output-port pout)
-                                          (values pin #t #f))
-                                         ((regexp-match
-                                           (regexp (string-append "^--"
-                                                                  boundary
-                                                                  )) ln)
-                                          (close-output-port pout)
-                                          (values pin #f #f))
-                                         (else
-                                          (fprintf pout "~a~n" ln)
-                                          (loop (read-line input)))))))))
-	    (eat-part) ;; preamble
-            (let loop ()
-	      (let-values ([(part close? eof?) (eat-part)])
-		(cond (close? (list part))
-		      (eof? null)
-		      (else
-		       (cons part (loop)))))))))
+          (let ([re:done (regexp (string-append "^--" (regexp-quote boundary) "--"))]
+                [re:sep (regexp (string-append "^--" (regexp-quote boundary)))])
+            (letrec ((eat-part (lambda ()
+                                 (let-values ([(pin pout) (make-pipe)])
+                                   (let loop ((ln (read-line input)))
+                                     (cond ((eof-object? ln)
+                                            (close-output-port pout)
+                                            (values pin;; part
+                                                    #f;; close-delimiter?
+                                                    #t;; eof reached?
+                                                    ))
+                                           ((regexp-match re:done ln)
+                                            (close-output-port pout)
+                                            (values pin #t #f))
+                                           ((regexp-match re:sep ln)
+                                            (close-output-port pout)
+                                            (values pin #f #f))
+                                           (else
+                                            (fprintf pout "~a~n" ln)
+                                            (loop (read-line input)))))))))
+              (eat-part) ;; preamble
+              (let loop ()
+                (let-values ([(part close? eof?) (eat-part)])
+                  (cond (close? (list part))
+                        (eof? null)
+                        (else
+                         (cons part (loop))))))))))
       
       ;; MIME-message-headers := entity-headers
       ;; 			fields