X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FEml.pm;h=485f637a3e7b41a9117cb37a9acfd8e7649dadfa;hb=584721cf9c98beabce9b779faafa1eabb5c24de6;hp=f7f62e7b26c36be34b26493acc2afad49d6bb470;hpb=69ea1bcb2983d2c51caf04440d4797212ed6fd64;p=public-inbox.git diff --git a/lib/PublicInbox/Eml.pm b/lib/PublicInbox/Eml.pm index f7f62e7b..485f637a 100644 --- a/lib/PublicInbox/Eml.pm +++ b/lib/PublicInbox/Eml.pm @@ -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__; } } @@ -234,6 +237,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 @@ -330,10 +334,18 @@ sub body_set { } 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; + { + my @w; + local $SIG{__WARN__} = sub { push @w, @_ }; + $tmp = $enc->encode($str, Encode::FB_WARN); + croak(@w) if @w; + }; + body_set($self, \$tmp); } sub content_type { scalar header($_[0], 'Content-Type') } @@ -449,15 +461,20 @@ 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 $tmp = body($self); + # workaround https://rt.cpan.org/Public/Bug/Display.html?id=139622 + my @w; + local $SIG{__WARN__} = sub { push @w, @_ }; + my $ret = $enc->decode($tmp, Encode::FB_WARN); + croak(@w) if @w; + $ret; } sub as_string { @@ -477,12 +494,20 @@ 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 address at / - || $s =~ /^Element at index [0-9]+ contains / + $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 /