public-inbox.git  about / heads / tags
an "archives first" approach to mailing lists
blob 9d7d4a32a13c45e64a237c953225b7c76ecaaaaa 3479 bytes (raw)
$ git show HEAD:lib/PublicInbox/MboxLock.pm	# shows this blob on the CLI

  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
 
# Copyright (C) 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 v5.12;
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...
use autodie qw(chdir opendir unlink);

our $TMPL = do {
	if ($^O eq 'linux') {
		\'s @32'
	} elsif ($^O =~ /bsd/ || $^O eq 'dragonfly') {
		\'@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);
				$self->{".lock$pid"} = $dot_lock;
				substr($dot_lock, 0, 1) eq '/' or
					opendir($self->{dh}, '.');
				return;
			}
			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);
		if ($!{EWOULDBLOCK}) {
			select(undef, undef, undef, $self->{delay});
		} elsif (!$!{EINTR}) {
			croak "flock($self->{f} ($self->{fh}): $!";
		}
	} while (now < $end);
	die "flock timeout $self->{f}: $!\n";
}

sub acq {
	my ($cls, $f, $rw, $methods) = @_;
	my $self = bless { f => $f, rw => $rw }, $cls;
	my $ok = open $self->{fh}, $rw ? '+>>' : '<', $f;
	croak "open($f): $!" if !$ok && ($rw || !$!{ENOENT});
	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 DESTROY {
	my ($self) = @_;
	my $f = $self->{".lock$$"} or return;
	my $x;
	if (my $dh = delete $self->{dh}) {
		opendir my $c, '.';
		$x = PublicInbox::OnDestroy->new(\&chdir, $c);
		chdir($dh);
	}
	CORE::unlink($f) or die "unlink($f): $! (lock stolen?)";
}

1;

git clone https://public-inbox.org/public-inbox.git
git clone http://7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd.onion/public-inbox.git