xt/cmp-imapd-compress.t

   1 #!perl -w
   2 # Copyright (C) 2020 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use strict;
   5 use Test::More;
   6 use PublicInbox::TestCommon;
   7 require_mods('Data::Dumper');
   8 Data::Dumper->import('Dumper');
   9 my $inboxdir = $ENV{GIANT_INBOX_DIR};
  10 (defined($inboxdir) && -d $inboxdir) or
  11         plan skip_all => "GIANT_INBOX_DIR not defined for $0";
  12 plan skip_all => "bad characters in $inboxdir" if $inboxdir =~ m![^\w\.\-/]!;
  13 my ($tmpdir, $for_destroy) = tmpdir();
  14 my $cfg = "$tmpdir/cfg";
  15 my $mailbox = 'inbox.test';
  16 {
  17         open my $fh, '>', $cfg or BAIL_OUT "open: $!";
  18         print $fh <<EOF or BAIL_OUT "print: $!";
  19 [publicinbox "test"]
  20         newsgroup = $mailbox
  21         address = test\@example.com
  22         inboxdir = $inboxdir
  23 EOF
  24         close $fh or BAIL_OUT "close: $!";
  25 }
  26 my ($out, $err) = ("$tmpdir/stdout.log", "$tmpdir/stderr.log");
  27 my $sock = tcp_server();
  28 my $cmd = [ '-imapd', '-W0', "--stdout=$out", "--stderr=$err"];
  29 my $env = { PI_CONFIG => $cfg };
  30 my $td = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT "-imapd: $?";
  31 my ($host, $port) = ($sock->sockhost, $sock->sockport);
  32 my $c = tcp_connect($sock);
  33 like(readline($c), qr/CAPABILITY /, 'got greeting');
  34 undef $c;
  35
  36 SKIP: {
  37         require_mods('Mail::IMAPClient', 3);
  38         unless ($ENV{RT_132720_FIXED}) {
  39                 my $bug = 'https://rt.cpan.org/Ticket/Display.html?id=132720';
  40                 skip "<$bug>, RT_132720_FIXED not defined", 3;
  41         }
  42         my %opt = (Server => $host, Port => $port,
  43                         User => 'u', Password => 'p', Clear => 1);
  44         my $uc = Mail::IMAPClient->new(%opt);
  45         my $c = Mail::IMAPClient->new(%opt);
  46         ok($c->compress, 'enabled compression');
  47         ok $c->examine($mailbox), 'compressed EXAMINE-ed';
  48         ok $uc->examine($mailbox), 'uncompress EXAMINE-ed';
  49         my $range = $uc->search('all');
  50         for my $uid (@$range) {
  51                 my $A = $uc->fetch_hash($uid, 'BODY[]');
  52                 my $B = $c->fetch_hash($uid, 'BODY[]');
  53                 if (!is_deeply($A, $B, "$uid identical")) {
  54                         diag Dumper([$A, $B]);
  55                         diag Dumper([$uc, $c]);
  56                         last;
  57                 }
  58         }
  59         $uc->logout;
  60         $c->logout;
  61 }
  62
  63 SKIP: {
  64         require_mods('Mail::IMAPTalk', 3);
  65         my %opt = (Server => $host, Port => $port, UseSSL => 0,
  66                 Username => 'u', Password => 'p', Uid => 1);
  67         my $uc = Mail::IMAPTalk->new(%opt) or BAIL_OUT 'IMAPTalk->new';
  68         my $c = Mail::IMAPTalk->new(%opt, UseCompress => 1) or
  69                 BAIL_OUT 'IMAPTalk->new(UseCompress => 1)';
  70         ok $c->examine($mailbox), 'compressed EXAMINE-ed';
  71         ok $uc->examine($mailbox), 'uncompress EXAMINE-ed';
  72         my $range = $uc->search('all');
  73         for my $uid (@$range) {
  74                 my $A = $uc->fetch($uid, 'rfc822');
  75                 my $B = $c->fetch($uid, 'rfc822');
  76                 if (!is_deeply($A, $B, "$uid identical")) {
  77                         diag Dumper([$A, $B]);
  78                         diag Dumper([$uc, $c]);
  79                         last;
  80                 }
  81         }
  82 }
  83 done_testing;