1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
# Copyright (C) 2021 all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
# Various mbox locking methods
package PublicInbox::MboxLock;
use strict;
use v5.10.1;
use PublicInbox::OnDestroy;
use Fcntl qw(:flock F_SETLK F_SETLKW F_RDLCK F_WRLCK
O_CREAT O_EXCL O_WRONLY SEEK_SET);
use Carp qw(croak);
use PublicInbox::DS qw(now); # ugh...
our $TMPL = do {
if ($^O eq 'linux') { \'s @32' }
elsif ($^O =~ /bsd/) { \'@20 s @256' } # n.b. @32 may be enough...
else { eval { require File::FcntlLock; 1 } }
};
# This order matches Debian policy on Linux systems.
# See policy/ch-customized-programs.rst in
# https://salsa.debian.org/dbnpolicy/policy.git
sub defaults { [ qw(fcntl dotlock) ] }
sub acq_fcntl {
my ($self) = @_;
my $op = $self->{nb} ? F_SETLK : F_SETLKW;
my $t = $self->{rw} ? F_WRLCK : F_RDLCK;
my $end = now + $self->{timeout};
$TMPL or die <<EOF;
"struct flock" layout not available on $^O, install File::FcntlLock?
EOF
do {
if (ref $TMPL) {
return if fcntl($self->{fh}, $op, pack($$TMPL, $t));
} else {
my $fl = File::FcntlLock->new;
$fl->l_type($t);
$fl->l_whence(SEEK_SET);
$fl->l_start(0);
$fl->l_len(0);
return if $fl->lock($self->{fh}, $op);
}
select(undef, undef, undef, $self->{delay});
} while (now < $end);
die "fcntl lock timeout $self->{f}: $!\n";
}
sub acq_dotlock {
my ($self) = @_;
my $dot_lock = "$self->{f}.lock";
my ($pfx, $base) = ($self->{f} =~ m!(\A.*?/)?([^/]+)\z!);
$pfx //= '';
my $pid = $$;
my $end = now + $self->{timeout};
do {
my $tmp = "$pfx.$base-".sprintf('%x,%x,%x',
rand(0xffffffff), $pid, time);
if (sysopen(my $fh, $tmp, O_CREAT|O_EXCL|O_WRONLY)) {
if (link($tmp, $dot_lock)) {
unlink($tmp) or die "unlink($tmp): $!";
$self->{".lock$pid"} = $dot_lock;
if (substr($dot_lock, 0, 1) ne '/') {
opendir(my $dh, '.') or
die "opendir . $!";
$self->{dh} = $dh;
}
return;
}
unlink($tmp) or die "unlink($tmp): $!";
select(undef, undef, undef, $self->{delay});
} else {
croak "open $tmp (for $dot_lock): $!" if !$!{EXIST};
}
} while (now < $end);
die "dotlock timeout $dot_lock\n";
}
sub acq_flock {
my ($self) = @_;
my $op = $self->{rw} ? LOCK_EX : LOCK_SH;
$op |= LOCK_NB if $self->{nb};
my $end = now + $self->{timeout};
do {
return if flock($self->{fh}, $op);
select(undef, undef, undef, $self->{delay});
} while (now < $end);
die "flock timeout $self->{f}: $!\n";
}
sub acq {
my ($cls, $f, $rw, $methods) = @_;
my $fh;
unless (open $fh, $rw ? '+>>' : '<', $f) {
croak "open($f): $!" if $rw || !$!{ENOENT};
}
my $self = bless { f => $f, fh => $fh, rw => $rw }, $cls;
my $m = "@$methods";
if ($m ne 'none') {
my @m = map {
if (/\A(timeout|delay)=([0-9\.]+)s?\z/) {
$self->{$1} = $2 + 0;
();
} else {
$cls->can("acq_$_") // $_
}
} split(/[, ]/, $m);
my @bad = grep { !ref } @m;
croak "Unsupported lock methods: @bad\n" if @bad;
croak "No lock methods supplied with $m\n" if !@m;
$self->{nb} = $#m || defined($self->{timeout});
$self->{delay} //= 0.1;
$self->{timeout} //= 5;
$_->($self) for @m;
}
$self;
}
sub _fchdir { chdir($_[0]) } # OnDestroy callback
sub DESTROY {
my ($self) = @_;
if (my $f = $self->{".lock$$"}) {
my $x;
if (my $dh = delete $self->{dh}) {
opendir my $c, '.' or die "opendir . $!";
$x = PublicInbox::OnDestroy->new(\&_fchdir, $c);
chdir($dh) or die "chdir (for $f): $!";
}
unlink($f) or die "unlink($f): $! (lock stolen?)";
undef $x;
}
}
1;
|
