use Carp qw(croak);
use Encode qw(find_encoding decode encode); # stdlib
use Text::Wrap qw(wrap); # stdlib, we need Perl 5.6+ for $huge
+use MIME::Base64 3.05; # Perl 5.10.0 / 5.9.2
+use MIME::QuotedPrint 3.05; # ditto
my $MIME_Header = find_encoding('MIME-Header');
-# TODO remove these dependencies
-use Email::MIME::ContentType;
-use Email::MIME::Encodings;
-$Email::MIME::ContentType::STRICT_PARAMS = 0;
+use PublicInbox::EmlContentFoo qw(parse_content_type parse_content_disposition);
+$PublicInbox::EmlContentFoo::STRICT_PARAMS = 0;
our $MAXPARTS = 1000; # same as SpamAssassin
our $MAXDEPTH = 20; # seems enough, Perl sucks, here
our $MAXBOUNDLEN = 2048; # same as postfix
+our $header_size_limit = 102400; # same as postfix
+
+my %MIME_ENC = (qp => \&enc_qp, base64 => \&encode_base64);
+my %MIME_DEC = (qp => \&dec_qp, base64 => \&decode_base64);
+$MIME_ENC{quotedprint} = $MIME_ENC{'quoted-printable'} = $MIME_ENC{qp};
+$MIME_DEC{quotedprint} = $MIME_DEC{'quoted-printable'} = $MIME_DEC{qp};
+$MIME_ENC{$_} = \&identity_codec for qw(7bit 8bit binary);
-my $NO_ENCODE_RE = qr/\A(?:7bit|8bit|binary)[ \t]*(?:;|$)?/i;
my %DECODE_ADDRESS = map { $_ => 1 } qw(From To Cc Sender Reply-To);
my %DECODE_FULL = (
Subject => 1,
/ismx
}
+sub hdr_truncate ($) {
+ my $len = length($_[0]);
+ substr($_[0], $header_size_limit, $len) = '';
+ my $end = rindex($_[0], "\n");
+ if ($end >= 0) {
+ ++$end;
+ substr($_[0], $end, $len) = '';
+ warn "header of $len bytes truncated to $end bytes\n";
+ } else {
+ $_[0] = '';
+ warn <<EOF
+header of $len bytes without `\\n' within $header_size_limit ignored
+EOF
+ }
+}
+
# compatible with our uses of Email::MIME
sub new {
my $ref = ref($_[1]) ? $_[1] : \(my $cpy = $_[1]);
- if ($$ref =~ /(?:\r?\n(\r?\n))/gs) { # likely
- # This can modify $$ref in-place and to avoid memcpy/memmove
- # on a potentially large $$ref. It does need to make a
- # copy for $hdr, though. Idea stolen from Email::Simple
- my $hdr = substr($$ref, 0, pos($$ref), ''); # sv_chop on $$ref
+ # substr() can modify the first arg in-place and to avoid
+ # memcpy/memmove on a potentially large scalar. It does need
+ # to make a copy for $hdr, though. Idea stolen from Email::Simple.
+
+ # We also prefer index() on common LFLF emails since it's faster
+ # and re scan can bump RSS by length($$ref) on big strings
+ if (index($$ref, "\r\n") < 0 && (my $pos = index($$ref, "\n\n")) >= 0) {
+ # likely on *nix
+ my $hdr = substr($$ref, 0, $pos + 2, ''); # sv_chop on $$ref
+ chop($hdr); # lower SvCUR
+ hdr_truncate($hdr) if length($hdr) > $header_size_limit;
+ bless { hdr => \$hdr, crlf => "\n", bdy => $ref }, __PACKAGE__;
+ } elsif ($$ref =~ /\r?\n(\r?\n)/s) {
+ my $hdr = substr($$ref, 0, $+[0], ''); # sv_chop on $$ref
substr($hdr, -(length($1))) = ''; # lower SvCUR
+ hdr_truncate($hdr) if length($hdr) > $header_size_limit;
bless { hdr => \$hdr, crlf => $1, bdy => $ref }, __PACKAGE__;
} elsif ($$ref =~ /^[a-z0-9-]+[ \t]*:/ims && $$ref =~ /(\r?\n)\z/s) {
# body is optional :P
- bless { hdr => \($$ref), crlf => $1 }, __PACKAGE__;
+ my $hdr = substr($$ref, 0, $header_size_limit + 1);
+ hdr_truncate($hdr) if length($hdr) > $header_size_limit;
+ bless { hdr => \$hdr, crlf => $1 }, __PACKAGE__;
} else { # nothing useful
my $hdr = $$ref = '';
bless { hdr => \$hdr, crlf => "\n" }, __PACKAGE__;
sub new_sub {
my (undef, $ref) = @_;
# special case for messages like <85k5su9k59.fsf_-_@lola.goethe.zz>
- $$ref =~ /\A(?:(\r?\n))/gs or goto &new;
- my $hdr = substr($$ref, 0, pos($$ref), ''); # sv_chop on $$ref
+ $$ref =~ /\A(\r?\n)/s or goto &new;
+ my $hdr = substr($$ref, 0, $+[0], ''); # sv_chop on $$ref
bless { hdr => \$hdr, crlf => $1, bdy => $ref }, __PACKAGE__;
}
# pick the first Content-Type header to match Email::MIME behavior.
# It's usually the right one based on historical archives.
sub ct ($) {
- # Email::MIME::ContentType::content_type:
+ # PublicInbox::EmlContentFoo::content_type:
$_[0]->{ct} //= parse_content_type(header($_[0], 'Content-Type'));
}
-sub body_decode ($$) {
- my $cte = header_raw($_[0], 'Content-Transfer-Encoding');
- ($cte) = ($cte =~ /([a-zA-Z0-9\-]+)/) if $cte; # For S/MIME, etc
- (!$cte || $cte =~ $NO_ENCODE_RE) ?
- $_[1] : Email::MIME::Encodings::decode($cte, $_[1], '7bit');
-}
-
# returns a queue of sub-parts iff it's worth descending into
# TODO: descend into message/rfc822 parts (Email::MIME didn't)
sub mp_descend ($$) {
# Cut at the the first epilogue, not subsequent ones.
# *sigh* just the regexp match alone seems to bump RSS by
# length($$bdy) on a ~30M string:
- $$bdy =~ /((?:\r?\n)?^--$bnd--[ \t]*\r?$)/gsm and
- substr($$bdy, pos($$bdy) - length($1)) = '';
+ my $epilogue_missing;
+ if ($$bdy =~ /(?:\r?\n)?^--$bnd--[ \t]*\r?$/sm) {
+ substr($$bdy, $-[0]) = '';
+ } else {
+ $epilogue_missing = 1;
+ }
# *Sigh* split() doesn't work in-place and return CoW strings
# because Perl wants to "\0"-terminate strings. So split()
if (@parts) { # the usual path if we got this far:
undef $bdy; # release memory ASAP if $nr > 0
+
+ # compatibility with Email::MIME
+ $parts[-1] =~ s/\n\r?\n\z/\n/s if $epilogue_missing;
+
@parts = grep /[^ \t\r\n]/s, @parts; # ignore empty parts
# Keep "From: someone..." from preamble in old,
}
}
+sub enc_qp {
+ # prevent MIME::QuotedPrint from encoding CR as =0D since it's
+ # against RFCs and breaks MUAs
+ $_[0] =~ s/\r\n/\n/sg;
+ encode_qp($_[0], "\r\n");
+}
+
+sub dec_qp {
+ # RFC 2822 requires all lines to end in CRLF, though... :<
+ $_[0] = decode_qp($_[0]);
+ $_[0] =~ s/\n/\r\n/sg;
+ $_[0]
+}
+
+sub identity_codec { $_[0] }
+
########### compatibility section for existing Email::MIME uses #########
sub header_obj {
sub body_set {
my ($self, $body) = @_;
my $bdy = $self->{bdy} = ref($body) ? $body : \$body;
- my $cte = header_raw($self, 'Content-Transfer-Encoding');
- if ($cte && $cte !~ $NO_ENCODE_RE) {
- $$bdy = Email::MIME::Encodings::encode($cte, $$bdy)
+ if (my $cte = header_raw($self, 'Content-Transfer-Encoding')) {
+ my $enc = $MIME_ENC{lc($cte)} or croak("can't encode `$cte'");
+ $$bdy = $enc->($$bdy); # in-place
}
undef;
}
sub body_raw { ${$_[0]->{bdy} // \''}; }
-sub body { body_decode($_[0], body_raw($_[0])) }
+sub body {
+ my $raw = body_raw($_[0]);
+ my $cte = header_raw($_[0], 'Content-Transfer-Encoding') or return $raw;
+ ($cte) = ($cte =~ /([a-zA-Z0-9\-]+)/) or return $raw; # For S/MIME, etc
+ my $dec = $MIME_DEC{lc($cte)} or return $raw;
+ $dec->($raw);
+}
sub body_str {
my ($self) = @_;