mirror of
https://github.com/xcat2/xcat-dep.git
synced 2026-10-02 00:41:43 +00:00
Daniel Hilst
f23a4e8786
XCAT::NFSLock recovered a dead owner's lock under a second lock, lock.break. A process that died after it created lock.break left it in place, and every later acquire timed out even when both processes were dead. The lock and its record were also put in place with rename, which replaces an empty directory, so acquire took over a lock.d that had no owner record. The lock now follows the NFS lock protocol at the top of NFSLock.pm. It uses mkdir, rmdir, unlink and plain writes, and no rename. lock.d/metadata holds the owner identity and a hash, and invalid metadata only causes a retry. Takeover and release both hold lock.borrow, beside lock.d. Only a process on the owner's machine takes over a lock, after it reads the same identity twice and proves that owner dead. acquire retries R times with a wait of T +/- jitter, and --try-unlock-timeout maps to R. Records written by the previous format are invalid metadata and are not taken over. A process that dies while it holds lock.borrow still blocks the lock. The protocol assumes that this does not happen. Signed-off-by: Daniel Hilst <392820+dhilst@users.noreply.github.com>
465 lines
15 KiB
Perl
465 lines
15 KiB
Perl
package XCAT::NFSLock;
|
|
|
|
# NFS lock protocol
|
|
#
|
|
# A lock on a shared, possibly re-exported, NFS tree. flock and fcntl are not
|
|
# available there. The protocol uses mkdir, rmdir, unlink and plain file
|
|
# writes. It uses no rename.
|
|
#
|
|
# Names in this module
|
|
# lock.d the lock path given to acquire
|
|
# lock.d/metadata the metadata of the owner
|
|
# lock.borrow <lock path>.borrow, beside lock.d
|
|
# R, T, δ the options retries, delay and jitter
|
|
#
|
|
# Assumptions
|
|
# 1. mkdir(path) is atomic and exclusive among contenders, and successful
|
|
# namespace changes eventually become visible.
|
|
# 2. machine-id is unique among participating hosts.
|
|
# Cloned VMs and images can share it by accident unless it is regenerated.
|
|
# 3. Metadata writes eventually become readable completely and consistently.
|
|
# 4. A host never declares one of its own live process incarnations dead.
|
|
# 5. A process cannot die:
|
|
# - after it creates lock.d, until it publishes valid metadata;
|
|
# - while it holds lock.borrow, until it removes it.
|
|
# 6. A crashed worker leaves recoverable state. The owning host eventually
|
|
# returns and retries. Eventually one worker and its release complete.
|
|
# 7. All participants follow the protocol.
|
|
#
|
|
# Metadata
|
|
# lock.d/metadata contains:
|
|
# machine-id, boot-id, pid, pstart, token, hash
|
|
#
|
|
# Ownership identity: (machine-id, boot-id, pid, pstart, token)
|
|
# token is random per acquisition.
|
|
# hash = HASH(canonical(SORT(k, v))) over all fields except hash.
|
|
#
|
|
# If the metadata is missing, cannot be parsed or hashed, or the hash does not
|
|
# match, assume a partial or inconsistent read and retry. Never infer stale
|
|
# ownership from invalid metadata.
|
|
#
|
|
# Retry
|
|
# R = max retries, T = base delay, δ = jitter
|
|
# R > 0, δ >= 0, T >= 3, T > 2δ
|
|
#
|
|
# Generic retry:
|
|
# if retries >= R: fail
|
|
# sleep(T + rand(-δ, δ))
|
|
# retries++
|
|
# goto 1
|
|
#
|
|
# Protocol
|
|
# 1. mkdir lock.d
|
|
# - success: write valid metadata, go to 8
|
|
# - EEXIST: continue
|
|
# - other error: fail
|
|
# 2. Read and validate the metadata.
|
|
# - invalid or missing: retry
|
|
# - different machine-id: retry
|
|
# - same host: save the observed ownership identity
|
|
# 3. mkdir lock.borrow
|
|
# - failure: retry
|
|
# 4. Read and validate the metadata again.
|
|
# - invalid, missing, or ownership identity changed: rmdir lock.borrow, retry
|
|
# 5. Prove that the recorded (boot-id, pid, pstart) is dead.
|
|
# - not provably dead: rmdir lock.borrow, retry
|
|
# - dead: continue
|
|
# 6. Replace the metadata with the identity of this process and a fresh token.
|
|
# 7. rmdir lock.borrow
|
|
# 8. Call the worker.
|
|
# 9. mkdir lock.borrow
|
|
# - failure: sleep(T + rand(-δ, δ)), retry step 9
|
|
# 10. unlink lock.d/metadata
|
|
# 11. rmdir lock.d (the actual unlock)
|
|
# 12. rmdir lock.borrow
|
|
#
|
|
# Core invariants
|
|
# lock.d exists => locked
|
|
# lock.d absent => acquirable
|
|
# invalid metadata => retry only
|
|
# different machine-id => never recover here
|
|
# lock.borrow exists => ownership transition or release in progress
|
|
#
|
|
# Steps 1 to 7 are acquire, step 8 is the caller, steps 9 to 12 are release.
|
|
# release does steps 10 and 11 only when the metadata names this acquisition.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Cwd qw(abs_path);
|
|
use Digest::SHA qw(sha256_hex);
|
|
use Errno qw(EEXIST ENOENT);
|
|
use Exporter 'import';
|
|
use File::Basename qw(dirname basename);
|
|
use Time::HiRes ();
|
|
|
|
our @EXPORT_OK = qw(this_process format_metadata parse_metadata owner_is_dead process_start);
|
|
|
|
my @IDENTITY = qw(machine-id boot-id pid pstart token);
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 acquire
|
|
|
|
Descriptions:
|
|
Take the lock at $path with steps 1 to 7 of the protocol.
|
|
Arguments:
|
|
$path: path of lock.d
|
|
%opt:
|
|
label => word for messages (default "lock")
|
|
delay => T, seconds, 3 or more (default 3)
|
|
jitter => δ, seconds, 0 or more and less than T/2 (default 0.5)
|
|
retries => R, more than 0 (default: timeout / T, at least 1)
|
|
timeout => seconds to wait, used when retries is not given (default 0)
|
|
Returns:
|
|
A lock object. Dies after R retries, naming the lock and its owner.
|
|
|
|
=cut
|
|
|
|
#--------------------------------------------------------------------------------
|
|
sub acquire {
|
|
my ($class, $path, %opt) = @_;
|
|
my $label = $opt{label} // 'lock';
|
|
my $delay = $opt{delay} // 3;
|
|
my $jitter = $opt{jitter} // 0.5;
|
|
die "Invalid delay $delay for $label: must be 3s or more\n" unless $delay >= 3;
|
|
die "Invalid jitter $jitter for $label: must be 0 or more\n" unless $jitter >= 0;
|
|
die "Invalid jitter $jitter for $label: must be less than half the delay\n"
|
|
unless $delay > 2 * $jitter;
|
|
my $retries = $opt{retries};
|
|
unless (defined($retries)) {
|
|
my $timeout = $opt{timeout} // 0;
|
|
$retries = int($timeout / $delay);
|
|
$retries++ if $retries * $delay < $timeout;
|
|
$retries = 1 if $retries < 1;
|
|
}
|
|
die "Invalid retries $retries for $label: must be a whole number more than 0\n"
|
|
unless $retries =~ /\A[1-9][0-9]*\z/;
|
|
|
|
# The last component names the lock itself. basename would turn '' into './' and drop a
|
|
# trailing slash, so the raw path is checked.
|
|
my ($name) = ($path // '') =~ m{(?:\A|/)([^/]+)\z};
|
|
die "Invalid $label path '" . ($path // '') . "'\n"
|
|
if !defined($name) || $name eq '.' || $name eq '..';
|
|
my $abs = _absolute($path);
|
|
my $borrow = "$abs.borrow";
|
|
my $self = bless {
|
|
path => $abs,
|
|
label => $label,
|
|
pid => $$,
|
|
delay => $delay,
|
|
jitter => $jitter,
|
|
}, $class;
|
|
my $here = _here();
|
|
my $seen;
|
|
|
|
for (my $count = 0 ; ; $count++) {
|
|
# Step 1.
|
|
if (mkdir($abs)) {
|
|
$self->{identity} = this_process();
|
|
return $self if eval { _write_metadata($abs, $self->{identity}); 1 };
|
|
my $error = $@;
|
|
unlink("$abs/metadata");
|
|
rmdir($abs);
|
|
die $error;
|
|
}
|
|
die "Cannot create $label $abs: $!\n" unless $! == EEXIST;
|
|
|
|
# Step 2.
|
|
my $observed = _read_metadata($abs);
|
|
$seen = $observed if defined($observed);
|
|
if (defined($observed) && $observed->{'machine-id'} eq $here->{'machine-id'} && mkdir($borrow)) {
|
|
# Steps 3 to 7.
|
|
my $taken = eval {
|
|
my $again = _read_metadata($abs);
|
|
return 0 unless defined($again) && _key($again) eq _key($observed);
|
|
return 0 unless owner_is_dead($again, $here);
|
|
$self->{identity} = this_process();
|
|
_write_metadata($abs, $self->{identity});
|
|
1;
|
|
};
|
|
my $error = $@;
|
|
rmdir($borrow);
|
|
die $error unless defined($taken);
|
|
return $self if $taken;
|
|
}
|
|
|
|
last if $count >= $retries;
|
|
_sleep(_wait($delay, $jitter));
|
|
}
|
|
|
|
my $who = _describe($seen);
|
|
my $s = $retries == 1 ? 'retry' : 'retries';
|
|
die "Trying to unlock $abs failed after $retries $s; $label owned by $who.\n"
|
|
. "If you are sure it is safe, remove the lock: rm -rf $abs\n";
|
|
}
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 release
|
|
|
|
Descriptions:
|
|
Steps 9 to 12 of the protocol. Waits while another process holds
|
|
lock.borrow. A forked child of the owner does nothing, and a lock whose
|
|
metadata names another acquisition is left alone.
|
|
Arguments:
|
|
none
|
|
Returns:
|
|
1 when the lock was removed, 0 otherwise.
|
|
|
|
=cut
|
|
|
|
#--------------------------------------------------------------------------------
|
|
sub release {
|
|
my ($self) = @_;
|
|
return 0 if $self->{released} || $$ != $self->{pid};
|
|
my $path = $self->{path};
|
|
my $borrow = "$path.borrow";
|
|
while (1) {
|
|
# Step 9.
|
|
if (mkdir($borrow)) {
|
|
my $current = _read_metadata($path);
|
|
if (defined($current) && _key($current) eq _key($self->{identity})) {
|
|
$self->{released} = 1;
|
|
unlink("$path/metadata");
|
|
my $removed = rmdir($path);
|
|
my $error = $!;
|
|
rmdir($borrow);
|
|
warn "Cannot remove $path: $error\n" unless $removed;
|
|
return $removed ? 1 : 0;
|
|
}
|
|
rmdir($borrow);
|
|
# Valid metadata of another acquisition, or no lock.d at all: this lock is gone.
|
|
if (defined($current) || !-d $path) {
|
|
$self->{released} = 1;
|
|
return 0;
|
|
}
|
|
}
|
|
elsif ($! != EEXIST) {
|
|
warn "Cannot create $borrow: $!\n";
|
|
return 0;
|
|
}
|
|
_sleep(_wait($self->{delay}, $self->{jitter}));
|
|
}
|
|
}
|
|
|
|
sub path { return $_[0]{path} }
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 this_process
|
|
|
|
Descriptions:
|
|
The ownership identity of this process with a fresh token.
|
|
Arguments:
|
|
none
|
|
Returns:
|
|
A hash ref with machine-id, boot-id, pid, pstart and token.
|
|
|
|
=cut
|
|
|
|
#--------------------------------------------------------------------------------
|
|
sub this_process {
|
|
my $here = _here();
|
|
return {
|
|
'machine-id' => $here->{'machine-id'},
|
|
'boot-id' => $here->{'boot-id'},
|
|
pid => $$,
|
|
pstart => process_start($$) // die("Cannot read the start time of pid $$\n"),
|
|
token => _token(),
|
|
};
|
|
}
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 format_metadata
|
|
|
|
Descriptions:
|
|
The content of lock.d/metadata: one "key=value" line per field, sorted
|
|
by key, and the hash line.
|
|
Arguments:
|
|
$fields: hash ref with machine-id, boot-id, pid, pstart and token
|
|
Returns:
|
|
The metadata string.
|
|
|
|
=cut
|
|
|
|
#--------------------------------------------------------------------------------
|
|
sub format_metadata {
|
|
my ($fields) = @_;
|
|
my $canonical = _canonical($fields);
|
|
return $canonical . 'hash=' . sha256_hex($canonical) . "\n";
|
|
}
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 parse_metadata
|
|
|
|
Descriptions:
|
|
Validate the content of lock.d/metadata. A partial read, an unknown or
|
|
repeated field, a malformed value and a hash that does not match all
|
|
make the metadata invalid.
|
|
Arguments:
|
|
$text: the content of lock.d/metadata, or undef
|
|
Returns:
|
|
A hash ref of the identity fields, or undef when the metadata is invalid.
|
|
|
|
=cut
|
|
|
|
#--------------------------------------------------------------------------------
|
|
sub parse_metadata {
|
|
my ($text) = @_;
|
|
return undef unless defined($text) && $text =~ /\n\z/;
|
|
my %field;
|
|
for my $line (split(/\n/, $text)) {
|
|
my ($key, $value) = $line =~ /\A([a-z-]+)=([^=\s]+)\z/ or return undef;
|
|
return undef if exists($field{$key});
|
|
$field{$key} = $value;
|
|
}
|
|
my $hash = delete($field{hash});
|
|
return undef unless defined($hash) && keys(%field) == @IDENTITY;
|
|
for my $key (@IDENTITY) {
|
|
return undef unless defined($field{$key});
|
|
}
|
|
return undef unless $field{pid} =~ /\A[1-9][0-9]*\z/ && $field{pstart} =~ /\A[0-9]+\z/;
|
|
return undef unless $hash eq sha256_hex(_canonical(\%field));
|
|
return \%field;
|
|
}
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 owner_is_dead
|
|
|
|
Descriptions:
|
|
Step 5: decide from facts alone whether a recorded owner is dead. Only
|
|
the owner's machine can know. Any other machine answers "not proven".
|
|
Arguments:
|
|
$owner: a hash ref from parse_metadata, or undef
|
|
$here: hash ref with machine-id, boot-id and start_of, a code ref that
|
|
returns the start time of a pid on this machine, or undef when
|
|
no such process exists
|
|
Returns:
|
|
1 when the owner is provably dead, 0 otherwise.
|
|
|
|
=cut
|
|
|
|
#--------------------------------------------------------------------------------
|
|
sub owner_is_dead {
|
|
my ($owner, $here) = @_;
|
|
return 0 unless defined($owner);
|
|
return 0 unless $owner->{'machine-id'} eq $here->{'machine-id'};
|
|
return 1 unless $owner->{'boot-id'} eq $here->{'boot-id'};
|
|
my $start = $here->{start_of}->($owner->{pid});
|
|
return 1 unless defined($start);
|
|
return $start eq $owner->{pstart} ? 0 : 1;
|
|
}
|
|
|
|
#--------------------------------------------------------------------------------
|
|
|
|
=head3 process_start
|
|
|
|
Descriptions:
|
|
The start time of a process, field 22 of /proc/<pid>/stat, in clock ticks
|
|
since boot. A reused pid has a later start time.
|
|
Arguments:
|
|
$pid: the process id
|
|
Returns:
|
|
The start time, or undef when no such process exists.
|
|
|
|
=cut
|
|
|
|
#--------------------------------------------------------------------------------
|
|
sub process_start {
|
|
my ($pid) = @_;
|
|
open(my $fh, '<', "/proc/$pid/stat") or return undef;
|
|
my $stat = <$fh>;
|
|
close($fh);
|
|
return undef unless defined($stat);
|
|
# The command name, field 2, may contain spaces and parentheses.
|
|
$stat =~ s/\A.*\)\s+//s or return undef;
|
|
my @field = split(/\s+/, $stat);
|
|
return $field[19];
|
|
}
|
|
|
|
sub _canonical {
|
|
my ($fields) = @_;
|
|
return join('', map { "$_=$fields->{$_}\n" } sort @IDENTITY);
|
|
}
|
|
|
|
sub _key {
|
|
my ($fields) = @_;
|
|
return join("\n", map { $fields->{$_} } @IDENTITY);
|
|
}
|
|
|
|
# A reader can see this file half written. The hash makes that read invalid.
|
|
sub _write_metadata {
|
|
my ($path, $identity) = @_;
|
|
my $file = "$path/metadata";
|
|
my $fh;
|
|
open($fh, '>', $file) && print({$fh} format_metadata($identity)) && close($fh)
|
|
or die "Cannot write $file: $!\n";
|
|
}
|
|
|
|
sub _read_metadata {
|
|
my ($path) = @_;
|
|
open(my $fh, '<', "$path/metadata") or return undef;
|
|
local $/;
|
|
my $text = <$fh>;
|
|
close($fh);
|
|
return parse_metadata($text);
|
|
}
|
|
|
|
sub _wait {
|
|
my ($delay, $jitter) = @_;
|
|
return $delay + (2 * rand() - 1) * $jitter;
|
|
}
|
|
|
|
sub _sleep {
|
|
my ($seconds) = @_;
|
|
Time::HiRes::sleep($seconds);
|
|
}
|
|
|
|
sub _token {
|
|
if (open(my $fh, '<:raw', '/dev/urandom')) {
|
|
my $read = read($fh, my $bytes, 16);
|
|
close($fh);
|
|
return unpack('H*', $bytes) if defined($read) && $read == 16;
|
|
}
|
|
return join('', map { sprintf('%08x', int(rand(2**32))) } 1 .. 4);
|
|
}
|
|
|
|
# Assumption 2 needs a real machine-id. A host without one cannot take part.
|
|
sub _here {
|
|
return {
|
|
'machine-id' => _first_line('/etc/machine-id')
|
|
// die("Cannot read /etc/machine-id: an NFS lock needs a machine id\n"),
|
|
'boot-id' => _first_line('/proc/sys/kernel/random/boot_id')
|
|
// die("Cannot read the boot id of this machine\n"),
|
|
start_of => \&process_start,
|
|
};
|
|
}
|
|
|
|
sub _first_line {
|
|
my ($file) = @_;
|
|
open(my $fh, '<', $file) or return undef;
|
|
my $line = <$fh>;
|
|
close($fh);
|
|
return undef unless defined($line);
|
|
chomp($line);
|
|
return length($line) ? $line : undef;
|
|
}
|
|
|
|
sub _describe {
|
|
my ($owner) = @_;
|
|
return 'an unknown owner' unless defined($owner);
|
|
return sprintf('pid %s on machine %s', $owner->{pid}, $owner->{'machine-id'});
|
|
}
|
|
|
|
# An absolute path in the message, without resolving the lock itself.
|
|
sub _absolute {
|
|
my ($path) = @_;
|
|
my $dir = abs_path(dirname($path)) // dirname($path);
|
|
return "$dir/" . basename($path);
|
|
}
|
|
|
|
1;
|