]> Sergey Matveev's repositories - public-inbox.git/commitdiff
mboxreader: new class for reading various mbox formats
authorEric Wong <e@80x24.org>
Thu, 31 Dec 2020 13:51:26 +0000 (13:51 +0000)
committerEric Wong <e@80x24.org>
Fri, 1 Jan 2021 05:00:38 +0000 (05:00 +0000)
This is only lightly-tested against stuff LeiToMail generates
and will need real-world tests to validate.

MANIFEST
lib/PublicInbox/MboxReader.pm [new file with mode: 0644]
t/mbox_reader.t [new file with mode: 0644]

index d32f064e928de2f2dbf0534751183a67f720116c..1fb1e18152563fb2e6443d4afd00f0f69c14b642 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -176,6 +176,7 @@ lib/PublicInbox/MIME.pm
 lib/PublicInbox/ManifestJsGz.pm
 lib/PublicInbox/Mbox.pm
 lib/PublicInbox/MboxGz.pm
+lib/PublicInbox/MboxReader.pm
 lib/PublicInbox/MiscIdx.pm
 lib/PublicInbox/MiscSearch.pm
 lib/PublicInbox/MsgIter.pm
@@ -334,6 +335,7 @@ t/lei_to_mail.t
 t/lei_xsearch.t
 t/linkify.t
 t/main-bin/spamc
+t/mbox_reader.t
 t/mda-mime.eml
 t/mda.t
 t/mda_filter_rubylang.t
