t/mbox_lock.t

   1 #!perl -w
   2 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use strict; use v5.10.1; use PublicInbox::TestCommon;
   5 use autodie qw(chdir);
   6 use POSIX qw(_exit);
   7 use PublicInbox::DS qw(now);
   8 use Errno qw(EAGAIN);
   9 use PublicInbox::OnDestroy;
  10 use_ok 'PublicInbox::MboxLock';
  11 my ($tmpdir, $for_destroy) = tmpdir();
  12 my $f = "$tmpdir/f";
  13 my $mbl = PublicInbox::MboxLock->acq($f, 1, ['dotlock']);
  14 ok(-f "$f.lock", 'dotlock created');
  15 undef $mbl;
  16 ok(!-f "$f.lock", 'dotlock gone');
  17 $mbl = PublicInbox::MboxLock->acq($f, 1, ['none']);
  18 ok(!-f "$f.lock", 'no dotlock with none');
  19 undef $mbl;
  20 {
  21         opendir my $cur, '.' or BAIL_OUT $!;
  22         my $od = on_destroy \&chdir, $cur;
  23         chdir $tmpdir;
  24         my $abs = "$tmpdir/rel.lock";
  25         my $rel = PublicInbox::MboxLock->acq('rel', 1, ['dotlock']);
  26         chdir '/';
  27         ok(-f $abs, 'lock with abs path created');
  28         undef $rel;
  29         ok(!-f $abs, 'lock gone despite being in the wrong dir');
  30 }
  31
  32 eval {
  33         PublicInbox::MboxLock->acq($f, 1, ['bogus']);
  34         fail "should not succeed with `bogus'";
  35 };
  36 ok($@, "fails on `bogus' lock method");
  37 eval {
  38         PublicInbox::MboxLock->acq($f, 1, ['timeout=1']);
  39         fail "should not succeed with only timeout";
  40 };
  41 ok($@, "fails with only `timeout=' and no lock method");
  42
  43 my $defaults = PublicInbox::MboxLock->defaults;
  44 is(ref($defaults), 'ARRAY', 'default lock methods');
  45 my $test_rw_lock = sub {
  46         my ($func) = @_;
  47         my $m = ["$func,timeout=0.000001"];
  48         for my $i (1..2) {
  49                 pipe(my ($r, $w)) or BAIL_OUT "pipe: $!";
  50                 my $t0 = now;
  51                 my $pid = fork // BAIL_OUT "fork $!";
  52                 if ($pid == 0) {
  53                         eval { PublicInbox::MboxLock->acq($f, 1, $m) };
  54                         my $err = $@;
  55                         syswrite $w, "E: $err";
  56                         _exit($err ? 0 : 1);
  57                 }
  58                 undef $w;
  59                 waitpid($pid, 0);
  60                 is($?, 0, "$func r/w lock behaved as expected #$i");
  61                 my $d = now - $t0;
  62                 ok($d < 1, "$func r/w timeout #$i") or diag "elapsed=$d";
  63                 my $err = do { local $/; <$r> };
  64                 $! = EAGAIN;
  65                 my $msg = "$!";
  66                 like($err, qr/\Q$msg\E/, "got EAGAIN in child #$i");
  67         }
  68 };
  69
  70 my $test_ro_lock = sub {
  71         my ($func) = @_;
  72         for my $i (1..2) {
  73                 my $t0 = now;
  74                 my $pid = fork // BAIL_OUT "fork $!";
  75                 if ($pid == 0) {
  76                         eval { PublicInbox::MboxLock->acq($f, 0, [ $func ]) };
  77                         _exit($@ ? 1 : 0);
  78                 }
  79                 waitpid($pid, 0);
  80                 is($?, 0, "$func ro lock behaved as expected #$i");
  81                 my $d = now - $t0;
  82                 ok($d < 1, "$func timeout respected #$i") or diag "elapsed=$d";
  83         }
  84 };
  85
  86 SKIP: {
  87         grep(/fcntl/, @$defaults) or skip 'File::FcntlLock not available', 1;
  88         my $top = PublicInbox::MboxLock->acq($f, 1, $defaults);
  89         ok($top, 'fcntl lock acquired');
  90         $test_rw_lock->('fcntl');
  91         undef $top;
  92         $top = PublicInbox::MboxLock->acq($f, 0, $defaults);
  93         ok($top, 'fcntl read lock acquired');
  94         $test_ro_lock->('fcntl');
  95 }
  96 $mbl = PublicInbox::MboxLock->acq($f, 1, ['flock']);
  97 ok($mbl, 'flock acquired');
  98 $test_rw_lock->('flock');
  99 undef $mbl;
 100 $mbl = PublicInbox::MboxLock->acq($f, 0, ['flock']);
 101 $test_ro_lock->('flock');
 102
 103 done_testing;