lib/PublicInbox/MboxReader.pm

   1 # Copyright (C) 2020 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # reader for mbox variants we support
   5 package PublicInbox::MboxReader;
   6 use strict;
   7 use v5.10.1;
   8 use PublicInbox::DS (); # localize $in_loop for error detection :<
   9 use Data::Dumper;
  10 $Data::Dumper::Useqq = 1; # should've been the default, for bad data
  11
  12 my $from_strict =
  13         qr/^From \S+ +\S+ \S+ +\S+ [^\n:]+:[^\n:]+:[^\n:]+ [^\n:]+\n/sm;
  14
  15 sub _mbox_from {
  16         my ($mbfh, $from_re, $eml_cb, @arg) = @_;
  17         local $PublicInbox::DS::in_loop; # disable dwaitpid
  18         my $buf = '';
  19         my @raw;
  20         while (defined(my $r = read($mbfh, $buf, 65536, length($buf)))) {
  21                 if ($r == 0) { # close here to check for "curl --fail"
  22                         close($mbfh) or die "error closing mbox: \$?=$? $!";
  23                         @raw = ($buf);
  24                 } else {
  25                         @raw = split(/$from_strict/mos, $buf, -1);
  26                         next if scalar(@raw) == 0;
  27                         $buf = pop(@raw); # last bit may be incomplete
  28                 }
  29                 @raw = grep /[^ \t\r\n]/s, @raw; # skip empty messages
  30                 while (defined(my $raw = shift @raw)) {
  31                         $raw =~ s/\r?\n\z//s;
  32                         $raw =~ s/$from_re/$1/gms;
  33                         my $eml = PublicInbox::Eml->new(\$raw);
  34                         $eml_cb->($eml, @arg);
  35                 }
  36                 return if $r == 0; # EOF
  37         }
  38         die "error reading mboxo/mboxrd handle: $!";
  39 }
  40
  41 sub mboxrd {
  42         my (undef, $mbfh, $eml_cb, @arg) = @_;
  43         _mbox_from($mbfh, qr/^>(>*From )/ms, $eml_cb, @arg);
  44 }
  45
  46 sub mboxo {
  47         my (undef, $mbfh, $eml_cb, @arg) = @_;
  48         _mbox_from($mbfh, qr/^>(From )/ms, $eml_cb, @arg);
  49 }
  50
  51 sub _cl_body {
  52         my ($mbfh, $bref, $cl) = @_;
  53         my $body = substr($$bref, 0, $cl, '');
  54         my $need = $cl - length($body);
  55         if ($need > 0) {
  56                 $mbfh or die "E: needed $need bytes after EOF";
  57                 defined(my $r = read($mbfh, $body, $need, length($body))) or
  58                         die "E: read error: $!\n";
  59                 $r == $need or die "E: read $r of $need bytes\n";
  60         }
  61         \$body;
  62 }
  63
  64 sub _extract_hdr {
  65         my ($ref) = @_;
  66         if (index($$ref, "\r\n") < 0 && (my $pos = index($$ref, "\n\n")) >= 0) {
  67                 # likely on *nix
  68                 \substr($$ref, 0, $pos + 2, ''); # sv_chop on $$ref
  69         } elsif ($$ref =~ /\r?\n\r?\n/s) {
  70                 \substr($$ref, 0, $+[0], ''); # sv_chop on $$ref
  71         } else {
  72                 undef
  73         }
  74 }
  75
  76 sub _mbox_cl ($$$;@) {
  77         my ($mbfh, $uxs_from, $eml_cb, @arg) = @_;
  78         local $PublicInbox::DS::in_loop; # disable dwaitpid
  79         my $buf = '';
  80         while (defined(my $r = read($mbfh, $buf, 65536, length($buf)))) {
  81                 if ($r == 0) { # detect "curl --fail"
  82                         close($mbfh) or
  83                                 die "error closing mboxcl/mboxcl2: \$?=$? $!";
  84                         undef $mbfh;
  85                 }
  86                 while (my $hdr = _extract_hdr(\$buf)) {
  87                         $$hdr =~ s/\A[\r\n]*From [^\n]*\n//s or
  88                                 die "E: no 'From ' line in:\n", Dumper($hdr);
  89                         my $eml = PublicInbox::Eml->new($hdr);
  90                         my @cl = $eml->header_raw('Content-Length');
  91                         my $n = scalar(@cl);
  92                         $n == 0 and die "E: Content-Length missing in:\n",
  93                                         Dumper($eml->as_string);
  94                         $n == 1 or die "E: multiple ($n) Content-Length in:\n",
  95                                         Dumper($eml->as_string);
  96                         $cl[0] =~ /\A[0-9]+\z/ or die
  97                                 "E: Content-Length `$cl[0]' invalid\n",
  98                                         Dumper($eml->as_string);
  99                         if (($eml->{bdy} = _cl_body($mbfh, \$buf, $cl[0]))) {
 100                                 $uxs_from and
 101                                         ${$eml->{bdy}} =~ s/^>From /From /sgm;
 102                         }
 103                         $eml_cb->($eml, @arg);
 104                 }
 105                 if ($r == 0) {
 106                         $buf =~ /[^ \r\n\t]/ and
 107                                 warn "W: leftover at end of mboxcl/mboxcl2:\n",
 108                                         Dumper(\$buf);
 109                         return;
 110                 }
 111         }
 112         die "error reading mboxcl/mboxcl2 handle: $!";
 113 }
 114
 115 sub mboxcl {
 116         my (undef, $mbfh, $eml_cb, @arg) = @_;
 117         _mbox_cl($mbfh, 1, $eml_cb, @arg);
 118 }
 119
 120 sub mboxcl2 {
 121         my (undef, $mbfh, $eml_cb, @arg) = @_;
 122         _mbox_cl($mbfh, undef, $eml_cb, @arg);
 123 }
 124
 125 sub new { bless \(my $x), __PACKAGE__ }
 126
 127 1;