t/pop3d-limit.t

   1 #!perl -w
   2 # Copyright (C) all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use v5.12;
   5 use PublicInbox::TestCommon;
   6 require_mods(qw(DBD::SQLite Net::POP3 :fcntl_lock));
   7 use autodie;
   8 my ($tmpdir, $for_destroy) = tmpdir();
   9 mkdir("$tmpdir/p3state");
  10 use PublicInbox::Eml;
  11 my $group = 'test.pop3d.limit';
  12 my $addr = 'pop3d-limit@example.com';
  13
  14 my $add_msg = sub {
  15         my ($im, $n) = @_;
  16         $im->add(PublicInbox::Eml->new(<<EOM)) or die 'add dup';
  17 From: $n\@example.com
  18 Subject: msg $n
  19 To: $addr
  20 Message-ID: <mid-$n\@example.com>
  21 Date: Sat, 02 Oct 2010 00:00:00 +0000
  22
  23 body $n
  24 EOM
  25 };
  26
  27 my $ibx = create_inbox 'pop3d-limit', -primary_address => $addr,
  28                         indexlevel => 'basic', tmpdir => "$tmpdir/ibx", sub {
  29         my ($im, $ibx) = @_;
  30         $add_msg->($im, $_) for (1..3);
  31         $im->done;
  32         diag 'done';
  33 }; # /create_inbox
  34
  35 my $pi_config = "$tmpdir/pi_config";
  36 {
  37         open my $fh, '>', $pi_config;
  38         print $fh <<EOF;
  39 [publicinbox]
  40         pop3state = $tmpdir/p3state
  41 [publicinbox "pop3"]
  42         inboxdir = $ibx->{inboxdir}
  43         address = $addr
  44         indexlevel = basic
  45         newsgroup = $group
  46 EOF
  47         close $fh;
  48 }
  49
  50 my $plain = tcp_server();
  51 my $plain_addr = tcp_host_port($plain);
  52 my $env = { PI_CONFIG => $pi_config };
  53 my $p3d = start_script([qw(-pop3d -W0),
  54         "--stdout=$tmpdir/out.log", "--stderr=$tmpdir/err.log" ],
  55         $env, { 3 => $plain });
  56 my @np3args = ($plain->sockhost, Port => $plain->sockport);
  57 my $fetch_delete = sub {
  58         my ($np3) = @_;
  59         map {
  60                 my $msg = $np3->get($_);
  61                 $np3->delete($_);
  62                 PublicInbox::Eml->new(join('', @$msg));
  63         } sort { $a <=> $b } keys %{$np3->list};
  64 };
  65
  66 my $login_a = ('a'x32)."\@$group?initial_limit=2&limit=1";
  67 my $login_a0 = ('a'x32)."\@$group.0?initial_limit=2&limit=1";
  68 my $login_b = ('b'x32)."\@$group?limit=1";
  69 my $login_b0 = ('b'x32)."\@$group.0?limit=1";
  70 my $login_c = ('c'x32)."\@$group?limit=10";
  71 my $login_c0 = ('c'x32)."\@$group.0?limit=10";
  72 my $login_d = ('d'x32)."\@$group?limit=100000";
  73 my $login_d0 = ('d'x32)."\@$group.0?limit=100000";
  74
  75 for my $login ($login_a, $login_a0) {
  76         my $np3 = Net::POP3->new(@np3args) or xbail "Net::POP3 $!";
  77         $np3->login($login, 'anonymous') or xbail "login $login ($!)";
  78         my @msg = $fetch_delete->($np3);
  79         $np3->quit;
  80         is_deeply([ map { $_->header('Message-ID') } @msg ],
  81                 [ qw(<mid-2@example.com> <mid-3@example.com>) ],
  82                 "initial_limit ($login)") or diag explain(\@msg);
  83 }
  84
  85 for my $login ($login_b, $login_b0) {
  86         my $np3 = Net::POP3->new(@np3args);
  87         $np3->login($login, 'anonymous') or xbail "login $login ($!)";
  88         my @msg = $fetch_delete->($np3);
  89         $np3->quit;
  90         is_deeply([ map { $_->header('Message-ID') } @msg ],
  91                 [ qw(<mid-3@example.com>) ],
  92                 "limit-only ($login)") or diag explain(\@msg);
  93 }
  94
  95 for my $login ($login_c, $login_c0, $login_d, $login_d0) {
  96         my $np3 = Net::POP3->new(@np3args);
  97         $np3->login($login, 'anonymous') or xbail "login $login ($!)";
  98         my @msg = $fetch_delete->($np3);
  99         $np3->quit;
 100         is_deeply([ map { $_->header('Message-ID') } @msg ],
 101                 [ qw(<mid-1@example.com> <mid-2@example.com>
 102                         <mid-3@example.com>) ],
 103                 "excessive limit ($login)") or diag explain(\@msg);
 104 }
 105
 106 { # add some new messages
 107         my $im = $ibx->importer(0);
 108         $add_msg->($im, $_) for (4..5);
 109         $im->done;
 110 }
 111
 112 for my $login ($login_a, $login_a0) {
 113         my $np3 = Net::POP3->new(@np3args);
 114         $np3->login($login, 'anonymous') or xbail "login $login ($!)";
 115         my @msg = $fetch_delete->($np3);
 116         $np3->quit;
 117         is_deeply([ map { $_->header('Message-ID') } @msg ],
 118                 [ qw(<mid-5@example.com>) ],
 119                 "limit used (initial_limit ignored, $login)") or
 120                         diag explain(\@msg);
 121 }
 122
 123 for my $login ($login_b, $login_b0) {
 124         my $np3 = Net::POP3->new(@np3args);
 125         $np3->login($login, 'anonymous') or xbail "login $login ($!)";
 126         my @msg = $fetch_delete->($np3);
 127         $np3->quit;
 128         is_deeply([ map { $_->header('Message-ID') } @msg ],
 129                 [ qw(<mid-5@example.com>) ],
 130                 "limit-only after new messages ($login)") or
 131                 diag explain(\@msg);
 132 }
 133
 134 for my $login ($login_c, $login_c0, $login_d, $login_d0) {
 135         my $np3 = Net::POP3->new(@np3args);
 136         $np3->login($login, 'anonymous') or xbail "login $login ($!)";
 137         my @msg = $fetch_delete->($np3);
 138         $np3->quit;
 139         is_deeply([ map { $_->header('Message-ID') } @msg ],
 140                 [ qw(<mid-4@example.com> <mid-5@example.com>) ],
 141                 "excessive limit ($login)") or diag explain(\@msg);
 142 }
 143
 144 done_testing;