From d002f24a9648d1499a16ed4dec84f05c0f849740 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Sat, 11 Nov 2023 09:04:57 +0000
Subject: mda|learn|watch: support dropUniqueUnsubscribe config

List-Unsubscribe headers with unique identifiers (such as those
generated by our examples/unsubscribe.milter) should not
end up in public archives.  Add a new config knob to strip
List-Unsubscribe headers if they have the
`List-Unsubscribe-Post: List-Unsubscribe=One-Click'
header.

Unfortunately, this breaks DKIM signatures if the signature
covers either of these List-Unsubscribe* headers.  However,
breaking DKIM is the lesser evil compared to any archive reader
being able to stop archival by an independent archivist.

As much as I would like this to be the default, it probably
affects few users at the moment since very few mailing lists
use unique identifiers in List-Unsubscribe (but that number
has grown, recently).
---
 t/lei-import.t    | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
 t/mda.t           | 41 +++++++++++++++++++++++++++++++++++++----
 t/watch_maildir.t | 30 +++++++++++++++++++++++++++---
 3 files changed, 111 insertions(+), 8 deletions(-)

(limited to 't')

diff --git a/t/lei-import.t b/t/lei-import.t
index 1edd607d..bd562617 100644
--- a/t/lei-import.t
+++ b/t/lei-import.t
@@ -3,7 +3,8 @@
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 use v5.12; use PublicInbox::TestCommon;
 use PublicInbox::DS qw(now);
-use autodie qw(open close);
+use PublicInbox::IO qw(write_file);
+use autodie qw(open close truncate);
 test_lei(sub {
 ok(!lei(qw(import -F bogus), 't/plack-qp.eml'), 'fails with bogus format');
 like($lei_err, qr/\bis `eml', not --in-format/, 'gave error message');
@@ -180,6 +181,51 @@ SKIP: {
 		'EIO noted in stderr');
 }
 
+{
+	local $ENV{PI_CONFIG} = "$ENV{HOME}/pi_config";
+	write_file '>', $ENV{PI_CONFIG}, <<EOM;
+[publicinboxImport]
+	dropUniqueUnsubscribe
+EOM
+	my $in = <<EOM;
+List-Unsubscribe: <https://example.com/some-UUID-here/test>
+List-Unsubscribe-Post: List-Unsubscribe=One-Click
+Message-ID: <unsubscribe-1\@example>
+Subject: unsubscribe-1 example
+From: u\@example.com
+To: 2\@example.com
+Date: Fri, 02 Oct 1993 00:00:00 +0000
+
+EOM
+	lei_ok [qw(import -F eml +L:unsub)], undef, { %$lei_opt, 0 => \$in },
+		'import succeeds w/ List-Unsubscribe';
+	lei_ok qw(q L:unsub -f mboxrd);
+	like $lei_out, qr/some-UUID-here/,
+		'Unsubscribe header preserved despite PI_CONFIG dropping';
+	lei_ok qw(q L:unsub -o), "v2:$ENV{HOME}/v2-1";
+	lei_ok qw(q s:unsubscribe -f mboxrd --only), "$ENV{HOME}/v2-1";
+	unlike $lei_out, qr/some-UUID-here/,
+		'Unsubscribe header dropped w/ dropUniqueUnsubscribe';
+	like $lei_out, qr/Message-ID: <unsubscribe-1\@example>/,
+		'wrote expected message to v2 output';
+
+	# the default for compatibility:
+	truncate $ENV{PI_CONFIG}, 0;
+	lei_ok qw(q L:unsub -o), "v2:$ENV{HOME}/v2-2";
+	lei_ok qw(q s:unsubscribe -f mboxrd --only), "$ENV{HOME}/v2-2";
+	like $lei_out, qr/some-UUID-here/,
+		'Unsubscribe header preserved by default :<';
+
+	# ensure we can fail
+	write_file '>', $ENV{PI_CONFIG}, <<EOM;
+[publicinboxImport]
+	dropUniqueUnsubscribe = bogus
+EOM
+	ok(!lei(qw(q L:unsub -o), "v2:$ENV{HOME}/v2-3"), 'bad config fails');
+	like $lei_err, qr/is not boolean/, 'non-booleaness noted in stderr';
+	ok !-d "$ENV{HOME}/v2-3", 'v2 directory not created';
+}
+
 # see t/lei_to_mail.t for "import -F mbox*"
 });
 done_testing;
diff --git a/t/mda.t b/t/mda.t
index 83b0b33a..5144f3ca 100644
--- a/t/mda.t
+++ b/t/mda.t
@@ -8,6 +8,7 @@ use PublicInbox::Git;
 use PublicInbox::InboxWritable;
 use PublicInbox::TestCommon;
 use PublicInbox::Import;
+use PublicInbox::IO qw(write_file);
 use File::Path qw(remove_tree);
 my ($tmpdir, $for_destroy) = tmpdir();
 my $home = "$tmpdir/pi-home";
