about summary refs log tree commit homepage
diff options
context:
space:
mode:
-rwxr-xr-xscripts/import_slrnspool46
1 files changed, 30 insertions, 16 deletions
diff --git a/scripts/import_slrnspool b/scripts/import_slrnspool
index e55c96c7..dd612b1f 100755
--- a/scripts/import_slrnspool
+++ b/scripts/import_slrnspool
@@ -66,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);
 }