diff --git a/lib/PublicInbox/MboxReader.pm b/lib/PublicInbox/MboxReader.pm
new file mode 100644 (file)
index 0000000..e1944aa
--- /dev/null
@@ -0,0 +1,124 @@
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# reader for mbox variants we support
+package PublicInbox::MboxReader;
+use strict;
+use v5.10.1;
+use Data::Dumper;
+$Data::Dumper::Useqq = 1; # should've been the default, for bad data
+
+my $from_strict =
+       qr/^From \S+ +\S+ \S+ +\S+ [^\n:]+:[^\n:]+:[^\n:]+ [^\n:]+\n/sm;
+
+sub _mbox_from {
+       my ($mbfh, $from_re, $eml_cb, @arg) = @_;
+       my $buf = '';
+       my @raw;
+       while (defined(my $r = read($mbfh, $buf, 65536, length($buf)))) {
+               if ($r == 0) { # close here to check for "curl --fail"
+                       close($mbfh) or die "error closing mbox: \$?=$? $!";
+                       @raw = ($buf);
+               } else {
+                       @raw = split(/$from_strict/mos, $buf, -1);
+                       next if scalar(@raw) == 0;
+                       $buf = pop(@raw); # last bit may be incomplete
+               }
+               @raw = grep /[^ \t\r\n]/s, @raw; # skip empty messages
+               while (defined(my $raw = shift @raw)) {
+                       $raw =~ s/\r?\n\z//s;
+                       $raw =~ s/$from_re/$1/gms;
+                       my $eml = PublicInbox::Eml->new(\$raw);
+                       $eml_cb->($eml, @arg);
+               }
+               return if $r == 0; # EOF
+       }
+       die "error reading mboxo/mboxrd handle: $!";
+}
+
+sub mboxrd {
+       my (undef, $mbfh, $eml_cb, @arg) = @_;
+       _mbox_from($mbfh, qr/^>(>*From )/ms, $eml_cb, @arg);
+}
+
+sub mboxo {
+       my (undef, $mbfh, $eml_cb, @arg) = @_;
+       _mbox_from($mbfh, qr/^>(From )/ms, $eml_cb, @arg);
+}
+
+sub _cl_body {
+       my ($mbfh, $bref, $cl) = @_;
+       my $body = substr($$bref, 0, $cl, '');
+       my $need = $cl - length($body);
+       if ($need > 0) {
+               $mbfh or die "E: needed $need bytes after EOF";
+               defined(my $r = read($mbfh, $body, $need, length($body))) or
+                       die "E: read error: $!\n";
+               $r == $need or die "E: read $r of $need bytes\n";
+       }
+       \$body;
+}
+
+sub _extract_hdr {
+       my ($ref) = @_;
+       if (index($$ref, "\r\n") < 0 && (my $pos = index($$ref, "\n\n")) >= 0) {
+               # likely on *nix
+               \substr($$ref, 0, $pos + 2, ''); # sv_chop on $$ref
+       } elsif ($$ref =~ /\r?\n\r?\n/s) {
+               \substr($$ref, 0, $+[0], ''); # sv_chop on $$ref
+       } else {
+               undef
+       }
+}
+
+sub _mbox_cl ($$$;@) {
+       my ($mbfh, $uxs_from, $eml_cb, @arg) = @_;
+       my $buf = '';
+       while (defined(my $r = read($mbfh, $buf, 65536, length($buf)))) {
+               if ($r == 0) { # detect "curl --fail"
+                       close($mbfh) or
+                               die "error closing mboxcl/mboxcl2: \$?=$? $!";
+                       undef $mbfh;
+               }
+               while (my $hdr = _extract_hdr(\$buf)) {
+                       $$hdr =~ s/\A[\r\n]*From [^\n]*\n//s or
+                               die "E: no 'From ' line in:\n", Dumper($hdr);
+                       my $eml = PublicInbox::Eml->new($hdr);
+                       my @cl = $eml->header_raw('Content-Length');
+                       my $n = scalar(@cl);
+                       $n == 0 and die "E: Content-Length missing in:\n",
+                                       Dumper($eml->as_string);
+                       $n == 1 or die "E: multiple ($n) Content-Length in:\n",
+                                       Dumper($eml->as_string);
+                       $cl[0] =~ /\A[0-9]+\z/ or die
+                               "E: Content-Length `$cl[0]' invalid\n",
+                                       Dumper($eml->as_string);
+                       if (($eml->{bdy} = _cl_body($mbfh, \$buf, $cl[0]))) {
+                               $uxs_from and
+                                       ${$eml->{bdy}} =~ s/^>From /From /sgm;
+                       }
+                       $eml_cb->($eml, @arg);
+               }
+               if ($r == 0) {
+                       $buf =~ /[^ \r\n\t]/ and
+                               warn "W: leftover at end of mboxcl/mboxcl2:\n",
+                                       Dumper(\$buf);
+                       return;
+               }
+       }
+       die "error reading mboxcl/mboxcl2 handle: $!";
+}
+
+sub mboxcl {
+       my (undef, $mbfh, $eml_cb, @arg) = @_;
+       _mbox_cl($mbfh, 1, $eml_cb, @arg);
+}
+
+sub mboxcl2 {
+       my (undef, $mbfh, $eml_cb, @arg) = @_;
+       _mbox_cl($mbfh, undef, $eml_cb, @arg);
+}
+
+sub new { bless \(my $x), __PACKAGE__ }
+
+1;
diff --git a/t/mbox_reader.t b/t/mbox_reader.t
new file mode 100644 (file)
index 0000000..9391dc2
--- /dev/null
@@ -0,0 +1,76 @@
+#!perl -w
+# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use strict;
+use v5.10.1;
+use Test::More;
+use PublicInbox::TestCommon;
+use List::Util qw(shuffle);
+use PublicInbox::Eml;
+use Fcntl qw(SEEK_SET);
+require_ok 'PublicInbox::MboxReader';
+require_ok 'PublicInbox::LeiToMail';
+my %raw = (
+       hdr_only => "From: header-only\@example.com\n\n",
+       small_from => "From: small-from\@example.com\n\nFrom hell\n",
+       small => "From: small\@example.com\n\nfrom hell\n",
+       big_hdr_only => "From: big-header\@example.com\n" .
+               (('A: '.('a' x 72)."\n") x 1000)."\n",
+       big_body => "From: big-body\@example.com\n\n".
+               (('b: '.('b' x 72)."\n") x 1000) .
+               "From hell\n",
+       big_all => "From: big-all\@example.com\n".
+               (("A: ".('a' x 72)."\n") x 1000). "\n" .
+               (("b: ".('b' x 72)."\n") x 1000) .
+               "From hell\n",
+);
+
+if ($ENV{TEST_EXTRA}) {
+       for my $fn (glob('t/*.eml'), glob('t/*/*.{patch,eml}')) {
+               $raw{$fn} = eml_load($fn)->as_string;
+       }
+}
+
+my $reader = PublicInbox::MboxReader->new;
+my $write_in_full = PublicInbox::LeiToMail->can('write_in_full');
+my $check_fmt = sub {
+       my $fmt = shift;
+       my @order = shuffle(keys %raw);
+       my $eml2mbox = PublicInbox::LeiToMail->can("eml2$fmt");
+       open my $fh, '+>', undef or BAIL_OUT "open: $!";
+       for my $k (@order) {
+               my $eml = PublicInbox::Eml->new($raw{$k});
+               my $buf = $eml2mbox->($eml);
+               $write_in_full->($fh, $buf, undef);
+       }
+       seek($fh, 0, SEEK_SET) or BAIL_OUT "seek: $!";
+       $reader->$fmt($fh, sub {
+               my ($eml) = @_;
+               my $cur = shift @order;
+               my @cl = $eml->header_raw('Content-Length');
+               if ($fmt =~ /\Amboxcl/) {
+                       is(scalar(@cl), 1, "Content-Length set $fmt $cur");
+                       my $raw = $eml->body_raw;
+                       my $adj = 0;
+                       if ($fmt eq 'mboxcl') {
+                               my @from = ($raw =~ /^(From )/smg);
+                               $adj = scalar(@from);
+                       }
+                       is(length($raw), $cl[0] - $adj,
+                               "Content-Length is correct $fmt $cur");
+                       # clobber for ->as_string comparison below
+                       $eml->header_set('Content-Length');
+               } else {
+                       is(scalar(@cl), 0, "Content-Length unset $fmt $cur");
+               }
+               my $orig = PublicInbox::Eml->new($raw{$cur});
+               is($eml->as_string, $orig->as_string,
+                       "read back original $fmt $cur");
+       });
+};
+my @mbox = qw(mboxrd mboxo mboxcl mboxcl2);
+for my $fmt (@mbox) { $check_fmt->($fmt) }
+s/\n/\r\n/sg for (values %raw);
+for my $fmt (@mbox) { $check_fmt->($fmt) }
+
+done_testing;