# Copyright (C) 2021 all contributors # License: AGPL-3.0+ # 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 <{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;