X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fimapd-tls.t;h=44ab350c95b34a7240320e41a88803e3643779e1;hb=4eee5af6011cc8cdefb66c9729952c7eff5c0b0b;hp=9f5abfe048ef339bca707ab077ea203ca88cd9b3;hpb=90f11ce471c53365a77896c847d0a39b0995b5b5;p=public-inbox.git diff --git a/t/imapd-tls.t b/t/imapd-tls.t index 9f5abfe0..44ab350c 100644 --- a/t/imapd-tls.t +++ b/t/imapd-tls.t @@ -1,14 +1,21 @@ -# Copyright (C) 2020 all contributors +#!perl -w +# Copyright (C) 2020-2021 all contributors # License: AGPL-3.0+ use strict; -use warnings; -use Test::More; +use v5.10.1; use Socket qw(IPPROTO_TCP SOL_SOCKET); use PublicInbox::TestCommon; # IO::Poll is part of the standard library, but distros may split it off... -require_mods(qw(DBD::SQLite IO::Socket::SSL Mail::IMAPClient IO::Poll)); -Mail::IMAPClient->can('starttls') or +require_mods(qw(-imapd IO::Socket::SSL Mail::IMAPClient IO::Poll)); +my $imap_client = 'Mail::IMAPClient'; +$imap_client->can('starttls') or plan skip_all => 'Mail::IMAPClient does not support TLS'; +my $can_compress = $imap_client->can('compress'); +if ($can_compress) { # hope this gets fixed upstream, soon + require PublicInbox::IMAPClient; + $imap_client = 'PublicInbox::IMAPClient'; +} + my $cert = 'certs/server-cert.pem'; my $key = 'certs/server-key.pem'; unless (-r $key && -r $cert) { @@ -17,68 +24,38 @@ unless (-r $key && -r $cert) { } use_ok 'PublicInbox::TLS'; use_ok 'IO::Socket::SSL'; -use PublicInbox::InboxWritable; -require PublicInbox::SearchIdx; my $version = 1; # v2 needs newer git require_git('2.6') if $version >= 2; my ($tmpdir, $for_destroy) = tmpdir(); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $inboxdir = "$tmpdir"; -my $pi_config = "$tmpdir/pi_config"; +my $pi_config; my $group = 'test-imapd-tls'; my $addr = $group . '@example.com'; my $starttls = tcp_server(); my $imaps = tcp_server(); -my $ibx = PublicInbox::Inbox->new({ - inboxdir => $inboxdir, - name => 'imapd-tls', - version => $version, - -primary_address => $addr, - indexlevel => 'basic', -}); -$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1}); -$ibx->init_inbox(0); -{ +my $ibx = create_inbox 'imapd-tls', version => $version, + -primary_address => $addr, indexlevel => 'basic', sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/data/0001.patch')) or BAIL_OUT '->add'; + $pi_config = "$ibx->{inboxdir}/pi_config"; open my $fh, '>', $pi_config or BAIL_OUT "open: $!"; - print $fh <{inboxdir} address = $addr indexlevel = basic newsgroup = $group EOF - ; close $fh or BAIL_OUT "close: $!\n"; -} - -{ - my $im = $ibx->importer(0); - ok($im->add(eml_load('t/data/0001.patch')), 'message added'); - $im->done; - if ($version == 1) { - my $s = PublicInbox::SearchIdx->new($ibx, 1); - $s->index_sync; - } -} +}; +$pi_config //= "$ibx->{inboxdir}/pi_config"; -my $imaps_addr = $imaps->sockhost . ':' . $imaps->sockport; -my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport; +my $imaps_addr = tcp_host_port($imaps); +my $starttls_addr = tcp_host_port($starttls); my $env = { PI_CONFIG => $pi_config }; my $td; -# Mail::IMAPClient ->compress creates cyclic reference: -# https://rt.cpan.org/Ticket/Display.html?id=132654 -my $compress_logout = sub { - my ($c) = @_; - ok($c->logout, 'logout ok after ->compress'); - # all documented in Mail::IMAPClient manpage: - for (qw(Readmoremethod Readmethod Prewritemethod)) { - $c->$_(undef); - } -}; - - for my $args ( [ "--cert=$cert", "--key=$key", "-limaps://$imaps_addr", @@ -112,22 +89,24 @@ for my $args ( Server => $imaps->sockhost, Port => $imaps->sockport); # IMAPS - my $c = Mail::IMAPClient->new(%imaps_opt, Ssl => [ %o ]); + my $c = $imap_client->new(%imaps_opt, Ssl => [ %o ]); ok($c && $c->IsAuthenticated, 'authenticated'); ok($c->select($group), 'SELECT works'); ok(!(scalar $c->has_capability('STARTTLS')), 'starttls not advertised with IMAPS'); ok(!$c->starttls, "starttls fails"); - ok($c->has_capability('COMPRESS'), 'compress advertised'); + ok($c->has_capability('COMPRESS') || + $c->has_capability('COMPRESS=DEFLATE'), + 'compress advertised'); ok($c->compress, 'compression enabled with IMAPS'); ok(!$c->starttls, 'starttls still fails'); ok($c->noop, 'noop succeeds'); - $compress_logout->($c); + ok($c->logout, 'logout succeeds'); # STARTTLS my %imap_opt = (Server => $starttls->sockhost, Port => $starttls->sockport); - $c = Mail::IMAPClient->new(%imap_opt); + $c = $imap_client->new(%imap_opt); ok(scalar $c->has_capability('STARTTLS'), 'starttls advertised'); ok($c->Starttls([ %o ]), 'set starttls options'); @@ -141,25 +120,25 @@ for my $args ( ok($c->noop, 'NOOP works'); ok($c->compress, 'compression enabled with IMAPS'); ok($c->noop, 'NOOP works after compress'); - $compress_logout->($c); + ok($c->logout, 'logout succeeds after compress'); # STARTTLS with bad hostname $o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.invalid'; - $c = Mail::IMAPClient->new(%imap_opt); + $c = $imap_client->new(%imap_opt); ok(scalar $c->has_capability('STARTTLS'), 'starttls advertised'); ok($c->Starttls([ %o ]), 'set starttls options'); ok(!$c->starttls, '->starttls fails with bad hostname'); - $c = Mail::IMAPClient->new(%imap_opt); + $c = $imap_client->new(%imap_opt); ok($c->noop, 'NOOP still works from plain IMAP'); # IMAPS with bad hostname - $c = Mail::IMAPClient->new(%imaps_opt, Ssl => [ %o ]); + $c = $imap_client->new(%imaps_opt, Ssl => [ %o ]); is($c, undef, 'IMAPS fails with bad hostname'); # make hostname valid $o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.local'; - $c = Mail::IMAPClient->new(%imaps_opt, Ssl => [ %o ]); + $c = $imap_client->new(%imaps_opt, Ssl => [ %o ]); ok($c, 'IMAPS succeeds again with valid hostname'); # slow TLS connection did not block the other fast clients while @@ -176,6 +155,13 @@ for my $args ( ok(sysread($slow, my $end, 4096) > 0, 'got end'); is(sysread($slow, my $eof, 4096), 0, 'got EOF'); + test_lei(sub { + lei_ok qw(ls-mail-source), "imap://$starttls_addr", + \'STARTTLS not used by default'; + ok(!lei(qw(ls-mail-source -c imap.starttls=true), + "imap://$starttls_addr"), 'STARTTLS verify fails'); + }); + SKIP: { skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux'; my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9; @@ -190,10 +176,11 @@ for my $args ( skip 'accf_data not loaded? kldload accf_data', 2; } require PublicInbox::Daemon; - my $var = PublicInbox::Daemon::SO_ACCEPTFILTER(); - my $x = getsockopt($imaps, SOL_SOCKET, $var); + my $x = getsockopt($imaps, SOL_SOCKET, + $PublicInbox::Daemon::SO_ACCEPTFILTER); like($x, qr/\Adataready\0+\z/, 'got dataready accf for IMAPS'); - $x = getsockopt($starttls, IPPROTO_TCP, $var); + $x = getsockopt($starttls, IPPROTO_TCP, + $PublicInbox::Daemon::SO_ACCEPTFILTER); is($x, undef, 'no BSD accept filter for plain IMAP'); };