From 29f3d0554f91a7b7aab40130e14179553ee7cb3f Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Wed, 10 Jun 2020 07:04:33 +0000 Subject: imapclient: wrapper for Mail::IMAPClient We'll be using this wrapper class to workaround some upstream bugs in Mail::IMAPClient. There may also be experiments with new APIs for more performance. --- t/imapd-tls.t | 37 ++++++++++++++++--------------------- t/imapd.t | 35 +++++++++++++++++++---------------- 2 files changed, 35 insertions(+), 37 deletions(-) (limited to 't') diff --git a/t/imapd-tls.t b/t/imapd-tls.t index 9f5abfe0..5352d100 100644 --- a/t/imapd-tls.t +++ b/t/imapd-tls.t @@ -7,8 +7,15 @@ 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 +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) { @@ -67,18 +74,6 @@ my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport; 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,7 +107,7 @@ 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')), @@ -122,12 +117,12 @@ for my $args ( 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 +136,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 diff --git a/t/imapd.t b/t/imapd.t index 7af14f1b..3d0be340 100644 --- a/t/imapd.t +++ b/t/imapd.t @@ -9,6 +9,12 @@ use PublicInbox::TestCommon; use PublicInbox::Config; use PublicInbox::Spawn qw(which); require_mods(qw(DBD::SQLite Mail::IMAPClient Mail::IMAPClient::BodyStructure)); +my $imap_client = 'Mail::IMAPClient'; +my $can_compress = $imap_client->can('compress'); +if ($can_compress) { # hope this gets fixed upstream, soon + require PublicInbox::IMAPClient; + $imap_client = 'PublicInbox::IMAPClient'; +} my $level = '-Lbasic'; SKIP: { @@ -57,7 +63,7 @@ my %mic_opt = ( Port => $sock->sockport, Uid => 1, ); -my $mic = Mail::IMAPClient->new(%mic_opt); +my $mic = $imap_client->new(%mic_opt); my $pre_login_capa = $mic->capability; is(grep(/\AAUTH=ANONYMOUS\z/, @$pre_login_capa), 1, 'AUTH=ANONYMOUS advertised pre-login'); @@ -71,7 +77,7 @@ ok(join("\n", @$pre_login_capa) ne join("\n", @$post_login_capa), $mic_opt{Authmechanism} = 'ANONYMOUS'; $mic_opt{Authcallback} = sub { '' }; -$mic = Mail::IMAPClient->new(%mic_opt); +$mic = $imap_client->new(%mic_opt); ok($mic && $mic->login && $mic->IsAuthenticated, 'AUTHENTICATE ANONYMOUS'); my $post_auth_anon_capa = $mic->capability; is_deeply($post_auth_anon_capa, $post_login_capa, @@ -175,20 +181,17 @@ for my $r ('1:*', '1') { is(lc($bs->bodyenc), '8bit', '->bodyenc'); } -# 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); - } -}; - is_deeply([$mic->has_capability('COMPRESS')], ['DEFLATE'], 'deflate cap'); -ok($mic->compress, 'compress enabled'); -$compress_logout->($mic); +SKIP: { + skip 'Mail::IMAPClient too old for ->compress', 2 if !$can_compress; + my $c = $imap_client->new(%mic_opt); + ok($c && $c->compress, 'compress enabled'); + ok($c->examine('inbox.i1'), 'EXAMINE succeeds after COMPRESS'); + $ret = $c->search('uid 1:*') or BAIL_OUT "SEARCH FAIL $@"; + is_deeply($ret, [ 1 ], 'search UID 1:* works after compression'); +} + +ok($mic->logout, 'logout works'); my $have_inotify = eval { require Linux::Inotify2; 1 }; @@ -198,7 +201,7 @@ $pi_config->each_inbox(sub { my $env = { ORIGINAL_RECIPIENT => $ibx->{-primary_address} }; my $name = $ibx->{name}; my $ng = $ibx->{newsgroup}; - my $mic = Mail::IMAPClient->new(%mic_opt); + my $mic = $imap_client->new(%mic_opt); ok($mic && $mic->login && $mic->IsAuthenticated, "authed $name"); my $uidnext = $mic->uidnext($ng); # we'll fetch BODYSTRUCTURE on this ok($uidnext, 'got uidnext for later fetch'); -- cgit v1.2.3-24-ge0c7