lib/PublicInbox/InboxWritable.pm

   1 # Copyright (C) 2018 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # Extends read-only Inbox for writing
   5 package PublicInbox::InboxWritable;
   6 use strict;
   7 use warnings;
   8 use base qw(PublicInbox::Inbox);
   9 use PublicInbox::Import;
  10 use PublicInbox::Filter::Base;
  11 *REJECT = *PublicInbox::Filter::Base::REJECT;
  12
  13 sub new {
  14         my ($class, $ibx) = @_;
  15         bless $ibx, $class;
  16 }
  17
  18 sub importer {
  19         my ($self, $parallel) = @_;
  20         $self->{-importer} ||= eval {
  21                 my $v = $self->{version} || 1;
  22                 if ($v == 2) {
  23                         eval { require PublicInbox::V2Writable };
  24                         die "v2 not supported: $@\n" if $@;
  25                         my $v2w = PublicInbox::V2Writable->new($self);
  26                         $v2w->{parallel} = $parallel;
  27                         $v2w;
  28                 } elsif ($v == 1) {
  29                         my $git = $self->git;
  30                         my $name = $self->{name};
  31                         my $addr = $self->{-primary_address};
  32                         PublicInbox::Import->new($git, $name, $addr, $self);
  33                 } else {
  34                         die "unsupported inbox version: $v\n";
  35                 }
  36         }
  37 }
  38
  39 sub filter {
  40         my ($self) = @_;
  41         my $f = $self->{filter};
  42         if ($f && $f =~ /::/) {
  43                 my @args = (-inbox => $self);
  44                 # basic line splitting, only
  45                 # Perhaps we can have proper quote splitting one day...
  46                 ($f, @args) = split(/\s+/, $f) if $f =~ /\s+/;
  47
  48                 eval "require $f";
  49                 if ($@) {
  50                         warn $@;
  51                 } else {
  52                         # e.g: PublicInbox::Filter::Vger->new(@args)
  53                         return $f->new(@args);
  54                 }
  55         }
  56         undef;
  57 }
  58
  59 sub is_maildir_basename ($) {
  60         my ($bn) = @_;
  61         return 0 if $bn !~ /\A[a-zA-Z0-9][\-\w:,=\.]+\z/;
  62         if ($bn =~ /:2,([A-Z]+)\z/i) {
  63                 my $flags = $1;
  64                 return 0 if $flags =~ /[DT]/; # no [D]rafts or [T]rashed mail
  65         }
  66         1;
  67 }
  68
  69 sub is_maildir_path ($) {
  70         my ($path) = @_;
  71         my @p = split(m!/+!, $path);
  72         (is_maildir_basename($p[-1]) && -f $path) ? 1 : 0;
  73 }
  74
  75 sub maildir_path_load ($) {
  76         my ($path) = @_;
  77         if (open my $fh, '<', $path) {
  78                 local $/;
  79                 my $str = <$fh>;
  80                 $str or return;
  81                 return PublicInbox::MIME->new(\$str);
  82         } elsif ($!{ENOENT}) {
  83                 # common with Maildir
  84                 return;
  85         } else {
  86                 warn "failed to open $path: $!\n";
  87                 return;
  88         }
  89 }
  90
  91 sub import_maildir {
  92         my ($self, $dir) = @_;
  93         my $im = $self->importer(1);
  94         my $filter = $self->filter;
  95         foreach my $sub (qw(cur new tmp)) {
  96                 -d "$dir/$sub" or die "$dir is not a Maildir (missing $sub)\n";
  97         }
  98         foreach my $sub (qw(cur new)) {
  99                 opendir my $dh, "$dir/$sub" or die "opendir $dir/$sub: $!\n";
 100                 while (defined(my $fn = readdir($dh))) {
 101                         next unless is_maildir_basename($fn);
 102                         my $mime = maildir_file_load("$dir/$fn") or next;
 103                         if ($filter) {
 104                                 my $ret = $filter->scrub($mime) or return;
 105                                 return if $ret == REJECT();
 106                                 $mime = $ret;
 107                         }
 108                         $im->add($mime);
 109                 }
 110         }
 111         $im->done;
 112 }
 113
 114 # asctime: From example@example.com Fri Jun 23 02:56:55 2000
 115 my $from_strict = qr/^From \S+ +\S+ \S+ +\S+ [^:]+:[^:]+:[^:]+ [^:]+/;
 116
 117 sub mb_add ($$$$) {
 118         my ($im, $variant, $filter, $msg) = @_;
 119         $$msg =~ s/(\r?\n)+\z/$1/s;
 120         my $mime = PublicInbox::MIME->new($msg);
 121         if ($variant eq 'mboxrd') {
 122                 $$msg =~ s/^>(>*From )/$1/sm;
 123         } elsif ($variant eq 'mboxo') {
 124                 $$msg =~ s/^>From /From /sm;
 125         }
 126         if ($filter) {
 127                 my $ret = $filter->scrub($mime) or return;
 128                 return if $ret == REJECT();
 129                 $mime = $ret;
 130         }
 131         $im->add($mime)
 132 }
 133
 134 sub import_mbox {
 135         my ($self, $fh, $variant) = @_;
 136         if ($variant !~ /\A(?:mboxrd|mboxo)\z/) {
 137                 die "variant must be 'mboxrd' or 'mboxo'\n";
 138         }
 139         my $im = $self->importer(1);
 140         my $prev = undef;
 141         my $msg = '';
 142         my $filter = $self->filter;
 143         while (defined(my $l = <$fh>)) {
 144                 if ($l =~ /$from_strict/o) {
 145                         if (!defined($prev) || $prev =~ /^\r?$/) {
 146                                 mb_add($im, $variant, $filter, \$msg) if $msg;
 147                                 $msg = '';
 148                                 $prev = $l;
 149                                 next;
 150                         }
 151                         warn "W[$.] $l\n";
 152                 }
 153                 $prev = $l;
 154                 $msg .= $l;
 155         }
 156         mb_add($im, $variant, $filter, \$msg) if $msg;
 157         $im->done;
 158 }
 159
 160 1;