]> Sergey Matveev's repositories - public-inbox.git/blobdiff - scripts/import_slrnspool
update copyright headers and email addresses
[public-inbox.git] / scripts / import_slrnspool
index d95836d69c6a8937a9a97bd20d645a05c0c6650f..f8271f586f010e41b3dee7247876f72428c3eb77 100755 (executable)
@@ -1,5 +1,5 @@
 #!/usr/bin/perl -w
-# Copyright (C) 2015, all contributors <meta@public-inbox.org>
+# Copyright (C) 2015 all contributors <meta@public-inbox.org>
 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
 #
 # Incremental (or one-shot) importer of a slrnpull news spool
@@ -31,16 +31,28 @@ if ($ENV{'FILTER'}) {
        @mda = (qw(ssoma-mda -1), $cfg->{mainrepo});
 }
 
-sub get_min {
+sub key {
        my ($cfg) = @_;
-       $cfg->{importslrnspoolstate} || 0;
+       "publicinbox.$cfg->{listname}.importslrnspoolstate";
+}
+
+sub get_min {
+       my $f = PublicInbox::Config->default_file;
+       my @cmd = (qw/git config/, "--file=$f", key($cfg));
+       use IPC::Run qw/run/;
+
+       my $in = '';
+       my $out = '';
+       unless (run(\@cmd, \$in, \$out)) {
+               $out = 0;
+       }
+       int($out);
 }
 
 sub set_min {
        my ($cfg, $num) = @_;
        my $f = PublicInbox::Config->default_file;
-       my @cmd = (qw/git config/, "--file=$f",
-                  "publicinbox.$cfg->{listname}.importslrnspoolstate", $num);
+       my @cmd = (qw/git config/, "--file=$f", key($cfg), $num);
        system(@cmd) == 0 or die join(' ', @cmd). " failed: $?\n";
 }
 
@@ -54,27 +66,41 @@ for (; $exit == 0 && $n < $max; $n++) {
        print STDERR $fn, "\n";
        open(my $fh, '<', $fn) or next;
        $max = $n + $max_gap;
-       my $f = Email::Filter->new(data => eval { local $/; <$fh> });
-       my $s = $f->simple;
 
-       # gmane rewrites Received headers, which increases spamminess
-       # Some older archives set Original-To
-       foreach my $x (qw(Received To)) {
-               my @h = $s->header("Original-$x");
-               if (@h) {
-                       $s->header_set($x, @h);
-                       $s->header_set("Original-$x");
+       # prevent process growth by forking a new process for each message
+       my $pid = fork;
+       die "failed to fork: $!\n" unless defined $pid;
+
+       if ($pid == 0) {
+               my $f = Email::Filter->new(data => eval { local $/; <$fh> });
+               close $fh;
+               $fh = undef;
+               my $s = $f->simple;
+
+               # gmane rewrites Received headers, which increases spamminess
+               # Some older archives set Original-To
+               foreach my $x (qw(Received To)) {
+                       my @h = $s->header("Original-$x");
+                       if (@h) {
+                               $s->header_set($x, @h);
+                               $s->header_set("Original-$x");
+                       }
                }
-       }
 
-       # triggers for the SA HEADER_SPAM rule
-       foreach my $drop (qw(Approved)) { $s->header_set($drop) }
+               # triggers for the SA HEADER_SPAM rule
+               foreach my $drop (qw(Approved)) { $s->header_set($drop) }
 
-       # appears to be an old gmane bug:
-       $s->header_set('connect()');
+               # appears to be an old gmane bug:
+               $s->header_set('connect()');
 
-       $f->exit(0);
-       $f->pipe(@mda);
+               $f->exit(0);
+               $f->pipe(@mda);
+               exit 0;
+       } else {
+               close $fh;
+               waitpid($pid, 0);
+               die "error: $?\n" if $?;
+       }
        $ok = $n + 1;
        set_min($cfg, $ok);
 }