diff options
| -rw-r--r-- | lib/PublicInbox/ContentId.pm | 67 | ||||
| -rw-r--r-- | lib/PublicInbox/V2Writable.pm | 35 | ||||
| -rw-r--r-- | t/content_id.t | 10 |
3 files changed, 94 insertions, 18 deletions
diff --git a/lib/PublicInbox/ContentId.pm b/lib/PublicInbox/ContentId.pm index 279eec0c..b1d27eb8 100644 --- a/lib/PublicInbox/ContentId.pm +++ b/lib/PublicInbox/ContentId.pm @@ -7,10 +7,19 @@ use warnings; use base qw/Exporter/; our @EXPORT_OK = qw/content_id content_digest/; use PublicInbox::MID qw(mids references); +use PublicInbox::MsgIter; # not sure if less-widely supported hash families are worth bothering with use Digest::SHA; +sub digest_addr ($$$) { + my ($dig, $h, $v) = @_; + $v =~ tr/"//d; + $v =~ s/@([a-z0-9\_\.\-\(\)]*([A-Z])\S*)/'@'.lc($1)/ge; + utf8::encode($v); + $dig->add("$h\0$v\0"); +} + sub content_digest ($) { my ($mime) = @_; my $dig = Digest::SHA->new(256); @@ -27,24 +36,62 @@ sub content_digest ($) { } foreach my $mid (@{references($hdr)}) { next if $seen{$mid}; - $dig->add('ref: '.$mid); + $dig->add("ref\0$mid\0"); } # Only use Sender: if From is not present foreach my $h (qw(From Sender)) { - my @v = $hdr->header_raw($h); + my @v = $hdr->header($h); if (@v) { - $dig->add("$h: $_") foreach @v; - last; + digest_addr($dig, $h, $_) foreach @v; } } - - # Content-* headers are often no-ops, so maybe we don't need them - foreach my $h (qw(Subject Date To Cc)) { - my @v = $hdr->header_raw($h); - $dig->add("$h: $_") foreach @v; + foreach my $h (qw(Subject Date)) { + my @v = $hdr->header($h); + foreach my $v (@v) { + utf8::encode($v); + $dig->add("$h\0$v\0"); + } + } + # Some mail processors will add " to unquoted names that were + # not in the original message. For the purposes of deduplication, + # do not take it into account: + foreach my $h (qw(To Cc)) { + my @v = $hdr->header($h); + digest_addr($dig, $h, $_) foreach @v; } - $dig->add($mime->body_raw); + msg_iter($mime, sub { + my ($part, $depth, @idx) = @{$_[0]}; + $dig->add("\0$depth:".join('.', @idx)."\0"); + my $fn = $part->filename; + if (defined $fn) { + utf8::encode($fn); + $dig->add("fn\0$fn\0"); + } + my @d = $part->header('Content-Description'); + foreach my $d (@d) { + utf8::encode($d); + $dig->add("d\0$d\0"); + } + $dig->add("b\0"); + my $ct = $part->content_type || 'text/plain'; + my $s = eval { $part->body_str }; + if ($@ && $ct =~ m!\btext/plain\b!i) { + # Try to assume UTF-8 because Alpine + # seems to do wacky things and set + # charset=X-UNKNOWN + $part->charset_set('UTF-8'); + $s = eval { $part->body_str }; + } + if (defined $s) { + $s =~ s/\r\n/\n/gs; + $s =~ s/\s*\z//s; + utf8::encode($s); + } else { + $s = $part->body; + } + $dig->add($s); + }); $dig; } diff --git a/lib/PublicInbox/V2Writable.pm b/lib/PublicInbox/V2Writable.pm index 0dcdedae..e9fd502e 100644 --- a/lib/PublicInbox/V2Writable.pm +++ b/lib/PublicInbox/V2Writable.pm @@ -259,12 +259,32 @@ sub purge_oids { $purges; } +sub content_ids ($) { + my ($mime) = @_; + my @cids = ( content_id($mime) ); + + # Email::MIME->as_string doesn't always round-trip, so we may + # use a second content_id + my $rt = content_id(PublicInbox::MIME->new(\($mime->as_string))); + push @cids, $rt if $cids[0] ne $rt; + \@cids; +} + +sub content_matches ($$) { + my ($cids, $existing) = @_; + my $cid = content_id($existing); + foreach (@$cids) { + return 1 if $_ eq $cid + } + 0 +} + sub remove_internal { my ($self, $mime, $cmt_msg, $purge) = @_; $self->idx_init; my $im = $self->importer unless $purge; my $over = $self->{over}; - my $cid = content_id($mime); + my $cids = content_ids($mime); my $parts = $self->{idx_parts}; my $mm = $self->{mm}; my $removed; @@ -287,7 +307,7 @@ sub remove_internal { } my $orig = $$msg; my $cur = PublicInbox::MIME->new($msg); - if (content_id($cur) eq $cid) { + if (content_matches($cids, $cur)) { $smsg->{mime} = $cur; $gone{$smsg->{num}} = [ $smsg, \$orig ]; } @@ -572,8 +592,7 @@ sub get_blob ($$) { sub lookup_content { my ($self, $mime, $mid) = @_; my $over = $self->{over}; - my $cid = content_id($mime); - my $found; + my $cids = content_ids($mime); my ($id, $prev); while (my $smsg = $over->next_by_mid($mid, \$id, \$prev)) { my $msg = get_blob($self, $smsg); @@ -582,16 +601,16 @@ sub lookup_content { next; } my $cur = PublicInbox::MIME->new($msg); - if (content_id($cur) eq $cid) { + if (content_matches($cids, $cur)) { $smsg->{mime} = $cur; - $found = $smsg; - last; + return $smsg; } + # XXX DEBUG_DIFF is experimental and may be removed diff($mid, $cur, $mime) if $ENV{DEBUG_DIFF}; } - $found; + undef; } sub atfork_child { diff --git a/t/content_id.t b/t/content_id.t index adcdb6c1..01ce65e5 100644 --- a/t/content_id.t +++ b/t/content_id.t @@ -22,4 +22,14 @@ my $orig = content_id($mime); my $reload = content_id(Email::MIME->new($mime->as_string)); is($orig, $reload, 'content_id matches after serialization'); +foreach my $h (qw(From To Cc)) { + my $n = '"Quoted N\'Ame" <foo@EXAMPLE.com>'; + $mime->header_str_set($h, "$n"); + my $q = content_id($mime); + is($n, $mime->header($h), "content_id does not mutate $h:"); + $mime->header_str_set($h, 'Quoted N\'Ame <foo@example.com>'); + my $nq = content_id($mime); + is($nq, $q, "quotes ignored in $h:"); +} + done_testing(); |