scripts/import_slrnspool

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 2015 all contributors <meta@public-inbox.org>
   3 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   4 #
   5 # Incremental (or one-shot) importer of a slrnpull news spool
   6 =begin usage
   7         export ORIGINAL_RECIPIENT=address@example.com
   8         public-inbox-init $LISTNAME $GIT_DIR $HTTP_URL $ORIGINAL_RECIPIENT
   9         ./import_slrnspool SLRNPULL_ROOT/news/foo/bar
  10 =cut
  11 use strict;
  12 use warnings;
  13 use PublicInbox::Config;
  14 use Email::Filter;
  15 use Email::LocalDelivery;
  16 sub usage { "Usage:\n".join('',grep(/\t/, `head -n 10 $0`)) }
  17 my $exit = 0;
  18 my $sighandler = sub { $exit = 1 };
  19 $SIG{INT} = $sighandler;
  20 $SIG{TERM} = $sighandler;
  21 my $spool = shift @ARGV or die usage();
  22 my $recipient = $ENV{ORIGINAL_RECIPIENT};
  23 defined $recipient or die usage();
  24 my $config = PublicInbox::Config->new;
  25 my $cfg = $config->lookup($recipient);
  26 defined $cfg or exit(1);
  27 my @mda;
  28 if ($ENV{'FILTER'}) {
  29         @mda = qw(public-inbox-mda);
  30 } else {
  31         @mda = (qw(ssoma-mda -1), $cfg->{mainrepo});
  32 }
  33
  34 sub key {
  35         my ($cfg) = @_;
  36         "publicinbox.$cfg->{listname}.importslrnspoolstate";
  37 }
  38
  39 sub get_min {
  40         my $f = PublicInbox::Config->default_file;
  41         my @cmd = (qw/git config/, "--file=$f", key($cfg));
  42         use IPC::Run qw/run/;
  43
  44         my $in = '';
  45         my $out = '';
  46         unless (run(\@cmd, \$in, \$out)) {
  47                 $out = 0;
  48         }
  49         int($out);
  50 }
  51
  52 sub set_min {
  53         my ($cfg, $num) = @_;
  54         my $f = PublicInbox::Config->default_file;
  55         my @cmd = (qw/git config/, "--file=$f", key($cfg), $num);
  56         system(@cmd) == 0 or die join(' ', @cmd). " failed: $?\n";
  57 }
  58
  59 my $n = get_min();
  60 my $ok;
  61 my $max_gap = 10000;
  62 my $max = $n + $max_gap;
  63
  64 for (; $exit == 0 && $n < $max; $n++) {
  65         my $fn = "$spool/$n";
  66         print STDERR $fn, "\n";
  67         open(my $fh, '<', $fn) or next;
  68         $max = $n + $max_gap;
  69
  70         # prevent process growth by forking a new process for each message
  71         my $pid = fork;
  72         die "failed to fork: $!\n" unless defined $pid;
  73
  74         if ($pid == 0) {
  75                 my $f = Email::Filter->new(data => eval { local $/; <$fh> });
  76                 close $fh;
  77                 $fh = undef;
  78                 my $s = $f->simple;
  79
  80                 # gmane rewrites Received headers, which increases spamminess
  81                 # Some older archives set Original-To
  82                 foreach my $x (qw(Received To)) {
  83                         my @h = $s->header("Original-$x");
  84                         if (@h) {
  85                                 $s->header_set($x, @h);
  86                                 $s->header_set("Original-$x");
  87                         }
  88                 }
  89
  90                 # triggers for the SA HEADER_SPAM rule
  91                 foreach my $drop (qw(Approved)) { $s->header_set($drop) }
  92
  93                 # appears to be an old gmane bug:
  94                 $s->header_set('connect()');
  95
  96                 $f->exit(0);
  97                 $f->pipe(@mda);
  98                 exit 0;
  99         } else {
 100                 close $fh;
 101                 waitpid($pid, 0);
 102                 die "error: $?\n" if $?;
 103         }
 104         $ok = $n + 1;
 105         set_min($cfg, $ok);
 106 }