@@ -49,13 +50,11 @@ my $fail_bad_header = sub ($$$) {
 	is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox");
 	PublicInbox::Import::init_bare($maindir);
 
-	open my $fh, '>>', $pi_config or die;
-	print $fh <<EOF or die;
+	write_file '>>', $pi_config, <<EOF;
 [publicinbox "test"]
 	address = $addr
 	inboxdir = $maindir
 EOF
-	close $fh or die;
 }
 
 local $ENV{GIT_COMMITTER_NAME} = eval {
@@ -306,10 +305,44 @@ EOF
 	# ensure -learn rm works after inbox address is updated
 	($out, $err) = ('', '');
 	xsys(qw(git config --file), $pi_config, "$cfgpfx.address",
-		'updated-address@example.com');
+		$addr = 'updated-address@example.com');
 	ok(run_script(['-learn', 'rm'], undef, $rdr), 'rm-ed via -learn');
 	$cur = $git->qx(qw(diff HEAD~1..HEAD));
 	like($cur, qr/^-Message-ID: <2lids\@example>/sm, 'changed in git');
+
+	# ensure we can strip List-Unsubscribe
+	$in = <<EOF;
+To: You <you\@example.com>
+List-Id: <$list_id>
+Message-ID: <unsubscribe-1\@example>
+Subject: unsubscribe-1
+From: user <user\@example.com>
+To: $addr
+Date: Fri, 02 Oct 1993 00:00:00 +0000
+List-Unsubscribe: <https://example.com/some-UUID-here/listname>
+List-Unsubscribe-Post: List-Unsubscribe=One-Click
+
+List-Unsubscribe should be stripped
+EOF
+	write_file '>>', $pi_config, <<EOM;
+[publicinboxImport]
+	dropUniqueUnsubscribe
+EOM
+	$out = $err = '';
+	ok(run_script([qw(-mda)], undef, $rdr), 'mda w/ dropUniqueUnsubscribe');
+	$cur = join('', grep(/^\+/, $git->qx(qw(diff HEAD~1..HEAD))));
+	like $cur, qr/Message-ID: <unsubscribe-1/, 'imported new message';
+	unlike $cur, qr/some-UUID-here/, 'List-Unsubscribe gone';
+	unlike $cur, qr/List-Unsubscribe-Post/i, 'List-Unsubscribe-Post gone';
+
+	$in =~ s/unsubscribe-1/unsubscribe-2/g or xbail 'BUG: s// fail';
+	ok(run_script([qw(-learn ham)], undef, $rdr),
+			'learn ham w/ dropUniqueUnsubscribe');
+	$cur = join('', grep(/^\+/, $git->qx(qw(diff HEAD~1..HEAD))));
+	like $cur, qr/Message-ID: <unsubscribe-2/, 'learn ham';
+	unlike $cur, qr/some-UUID-here/, 'List-Unsubscribe gone on learn ham';
+	unlike $cur, qr/List-Unsubscribe-Post/i,
+		'List-Unsubscribe-Post gone on learn ham';
 }
 
 SKIP: {
diff --git a/t/watch_maildir.t b/t/watch_maildir.t
index 29e9bdc5..69a5e1f3 100644
--- a/t/watch_maildir.t
+++ b/t/watch_maildir.t
@@ -6,6 +6,7 @@ use PublicInbox::Eml;
 use Cwd;
 use PublicInbox::TestCommon;
 use PublicInbox::Import;
+use PublicInbox::IO qw(write_file);
 my ($tmpdir, $for_destroy) = tmpdir();
 my $git_dir = "$tmpdir/test.git";
 my $maildir = "$tmpdir/md";
@@ -143,6 +144,10 @@ More majordomo info at  http://vger.kernel.org/majordomo-info.html\n);
 	my $env = { PI_CONFIG => $cfg_path };
 	$git->cleanup;
 
+	write_file '>>', $cfg_path, <<EOM;
+[publicinboxImport]
+	dropUniqueUnsubscribe
+EOM
 	# n.b. --no-scan is only intended for testing atm
 	my $wm = start_script([qw(-watch --no-scan)], $env);
 	no_pollerfd($wm->{pid});
@@ -194,13 +199,32 @@ More majordomo info at  http://vger.kernel.org/majordomo-info.html\n);
 	$em->commit; # wake -watch up
 	diag 'waiting for -watch to import new message';
 	PublicInbox::DS::event_loop();
+
+	my $head = $git->qx(qw(cat-file commit HEAD));
+	my $subj = $eml->header('Subject');
+	like($head, qr/^\Q$subj\E/sm, 'new commit made');
+
+	# try dropUniqueUnsubscribe
+	$delivered = 0;
+	$eml->header_set('Message-ID', '<unsubscribe@example>');
+	$eml->header_set('List-Unsubscribe',
+			'<https://example.com/some-UUID-here/test');
+	$eml->header_set('List-Unsubscribe-Post', 'List-Unsubscribe=One-Click');
+	$em = PublicInbox::Emergency->new($maildir);
+	$em->prepare(\($eml->as_string));
+	$em->commit; # wake -watch up
+	diag 'waiting for -watch to import dropUniqueUnsubscribe message';
+	PublicInbox::DS::event_loop();
+	my $cur = $git->qx(qw(diff HEAD~1..HEAD));
+	like $cur, qr/Message-ID: <unsubscribe\@example>/,
+		'unsubscribe@example imported';
+	unlike $cur, qr/List-Unsubscribe\b/,
+		'List-Unsubscribe-* headers gone w/ dropUniqueUnsubscribe';
+
 	$wm->kill;
 	$wm->join;
 	$ii->close;
 	PublicInbox::DS->Reset;
-	my $head = $git->qx(qw(cat-file commit HEAD));
-	my $subj = $eml->header('Subject');
-	like($head, qr/^\Q$subj\E/sm, 'new commit made');
 }
 
 sub is_maildir {
-- 
cgit v1.2.3-24-ge0c7