1 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
4 # Various mbox locking methods
5 package PublicInbox::MboxLock;
8 use PublicInbox::OnDestroy;
9 use Fcntl qw(:flock F_SETLK F_SETLKW F_RDLCK F_WRLCK
10 O_CREAT O_EXCL O_WRONLY SEEK_SET);
12 use PublicInbox::DS qw(now); # ugh...
15 if ($^O eq 'linux') { \'s @32' }
16 elsif ($^O =~ /bsd/) { \'@20 s @256' } # n.b. @32 may be enough...
17 else { eval { require File::FcntlLock; 1 } }
20 # This order matches Debian policy on Linux systems.
21 # See policy/ch-customized-programs.rst in
22 # https://salsa.debian.org/dbnpolicy/policy.git
23 sub defaults { [ qw(fcntl dotlock) ] }
27 my $op = $self->{nb} ? F_SETLK : F_SETLKW;
28 my $t = $self->{rw} ? F_WRLCK : F_RDLCK;
29 my $end = now + $self->{timeout};
31 "struct flock" layout not available on $^O, install File::FcntlLock?
35 return if fcntl($self->{fh}, $op, pack($$TMPL, $t));
37 my $fl = File::FcntlLock->new;
39 $fl->l_whence(SEEK_SET);
42 return if $fl->lock($self->{fh}, $op);
44 select(undef, undef, undef, $self->{delay});
46 die "fcntl lock timeout $self->{f}: $!\n";
51 my $dot_lock = "$self->{f}.lock";
52 my ($pfx, $base) = ($self->{f} =~ m!(\A.*?/)?([^/]+)\z!);
55 my $end = now + $self->{timeout};
57 my $tmp = "$pfx.$base-".sprintf('%x,%x,%x',
58 rand(0xffffffff), $pid, time);
59 if (sysopen(my $fh, $tmp, O_CREAT|O_EXCL|O_WRONLY)) {
60 if (link($tmp, $dot_lock)) {
61 unlink($tmp) or die "unlink($tmp): $!";
62 $self->{".lock$pid"} = $dot_lock;
63 if (substr($dot_lock, 0, 1) ne '/') {
64 opendir(my $dh, '.') or
70 unlink($tmp) or die "unlink($tmp): $!";
71 select(undef, undef, undef, $self->{delay});
73 croak "open $tmp (for $dot_lock): $!" if !$!{EXIST};
76 die "dotlock timeout $dot_lock\n";
81 my $op = $self->{rw} ? LOCK_EX : LOCK_SH;
82 $op |= LOCK_NB if $self->{nb};
83 my $end = now + $self->{timeout};
85 return if flock($self->{fh}, $op);
86 select(undef, undef, undef, $self->{delay});
88 die "flock timeout $self->{f}: $!\n";
92 my ($cls, $f, $rw, $methods) = @_;
94 unless (open $fh, $rw ? '+>>' : '<', $f) {
95 croak "open($f): $!" if $rw || !$!{ENOENT};
97 my $self = bless { f => $f, fh => $fh, rw => $rw }, $cls;
101 if (/\A(timeout|delay)=([0-9\.]+)s?\z/) {
102 $self->{$1} = $2 + 0;
105 $cls->can("acq_$_") // $_
108 my @bad = grep { !ref } @m;
109 croak "Unsupported lock methods: @bad\n" if @bad;
110 croak "No lock methods supplied with $m\n" if !@m;
111 $self->{nb} = $#m || defined($self->{timeout});
112 $self->{delay} //= 0.1;
113 $self->{timeout} //= 5;
119 sub _fchdir { chdir($_[0]) } # OnDestroy callback
123 if (my $f = $self->{".lock$$"}) {
125 if (my $dh = delete $self->{dh}) {
126 opendir my $c, '.' or die "opendir . $!";
127 $x = PublicInbox::OnDestroy->new(\&_fchdir, $c);
128 chdir($dh) or die "chdir (for $f): $!";
130 unlink($f) or die "unlink($f): $! (lock stolen?)";