diff options
Diffstat (limited to 'lib/PublicInbox/Eml.pm')
| -rw-r--r-- | lib/PublicInbox/Eml.pm | 100 |
1 files changed, 79 insertions, 21 deletions
diff --git a/lib/PublicInbox/Eml.pm b/lib/PublicInbox/Eml.pm index 571edc5c..d59d7c3f 100644 --- a/lib/PublicInbox/Eml.pm +++ b/lib/PublicInbox/Eml.pm @@ -1,4 +1,4 @@ -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # # Lazy MIME parser, it still slurps the full message but keeps short @@ -28,7 +28,7 @@ package PublicInbox::Eml; use strict; use v5.10.1; use Carp qw(croak); -use Encode qw(find_encoding decode encode); # stdlib +use Encode qw(find_encoding); # 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 @@ -51,7 +51,9 @@ $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 %DECODE_ADDRESS = map { $_ => 1 } qw(From To Cc Sender Reply-To); +my %DECODE_ADDRESS = map { + ($_ => 1, "Resent-$_" => 1) +} qw(From To Cc Sender Reply-To Bcc); my %DECODE_FULL = ( Subject => 1, 'Content-Description' => 1, @@ -120,9 +122,10 @@ sub new { 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__; + } else { # just a body w/o header? + my $hdr = ''; + my $eol = ($$ref =~ /(\r?\n)/) ? $1 : "\n"; + bless { hdr => \$hdr, crlf => $eol, bdy => $ref }, __PACKAGE__; } } @@ -141,6 +144,7 @@ sub header_raw { my $re = re_memo($_[1]); my @v = (${ $_[0]->{hdr} } =~ /$re/g); for (@v) { + utf8::decode($_); # SMTPUTF8 # for compatibility w/ Email::Simple::Header, s/\s+\z//s; s/\A\s+//s; @@ -217,7 +221,7 @@ sub mp_descend ($$) { # There's also a case where quoted text showed up in the # preamble # <20060515162817.65F0F1BBAE@citi.umich.edu> - unshift(@parts, new_sub(undef, \$pre)) if $pre =~ /:/s; + unshift(@parts, new_sub(undef, \$pre)) if index($pre, ':') >= 0; return \@parts; } # "multipart", but no boundary found, treat as single part @@ -234,6 +238,7 @@ sub mp_descend ($$) { # $cb - user-supplied callback sub # $arg - user-supplied arg (think pthread_create) # $once - unref body scalar during iteration +# $all - used by IMAP server, only sub each_part { my ($self, $cb, $arg, $once, $all) = @_; my $p = mp_descend($self, $once // 0) or @@ -329,11 +334,24 @@ sub body_set { undef; } +# workaround https://rt.cpan.org/Public/Bug/Display.html?id=139622 +# Encode 2.87..3.12 leaks on croak, so we defer and croak ourselves +our @enc_warn; +my $enc_warn = sub { push @enc_warn, @_ }; + sub body_str_set { - my ($self, $body_str) = @_; - my $charset = ct($self)->{attributes}->{charset} or - Carp::confess('body_str was given, but no charset is defined'); - body_set($self, \(encode($charset, $body_str, Encode::FB_CROAK))); + my ($self, $str) = @_; + my $cs = ct($self)->{attributes}->{charset} // + croak('body_str was given, but no charset is defined'); + my $enc = find_encoding($cs) // croak "unknown encoding `$cs'"; + my $tmp; + { + local @enc_warn; + local $SIG{__WARN__} = $enc_warn; + $tmp = $enc->encode($str, Encode::FB_WARN); + croak(@enc_warn) if @enc_warn; + }; + body_set($self, \$tmp); } sub content_type { scalar header($_[0], 'Content-Type') } @@ -347,14 +365,15 @@ sub header_set { $pfx .= ': '; my $len = 78 - length($pfx); @vals = map {; + utf8::encode(my $v = $_); # to bytes, support SMTPUTF8 # folding differs from Email::Simple::Header, # we favor tabs for visibility (and space savings :P) if (length($_) >= $len && (/\n[^ \t]/s || !/\n/s)) { local $Text::Wrap::columns = $len; local $Text::Wrap::huge = 'overflow'; - $pfx . wrap('', "\t", $_) . $self->{crlf}; + $pfx . wrap('', "\t", $v) . $self->{crlf}; } else { - $pfx . $_ . $self->{crlf}; + $pfx . $v . $self->{crlf}; } } @vals; $$hdr =~ s!$re!shift(@vals) // ''!ge; # replace current headers, first @@ -378,7 +397,9 @@ sub header_str_set { header_set($self, $name, @vals); } -sub mhdr_decode ($) { eval { $MIME_Header->decode($_[0]) } // $_[0] } +sub mhdr_decode ($) { + eval { $MIME_Header->decode($_[0], Encode::FB_DEFAULT) } // $_[0]; +} sub filename { my $dis = header_raw($_[0], 'Content-Disposition'); @@ -447,15 +468,19 @@ sub body { sub body_str { my ($self) = @_; my $ct = ct($self); - my $charset = $ct->{attributes}->{charset}; - if (!$charset) { - if ($STR_TYPE{$ct->{type}} && $STR_SUBTYPE{$ct->{subtype}}) { + my $cs = $ct->{attributes}->{charset} // do { + ($STR_TYPE{$ct->{type}} && $STR_SUBTYPE{$ct->{subtype}}) and return body($self); - } - Carp::confess("can't get body as a string for ", + croak("can't get body as a string for ", join("\n\t", header_raw($self, 'Content-Type'))); - } - decode($charset, body($self), Encode::FB_CROAK); + }; + my $enc = find_encoding($cs) or croak "unknown encoding `$cs'"; + my $ret = body($self); + local @enc_warn; + local $SIG{__WARN__} = $enc_warn; + $ret = $enc->decode($ret, Encode::FB_WARN); + croak(@enc_warn) if @enc_warn; + $ret; } sub as_string { @@ -475,9 +500,42 @@ sub charset_set { sub crlf { $_[0]->{crlf} // "\n" } +sub raw_size { + my ($self) = @_; + my $len = length(${$self->{hdr}}); + defined($self->{bdy}) and + $len += length(${$self->{bdy}}) + length($self->{crlf}); + $len; +} + +# warnings to ignore when handling spam mailboxes and maybe other places +sub warn_ignore { + my $s = "@_"; + # Email::Address::XS warnings + $s =~ /^Argument contains empty / + || $s =~ /^Element at index [0-9]+.*? contains / + # PublicInbox::MsgTime + || $s =~ /^bogus TZ offset: .+?, ignoring and assuming \+0000/ + || $s =~ /^bad Date: .+? in / + # Encode::Unicode::UTF7 + || $s =~ /^Bad UTF7 data escape at / +} + +# this expects to be RHS in this assignment: "local $SIG{__WARN__} = ..." +sub warn_ignore_cb { + my $cb = $SIG{__WARN__} // \&CORE::warn; + sub { $cb->(@_) unless warn_ignore(@_) } +} + sub willneed { re_memo($_) for @_ } willneed(qw(From To Cc Date Subject Content-Type In-Reply-To References Message-ID X-Alt-Message-ID)); +# This fixes an old bug from import (pre-a0c07cba0e5d8b6a) +# mutt also pipes single RFC822 messages with a "From " line, +# but no Content-Length or "From " escaping. +# "git format-patch" also generates such files by default. +sub strip_from { $_[0] =~ s/\A[\r\n]*From [^\n]*\n//s } + 1; |