X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fpop3d.t;h=e5d537671292657b17dd5e75e4151c82ea18993b;hb=refs%2Fheads%2Fmaster;hp=d5ccb0d8c5b4922d0e275986e45b604ff384dfff;hpb=68046e0fff12c35d793a7ae9f164ac415c84cc21;p=public-inbox.git diff --git a/t/pop3d.t b/t/pop3d.t index d5ccb0d8..dc52b0cf 100644 --- a/t/pop3d.t +++ b/t/pop3d.t @@ -4,9 +4,17 @@ 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(); @@ -43,14 +51,6 @@ my $pop3s_addr = tcp_host_port($pop3s); 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 }); @@ -59,6 +59,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 +114,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 +137,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 +153,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 +185,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,9 +291,19 @@ 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'); - # 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');