1 # This library is free software; you can redistribute it and/or modify
2 # it under the same terms as Perl itself.
4 # The license for this file differs from the rest of public-inbox.
6 # It monkey patches the "parts_multipart" subroutine with patches
7 # from Matthew Horsfall <wolfsage@gmail.com> at:
9 # git clone --mirror https://github.com/rjbs/Email-MIME.git refs/pull/28/head
11 # commit fe0eb870ab732507aa39a1070a2fd9435c7e4877
12 # ("Make sure we don't modify the body of a message when injecting a header.")
13 # commit 981d8201a7239b02114489529fd366c4c576a146
14 # ("GH #14 - Handle CRLF emails properly.")
15 # commit 2338d93598b5e8432df24bda8dfdc231bdeb666e
16 # ("GH #14 - Support multipart messages without content-type in subparts.")
18 # For Email::MIME >= 1.923 && < 1.935,
19 # commit dcef9be66c49ae89c7a5027a789bbbac544499ce
20 # ("removing all trailing newlines was too much")
22 package PublicInbox::MIME;
25 use base qw(Email::MIME);
27 if ($Email::MIME::VERSION <= 1.937) {
30 my $boundary = $self->{ct}->{attributes}->{boundary};
32 # Take a message, join all its lines together. Now try to Email::MIME->new
33 # it with 1.861 or earlier. Death! It tries to recurse endlessly on the
34 # body, because every time it splits on boundary it gets itself. Obviously
35 # that means it's a bogus message, but a mangled result (or exception) is
36 # better than endless recursion. -- rjbs, 2008-01-07
37 return $self->parts_single_part
38 unless $boundary and $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;
40 $self->{body_raw} = Email::Simple::body($self);
43 my ($body, $epilogue) = split /^--\Q$boundary\E--\s*$/sm, $self->body_raw, 2;
45 # Split on boundaries, but keep blank lines after them intact
46 my @bits = split /^--\Q$boundary\E\s*?(?=$self->{mycrlf})/m, ($body || '');
48 Email::Simple::body_set($self, undef);
50 # If there are no headers in the potential MIME part, it's just part of the
51 # body. This is a horrible hack, although it's debatable whether it was
52 # better or worse when it was $self->{body} = shift @bits ... -- rjbs,
54 Email::Simple::body_set($self, shift @bits) if ($bits[0] || '') !~ /.*:.*/;
60 # Parts don't need headers. If they don't have them, they look like this:
62 # --90e6ba6e8d06f1723604fc1b809a
68 # $bit will contain two new lines before Part 2.
70 # Anything with headers will only have one new line.
72 # RFC 1341 Section 7.2 says parts without headers are to be considered
73 # plain US-ASCII text. -- alh
77 if ($bit =~ /^(?:$self->{mycrlf}){2}/) {
78 $bit = "Content-type: text/plain; charset=us-ascii" . $bit;
83 $bit =~ s/\A[\n\r]+//smg;
84 $bit =~ s/(?<!\x0d)$self->{mycrlf}\Z//sm;
86 my $email = (ref $self)->new($bit);
89 # Remove our changes so we don't change the raw email content
90 $email->header_str_set('Content-Type');
96 $self->{parts} = \@parts;
98 return @{ $self->{parts} };