From 2b9d2136a0fa581e83949a6fb5797fb246d7d07e Mon Sep 17 00:00:00 2001
From: Matthew Horsfall <wolfsage@gmail.com>
Date: Fri, 20 May 2016 14:24:26 -0400
Subject: [PATCH] Support multipart messages without content-type in subparts.
 (GH: #14)

Per RFC 1341, section 7.2

  https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html

  A body part is NOT to be interpreted as actually being an RFC 822 message.
  To begin with, NO header fields are actually required in body parts. A
  body part that starts with a blank line, therefore, is allowed and is a
  body part for which all default values are to be assumed. In such a case,
  the absence of a Content-Type header field implies that the encapsulation
  is plain US-ASCII text.
---
 lib/Email/MIME.pm | 22 ++++++++++++++++++-
 t/multipart.t     | 55 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 76 insertions(+), 1 deletion(-)

diff --git a/lib/Email/MIME.pm b/lib/Email/MIME.pm
index 89fa765..bd1c8b5 100644
--- a/lib/Email/MIME.pm
+++ b/lib/Email/MIME.pm
@@ -363,7 +363,7 @@ sub parts_multipart {
   # rfc1521 7.2.1
   my ($body, $epilogue) = split /^--\Q$boundary\E--\s*$/sm, $self->body_raw, 2;
 
-  my @bits = split /^--\Q$boundary\E\s*$/sm, ($body || '');
+  my @bits = split /^--\Q$boundary\E\s*?$/m, ($body || '');
 
   $self->SUPER::body_set(undef);
 
@@ -377,6 +377,26 @@ sub parts_multipart {
 
   my @parts;
   for my $bit (@bits) {
+    my $no_header;
+
+    # Parts don't need headers. If they don't have them, they look like this:
+    #
+    #   --90e6ba6e8d06f1723604fc1b809a
+    #
+    #   Part 2
+    #
+    #   Part 2a
+    #
+    # $bit will contain two new lines before Part 2.
+    #
+    # Anything with headers will only have one new line.
+    #
+    # RFC 1341 Section 7.2 says parts without headers are to be considered
+    # plain US-ASCII text.
+    if ($bit =~ /^([\r\n][\r\n])/) {
+      $bit = "Content-type: text/plain; charset=us-ascii" . $bit;
+    }
+
     $bit =~ s/\A[\n\r]+//smg;
     $bit =~ s/(?<!\x0d)$self->{mycrlf}\Z//sm;
     my $email = (ref $self)->new($bit);
diff --git a/t/multipart.t b/t/multipart.t
index 6d44836..1321ea4 100644
--- a/t/multipart.t
+++ b/t/multipart.t
@@ -5,6 +5,17 @@ use Test::More;
 use Carp; $SIG{__WARN__} = sub { Carp::cluck @_ };
 
 use_ok 'Email::MIME::Creator';
+use_ok 'Email::MIME::ContentType';
+
+sub ct {
+  return (
+    type    => $_[0], # okay!
+    subtype => $_[1], # okay!
+
+    discrete  => $_[0], # dumb!
+    composite => $_[1], # dumb!
+  );
+}
 
 my $hi    = Email::MIME->create(body => "Hi");
 my $hello = Email::MIME->create(body => "Hello");
@@ -89,4 +100,48 @@ END
   unlike($email->as_string, qr/Postlude/, "postlude in string");
 }
 
+{
+  my $email = Email::MIME->new(<<'END');
+From: Test <test@test.com>
+To: Test <test@test.com>
+Subject: Test
+Content-Type: multipart/alternative; boundary=90e6ba6e8d06f1723604fc1b809a
+
+--90e6ba6e8d06f1723604fc1b809a
+Content-Type: text/plain; charset=UTF-8
+
+Part 1
+
+Part 1a
+
+--90e6ba6e8d06f1723604fc1b809a
+
+Part 2
+
+Part 2a
+
+--90e6ba6e8d06f1723604fc1b809a--
+END
+
+  my @parts = $email->subparts;
+
+  is(@parts, 2, 'got 2 parts');
+
+  like($parts[0]->body, qr/^Part 1.*Part 1a$/s, 'Part 1 looks right');
+  is_deeply( parse_content_type($parts[0]->header('Content-Type')), {
+      ct(qw(text plain)),
+      attributes => {
+          charset => 'UTF-8',
+      },
+  }, 'explicit ct worked' );
+
+  like($parts[1]->body, qr/^Part 2.*Part 2a$/s, 'Part 2 looks right');
+  is_deeply( parse_content_type($parts[1]->header('Content-Type')), {
+      ct(qw(text plain)),
+      attributes => {
+          charset => 'us-ascii',
+      },
+  }, 'default ct worked' );
+}
+
 done_testing;