From 34a3b85f4c40d3bd9a50bfab2ac77536cae4fd37 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Mon, 12 Jan 2015 01:16:04 +0000
Subject: 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.
---
 scripts/import_slrnspool | 46 ++++++++++++++++++++++++++++++----------------
 1 file changed, 30 insertions(+), 16 deletions(-)

(limited to 'scripts/import_slrnspool')

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);
 }
-- 
cgit v1.2.3-24-ge0c7