use v5.12;
use PublicInbox::TestCommon;
use Socket qw(IPPROTO_TCP SOL_SOCKET);
+my $cert = 'certs/server-cert.pem';
+my $key = 'certs/server-key.pem';
+unless (-r $key && -r $cert) {
+ plan skip_all =>
+ "certs/ missing for $0, run $^X ./create-certs.perl in certs/";
+}
+
# 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();
my $stls_addr = tcp_host_port($stls);
my $plain_addr = tcp_host_port($plain);
my $env = { PI_CONFIG => $pi_config };
-my $cert = 'certs/server-cert.pem';
-my $key = 'certs/server-key.pem';
-
-unless (-r $key && -r $cert) {
- plan skip_all =>
- "certs/ missing for $0, run $^X ./create-certs.perl in certs/";
-}
-
my $old = start_script(['-pop3d', '-W0',
"--stdout=$tmpdir/plain.out", "--stderr=$olderr" ],
$env, { 3 => $plain });
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');
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);
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") {
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");
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");
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');
- # clients which see "EXPIRE 0" can elide DELE requests
+ # ensure TOP doesn't trigger "EXPIRE 0" like RETR does (cf. RFC2449)
my $list = $oldc->list;
+ ok(scalar keys %$list, 'got a listing of messages');
+ ok($oldc->top($_, 1), "TOP $_ 1") for keys %$list;
+ ok($oldc->quit, 'QUIT after TOP');
+
+ # clients which see "EXPIRE 0" can elide DELE requests
+ $oldc = Net::POP3->new(@old_args);
+ ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP for RETR');
+ is_deeply($oldc->capa, $capa, 'CAPA unchanged');
+ is_deeply($oldc->list, $list, 'LIST unchanged by previous TOP');
ok($oldc->get($_), "RETR $_") for keys %$list;
ok($oldc->quit, 'QUIT after RETR');