public-inbox.git  about / heads / tags
an "archives first" approach to mailing lists
blob 456eed64b8c444647c75bb1c21fa10ec512ad484 3315 bytes (raw)
$ git show ci-WIP:lib/PublicInbox/MIME.pm	# shows this blob on the CLI

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
 
# This library is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# The license for this file differs from the rest of public-inbox.
#
# It monkey patches the "parts_multipart" subroutine with patches
# from Matthew Horsfall <wolfsage@gmail.com> at:
#
# git clone --mirror https://github.com/rjbs/Email-MIME.git refs/pull/28/head
#
# commit fe0eb870ab732507aa39a1070a2fd9435c7e4877
# ("Make sure we don't modify the body of a message when injecting a header.")
# commit 981d8201a7239b02114489529fd366c4c576a146
# ("GH #14 - Handle CRLF emails properly.")
# commit 2338d93598b5e8432df24bda8dfdc231bdeb666e
# ("GH #14 - Support multipart messages without content-type in subparts.")
#
# For Email::MIME >= 1.923 && < 1.935,
# commit dcef9be66c49ae89c7a5027a789bbbac544499ce
# ("removing all trailing newlines was too much")
# is also included
package PublicInbox::MIME;
use strict;
use warnings;
use base qw(Email::MIME);
use Email::MIME::ContentType;
$Email::MIME::ContentType::STRICT_PARAMS = 0;

if ($Email::MIME::VERSION <= 1.937) {
sub parts_multipart {
  my $self     = shift;
  my $boundary = $self->{ct}->{attributes}->{boundary};

  # Take a message, join all its lines together.  Now try to Email::MIME->new
  # it with 1.861 or earlier.  Death!  It tries to recurse endlessly on the
  # body, because every time it splits on boundary it gets itself. Obviously
  # that means it's a bogus message, but a mangled result (or exception) is
  # better than endless recursion. -- rjbs, 2008-01-07
  return $self->parts_single_part
    unless $boundary and $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;

  $self->{body_raw} = Email::Simple::body($self);

  # rfc1521 7.2.1
  my ($body, $epilogue) = split /^--\Q$boundary\E--\s*$/sm, $self->body_raw, 2;

  # Split on boundaries, but keep blank lines after them intact
  my @bits = split /^--\Q$boundary\E\s*?(?=$self->{mycrlf})/m, ($body || '');

  Email::Simple::body_set($self, undef);

  # If there are no headers in the potential MIME part, it's just part of the
  # body.  This is a horrible hack, although it's debatable whether it was
  # better or worse when it was $self->{body} = shift @bits ... -- rjbs,
  # 2006-11-27
  Email::Simple::body_set($self, shift @bits) if ($bits[0] || '') !~ /.*:.*/;

  my $bits = @bits;

  my @parts;
  for my $bit (@bits) {
    # 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. -- alh
    # 2016-08-01
    my $added_header;

    if ($bit =~ /^(?:$self->{mycrlf}){2}/) {
      $bit = "Content-type: text/plain; charset=us-ascii" . $bit;

      $added_header = 1;
    }

    $bit =~ s/\A[\n\r]+//smg;
    $bit =~ s/(?<!\x0d)$self->{mycrlf}\Z//sm;

    my $email = (ref $self)->new($bit);

    if ($added_header) {
      # Remove our changes so we don't change the raw email content
      $email->header_str_set('Content-Type');
    }

    push @parts, $email;
  }

  $self->{parts} = \@parts;

  return @{ $self->{parts} };
}
}

1;

git clone https://public-inbox.org/public-inbox.git
git clone http://7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd.onion/public-inbox.git