import_slrnspool: fork a process for each message

This prevents process growth when importing large messages.
Memory growth could be due to the sliding sbrk window in glibc malloc
or a circular reference in the Email::* Perl code somewhere.

diff --git a/scripts/import_slrnspool b/scripts/import_slrnspool
index e55c96c7dcde95b376db44f5934bf96fe4d22286..dd612b1f807a92c9c4786e9f70c023d8d39be426 100755 (executable)
--- 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);
 }