[PATCH 0/4] misc import_slrnspool improvements

[PATCH 0/4] misc import_slrnspool improvements

[Eric Wong]

Eric Wong (4):
      import_slrnspool: make filtering optional
      import_slrnspool: graceful exit for interruptibility
      import_slrnspool: load private config key
      import_slrnspool: fork a process for each message

 scripts/import_slrnspool | 79 ++++++++++++++++++++++++++++++++++--------------
 1 file changed, 57 insertions(+), 22 deletions(-)

[PATCH 1/4] import_slrnspool: make filtering optional

[Eric Wong]

---
 scripts/import_slrnspool | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/scripts/import_slrnspool b/scripts/import_slrnspool
index b3a1b1d..1f25eff 100755
--- a/scripts/import_slrnspool
+++ b/scripts/import_slrnspool
@@ -20,7 +20,12 @@ defined $recipient or die usage();
 my $config = PublicInbox::Config->new;
 my $cfg = $config->lookup($recipient);
 defined $cfg or exit(1);
-my @mda = (qw(ssoma-mda -1), $cfg->{mainrepo});
+my @mda;
+if ($ENV{'FILTER'}) {
+	@mda = qw(public-inbox-mda);
+} else {
+	@mda = (qw(ssoma-mda -1), $cfg->{mainrepo});
+}
 
 sub get_min {
 	my ($cfg) = @_;
-- 
EW

[PATCH 2/4] import_slrnspool: graceful exit for interruptibility

[Eric Wong]

This should alleviate fears of interrupting the process.
---
 scripts/import_slrnspool | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/scripts/import_slrnspool b/scripts/import_slrnspool
index 1f25eff..d95836d 100755
--- a/scripts/import_slrnspool
+++ b/scripts/import_slrnspool
@@ -14,6 +14,10 @@ use PublicInbox::Config;
 use Email::Filter;
 use Email::LocalDelivery;
 sub usage { "Usage:\n".join('',grep(/\t/, `head -n 10 $0`)) }
+my $exit = 0;
+my $sighandler = sub { $exit = 1 };
+$SIG{INT} = $sighandler;
+$SIG{TERM} = $sighandler;
 my $spool = shift @ARGV or die usage();
 my $recipient = $ENV{ORIGINAL_RECIPIENT};
 defined $recipient or die usage();
@@ -45,7 +49,7 @@ my $ok;
 my $max_gap = 10000;
 my $max = $n + $max_gap;
 
-for (; $n < $max; $n++) {
+for (; $exit == 0 && $n < $max; $n++) {
 	my $fn = "$spool/$n";
 	print STDERR $fn, "\n";
 	open(my $fh, '<', $fn) or next;
-- 
EW

[PATCH 3/4] import_slrnspool: load private config key

[Eric Wong]

PublicInbox::Config->lookup won't return unknown keys
---
 scripts/import_slrnspool | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/scripts/import_slrnspool b/scripts/import_slrnspool
index d95836d..e55c96c 100755
--- a/scripts/import_slrnspool
+++ b/scripts/import_slrnspool
@@ -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";
 }
 
-- 
EW

[PATCH 4/4] import_slrnspool: fork a process for each message

[Eric Wong]

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(-)

diff --git a/scripts/import_slrnspool b/scripts/import_slrnspool
index e55c96c..dd612b1 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);
 }
-- 
EW