lib/PublicInbox/MIME.pm

   1 # This library is free software; you can redistribute it and/or modify
   2 # it under the same terms as Perl itself.
   3 #
   4 # The license for this file differs from the rest of public-inbox.
   5 #
   6 # We no longer load this in any of our code outside of maintainer
   7 # tests for compatibility.  PublicInbox::Eml is favored throughout
   8 # our codebase for performance and safety reasons, though we maintain
   9 # Email::MIME-compatibility in mail injection and indexing code paths.
  10 #
  11 # It monkey patches the "parts_multipart" subroutine with patches
  12 # from Matthew Horsfall <wolfsage@gmail.com> at:
  13 #
  14 # git clone --mirror https://github.com/rjbs/Email-MIME.git refs/pull/28/head
  15 #
  16 # commit fe0eb870ab732507aa39a1070a2fd9435c7e4877
  17 # ("Make sure we don't modify the body of a message when injecting a header.")
  18 # commit 981d8201a7239b02114489529fd366c4c576a146
  19 # ("GH #14 - Handle CRLF emails properly.")
  20 # commit 2338d93598b5e8432df24bda8dfdc231bdeb666e
  21 # ("GH #14 - Support multipart messages without content-type in subparts.")
  22 #
  23 # For Email::MIME >= 1.923 && < 1.935,
  24 # commit dcef9be66c49ae89c7a5027a789bbbac544499ce
  25 # ("removing all trailing newlines was too much")
  26 # is also included
  27 package PublicInbox::MIME;
  28 use strict;
  29 use warnings;
  30 use base qw(Email::MIME);
  31 use Email::MIME::ContentType;
  32 use PublicInbox::MsgIter ();
  33 $Email::MIME::ContentType::STRICT_PARAMS = 0;
  34
  35 if ($Email::MIME::VERSION <= 1.937) {
  36 sub parts_multipart {
  37   my $self     = shift;
  38   my $boundary = $self->{ct}->{attributes}->{boundary};
  39
  40   # Take a message, join all its lines together.  Now try to Email::MIME->new
  41   # it with 1.861 or earlier.  Death!  It tries to recurse endlessly on the
  42   # body, because every time it splits on boundary it gets itself. Obviously
  43   # that means it's a bogus message, but a mangled result (or exception) is
  44   # better than endless recursion. -- rjbs, 2008-01-07
  45   return $self->parts_single_part
  46     unless $boundary and $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;
  47
  48   $self->{body_raw} = Email::Simple::body($self);
  49
  50   # rfc1521 7.2.1
  51   my ($body, $epilogue) = split /^--\Q$boundary\E--\s*$/sm, $self->body_raw, 2;
  52
  53   # Split on boundaries, but keep blank lines after them intact
  54   my @bits = split /^--\Q$boundary\E\s*?(?=$self->{mycrlf})/m, ($body || '');
  55
  56   Email::Simple::body_set($self, undef);
  57
  58   # If there are no headers in the potential MIME part, it's just part of the
  59   # body.  This is a horrible hack, although it's debatable whether it was
  60   # better or worse when it was $self->{body} = shift @bits ... -- rjbs,
  61   # 2006-11-27
  62   Email::Simple::body_set($self, shift @bits) if ($bits[0] || '') !~ /.*:.*/;
  63
  64   my $bits = @bits;
  65
  66   my @parts;
  67   for my $bit (@bits) {
  68     # Parts don't need headers. If they don't have them, they look like this:
  69     #
  70     #   --90e6ba6e8d06f1723604fc1b809a
  71     #
  72     #   Part 2
  73     #
  74     #   Part 2a
  75     #
  76     # $bit will contain two new lines before Part 2.
  77     #
  78     # Anything with headers will only have one new line.
  79     #
  80     # RFC 1341 Section 7.2 says parts without headers are to be considered
  81     # plain US-ASCII text. -- alh
  82     # 2016-08-01
  83     my $added_header;
  84
  85     if ($bit =~ /^(?:$self->{mycrlf}){2}/) {
  86       $bit = "Content-type: text/plain; charset=us-ascii" . $bit;
  87
  88       $added_header = 1;
  89     }
  90
  91     $bit =~ s/\A[\n\r]+//smg;
  92     $bit =~ s/(?<!\x0d)$self->{mycrlf}\Z//sm;
  93
  94     my $email = (ref $self)->new($bit);
  95
  96     if ($added_header) {
  97       # Remove our changes so we don't change the raw email content
  98       $email->header_str_set('Content-Type');
  99     }
 100
 101     push @parts, $email;
 102   }
 103
 104   $self->{parts} = \@parts;
 105
 106   return @{ $self->{parts} };
 107 }
 108 }
 109
 110 no warnings 'once';
 111 *each_part = \&PublicInbox::MsgIter::em_each_part;
 112 1;