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