X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fpop3d.t;h=7248c03f47c5f28726fa4b8fe88b4226359486ad;hb=6b4e4f0d2d52a4b39c68d8f63915ddb7e1e8270e;hp=3d70935fa69d162db37e5ffef1b0906a839f5454;hpb=b9bc55a39b65d6da9da8bf2ad5daaaa2933ab508;p=public-inbox.git

diff --git a/t/pop3d.t b/t/pop3d.t
index 3d70935f..7248c03f 100644
--- a/t/pop3d.t
+++ b/t/pop3d.t
@@ -5,8 +5,9 @@ use v5.12;
 use PublicInbox::TestCommon;
 use Socket qw(IPPROTO_TCP SOL_SOCKET);
 # Net::POP3 is part of the standard library, but distros may split it off...
-require_mods(qw(DBD::SQLite Net::POP3 IO::Socket::SSL File::FcntlLock));
+require_mods(qw(DBD::SQLite Net::POP3 IO::Socket::SSL));
 require_git('2.6'); # for v2
+require_mods(qw(File::FcntlLock)) if $^O !~ /\A(?:linux|freebsd)\z/;
 use_ok 'IO::Socket::SSL';
 use_ok 'PublicInbox::TLS';
 my ($tmpdir, $for_destroy) = tmpdir();
@@ -59,6 +60,14 @@ my $oldc = Net::POP3->new(@old_args);
 my $locked_mb = ('e'x32)."\@$group";
 ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP to old');
 
+my $dbh = DBI->connect("dbi:SQLite:dbname=$tmpdir/p3state/db.sqlite3",'','', {
+	AutoCommit => 1,
+	RaiseError => 1,
+	PrintError => 0,
+	sqlite_use_immediate_transaction => 1,
+	sqlite_see_if_its_a_number => 1,
+});
+
 { # locking within the same process
 	my $x = Net::POP3->new(@old_args);
 	ok(!$x->apop("$locked_mb.0", 'anonymous'), 'APOP lock failure');
@@ -106,6 +115,8 @@ for my $args (
 	my @p3s_args = ($pop3s->sockhost,
 			Port => $pop3s->sockport, SSL => 1, %o);
 	my $p3s = Net::POP3->new(@p3s_args);
+	my $capa = $p3s->capa;
+	ok(!exists $capa->{STLS}, 'no STLS CAPA for POP3S');
 	ok($p3s->quit, 'QUIT works w/POP3S');
 	{
 		$p3s = Net::POP3->new(@p3s_args);
@@ -127,7 +138,11 @@ for my $args (
 	my $np3 = Net::POP3->new(@np3_args);
 	ok($np3->quit, 'plain QUIT works');
 	$np3 = Net::POP3->new(@np3_args, %o);
+	$capa = $np3->capa;
+	ok(exists $capa->{STLS}, 'STLS CAPA advertised before STLS');
 	ok($np3->starttls, 'STLS works');
+	$capa = $np3->capa;
+	ok(!exists $capa->{STLS}, 'STLS CAPA not advertised after STLS');
 	ok($np3->quit, 'QUIT works after STLS');
 
 	for my $mailbox (('x'x32)."\@$group", $group, ('a'x32)."\@z.$group") {
@@ -139,11 +154,26 @@ for my $args (
 		ok(!$np3->apop($mailbox, 'anonymous'), "APOP $mailbox reject");
 		ok($np3->quit, "QUIT after APOP fail $mailbox");
 	}
+
+	# we do connect+QUIT bumps to try ensuring non-QUIT disconnects
+	# get processed below:
 	for my $mailbox ($group, "$group.0") {
 		my $u = ('f'x32)."\@$mailbox";
+		undef $np3;
+		ok(Net::POP3->new(@np3_args)->quit, 'connect+QUIT bump');
 		$np3 = Net::POP3->new(@np3_args);
+		my $n0 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes');
+		my $u0 = $dbh->selectrow_array('SELECT COUNT(*) FROM users');
 		ok($np3->user($u), "UUID\@$mailbox accept");
 		ok($np3->pass('anonymous'), 'pass works');
+		my $n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes');
+		is($n1 - $n0, 1, 'deletes bumped while connected');
+		ok($np3->quit, 'client QUIT');
+
+		$n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes');
+		is($n1, $n0, 'deletes row gone on no-op after QUIT');
+		my $u1 = $dbh->selectrow_array('SELECT COUNT(*) FROM users');
+		is($u1, $u0, 'users row gone on no-op after QUIT');
 
 		$np3 = Net::POP3->new(@np3_args);
 		ok($np3->user($u), "UUID\@$mailbox accept");
@@ -156,9 +186,32 @@ for my $args (
 		ok($_ > 0, 'bytes in LIST result') for values %$list;
 		like($_, qr/\A[a-z0-9]{40,}\z/,
 			'blob IDs in UIDL result') for values %$uidl;
+		ok($np3->quit, 'QUIT after LIST+UIDL');
+		$n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes');
+		is($n1, $n0, 'deletes row gone on no-op after LIST+UIDL');
+		$n0 = $n1;
+
+		$np3 = Net::POP3->new(@np3_args);
+		ok($np3->user($u), "UUID\@$mailbox accept");
+		ok($np3->pass('anonymous'), 'pass works');
+		undef $np3; # QUIT-less disconnect
+		ok(Net::POP3->new(@np3_args)->quit, 'connect+QUIT bump');
+
+		$u1 = $dbh->selectrow_array('SELECT COUNT(*) FROM users');
+		is($u1, $u0, 'users row gone on QUIT-less disconnect');
+		$n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes');
+		is($n1, $n0, 'deletes row gone on QUIT-less disconnect');
+		$n0 = $n1;
 
 		$np3 = Net::POP3->new(@np3_args);
 		ok(!$np3->apop($u, 'anonumuss'), 'APOP wrong pass reject');
+		$n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes');
+		is($n1, $n0, 'deletes row not bumped w/ wrong pass');
+		undef $np3; # QUIT-less disconnect
+		ok(Net::POP3->new(@np3_args)->quit, 'connect+QUIT bump');
+
+		$n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes');
+		is($n1, $n0, 'deletes row not bumped w/ wrong pass');
 
 		$np3 = Net::POP3->new(@np3_args);
 		ok($np3->apop($u, 'anonymous'), "APOP UUID\@$mailbox");
@@ -239,6 +292,7 @@ EOF
 	my $capa = $oldc->capa;
 	ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA');
 	is($capa->{EXPIRE}, 0, 'EXPIRE 0 set');
+	ok(!exists $capa->{STLS}, 'STLS unset w/o daemon certs');
 
 	# ensure TOP doesn't trigger "EXPIRE 0" like RETR does (cf. RFC2449)
 	my $list = $oldc->list;