mirror of
https://github.com/xcat2/xcat-dep.git
synced 2026-09-30 14:55:17 +00:00
feat(xcat-dep): add XCAT::NFSLock, a lock for the shared NFS tree
The dep builds lock trees on a shared NFS tree that the hypervisors re-export. The kernel refuses flock and fcntl locks to clients of a re-export, so every such lock fails with errno 524. XCAT::NFSLock builds a lock as a directory under a private name, with an owner record and the caller's metadata, and renames it into place. The record holds the machine id, boot id, pid, process start time and a random token. The owner removes the lock, or a process on the owner's host that proves the owner dead: another boot, no such pid, or a pid with another start time. That process takes a breaker lock and proves the owner dead again before it removes the lock. Removal renames the lock away first. Any other acquire waits up to a timeout, retrying every 3 s by default, then fails with the mv command that moves the lock away. A lock left by mockbuild-all.pl before this module is taken when its pid is gone on this host. t/nfslock.t covers each rule without NFS. Signed-off-by: Daniel Hilst <392820+dhilst@users.noreply.github.com>
This commit is contained in:
Daniel Hilst
@@ -0,0 +1,406 @@
|
||||
package XCAT::NFSLock;
|
||||
|
||||
# A lock on a shared, possibly re-exported, NFS tree.
|
||||
#
|
||||
# Definitions
|
||||
# L, P, H, J locks, processes, hosts, jobs
|
||||
# host : P → H the host a process runs on
|
||||
# job : P → J the job a process belongs to
|
||||
# Dₜ ⊆ P the processes dead at time t
|
||||
# Oₜ(l) ⊆ P the processes that acquired l and have not released it, live or dead
|
||||
#
|
||||
# Assumptions
|
||||
# A1 Job-host affinity ∀ p, q ∈ P : job(p) = job(q) ⇒ host(p) = host(q)
|
||||
# A job always runs on the same host.
|
||||
# A2 Mortality ∀ p ∈ P : ∃ t : p ∈ Dₜ
|
||||
# Every process ends.
|
||||
# A3 Atomicity mkdir and rename are atomic. flock and fcntl are unavailable.
|
||||
#
|
||||
# Safety
|
||||
# S1 Single ownership ∀ l, t : |Oₜ(l) ∖ Dₜ| ≤ 1
|
||||
# At most one live process holds a lock.
|
||||
# S2 No borrowing q removes l at t ∧ q ∉ Oₜ(l) ⇒ ∀ p ∈ Oₜ(l) : p ∈ Dₜ ∧ host(p) = host(q)
|
||||
# Only a process on the holders' host removes a lock, when all are dead.
|
||||
#
|
||||
# Liveness
|
||||
# L1 Bounded wait Every acquire ends within its timeout, owning l or naming it in an error.
|
||||
# L2 Recovery ∅ ≠ Oₜ(l) ⊆ Dₜ ∧ job(q) ∈ job(Oₜ(l)) ⇒ q takes l with no operator
|
||||
# The next run of the same job reclaims a dead owner's lock.
|
||||
# L3 Disjoint progress Jobs that write disjoint resources take disjoint locks.
|
||||
#
|
||||
# Algorithm
|
||||
# acquire(l, τ)
|
||||
# 1. r ← (host, boot, pid, start time) of this process.
|
||||
# 2. Create a private directory holding r and rename it to l. On success, return.
|
||||
# 3. If l's owner is dead, break(l) and go to 2.
|
||||
# 4. If τ has passed, fail and name l.
|
||||
# 5. Wait, then go to 2.
|
||||
#
|
||||
# break(l)
|
||||
# 1. Create l.break atomically. If it exists, another process is breaking l: return.
|
||||
# 2. If l's owner is still dead, rename l away.
|
||||
# 3. Remove l.break.
|
||||
#
|
||||
# release(l)
|
||||
# 1. If l's record is r, rename l away.
|
||||
#
|
||||
# dead(r) ⇔ r.host = this host
|
||||
# ∧ (r.boot ≠ current boot ∨ r.pid does not exist ∨ start time of r.pid ≠ r.start)
|
||||
#
|
||||
# Where each property rests
|
||||
# S1 acquire 2 (one rename wins) and break 2 (the owner is re-checked under l.break)
|
||||
# S2 dead(r), which only r's host can prove, and release 1
|
||||
# L1 acquire 4
|
||||
# L2 acquire 3
|
||||
# L3 the caller, which takes one lock per resource
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Cwd qw(abs_path);
|
||||
use Errno qw(EEXIST ENOENT ENOTEMPTY ESTALE);
|
||||
use Exporter 'import';
|
||||
use File::Basename qw(dirname basename);
|
||||
use File::Glob qw(bsd_glob);
|
||||
use File::Path qw(remove_tree);
|
||||
use Sys::Hostname qw(hostname);
|
||||
use Time::HiRes ();
|
||||
|
||||
our @EXPORT_OK = qw(owner_record parse_owner owner_is_dead process_start);
|
||||
|
||||
my $FORMAT = 'nfslock2';
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
|
||||
=head3 acquire
|
||||
|
||||
Descriptions:
|
||||
Take the lock at $path. Waits while another live process owns it, and
|
||||
removes it when the owner is provably dead on this machine.
|
||||
Arguments:
|
||||
$path: path of the lock directory
|
||||
%opt:
|
||||
timeout => seconds to wait for a live owner (default 0: try once)
|
||||
label => word for messages (default "lock")
|
||||
retry => seconds between attempts, more than 0.5 (default 3)
|
||||
meta => hash ref of file name => content, written into the lock
|
||||
before it appears
|
||||
Returns:
|
||||
A lock object. Dies when the wait ends, naming the owner and the mv
|
||||
command that moves the lock away. The next acquire deletes a lock moved
|
||||
to <path>.dead.*.
|
||||
|
||||
=cut
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
sub acquire {
|
||||
my ($class, $path, %opt) = @_;
|
||||
my $timeout = $opt{timeout} // 0;
|
||||
my $label = $opt{label} // 'lock';
|
||||
my $retry = $opt{retry} // 3;
|
||||
# Each attempt is a mkdir, writes and a rename on the NFS server.
|
||||
die "Invalid retry interval $retry for $label: must be more than 0.5s\n" unless $retry > 0.5;
|
||||
my $meta = $opt{meta} // {};
|
||||
for my $name (keys %$meta) {
|
||||
die "Invalid metadata name '$name' for $label\n"
|
||||
if $name eq 'owner' || $name !~ /\A[A-Za-z0-9_][A-Za-z0-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 $self = bless { path => $abs, label => $label, pid => $$ }, $class;
|
||||
$self->{record} = owner_record();
|
||||
my $deadline = Time::HiRes::time() + $timeout;
|
||||
my $owner;
|
||||
|
||||
_sweep($abs);
|
||||
while (1) {
|
||||
return $self if _create($abs, $self->{record}, $meta);
|
||||
my $error = $!;
|
||||
die "Cannot create $label $abs: $error\n"
|
||||
unless grep { $error == $_ } (EEXIST, ENOTEMPTY, ENOENT, ESTALE);
|
||||
|
||||
my $current = _read_owner($abs);
|
||||
$owner = $current if defined($current);
|
||||
next if _owner_dead($current) && _break($abs);
|
||||
my $left = $deadline - Time::HiRes::time();
|
||||
last if $left <= 0;
|
||||
# Randomise the wait. Two waiters that back off by the same amount keep colliding.
|
||||
my $wait = $retry + rand($retry / 4);
|
||||
Time::HiRes::sleep($wait < $left ? $wait : $left);
|
||||
}
|
||||
|
||||
my $who = _describe(parse_owner($owner));
|
||||
die "Trying to unlock $abs failed after ${timeout}s; $label owned by $who.\n"
|
||||
. "If you are sure it is safe, move the lock away: mv $abs $abs.dead.manual\n";
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
|
||||
=head3 release
|
||||
|
||||
Descriptions:
|
||||
Remove the lock if this process owns it. A forked child of the owner does
|
||||
nothing, and a lock that no longer carries this owner's record 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 $current = _read_owner($self->{path});
|
||||
return 0 unless defined($current) && $current eq $self->{record};
|
||||
$self->{released} = 1;
|
||||
return _remove($self->{path});
|
||||
}
|
||||
|
||||
sub path { return $_[0]{path} }
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
|
||||
=head3 owner_record
|
||||
|
||||
Descriptions:
|
||||
The content of the owner file: the machine, its boot, the pid and the
|
||||
start time of the process, a random token, and, for messages only, the
|
||||
host name and the creation time. The token tells two acquisitions of one
|
||||
process apart, so a record names one acquisition.
|
||||
Arguments:
|
||||
none
|
||||
Returns:
|
||||
The record string.
|
||||
|
||||
=cut
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
sub owner_record {
|
||||
my %here = %{ _here() };
|
||||
return join('', map { "$_\n" } $FORMAT,
|
||||
"machine=$here{machine}", "boot=$here{boot}", "pid=$$",
|
||||
'start=' . (process_start($$) // 0),
|
||||
sprintf('token=%08x%08x', int(rand(2**32)), int(rand(2**32))),
|
||||
'host=' . (hostname() || 'unknown'), 'created=' . time());
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
|
||||
=head3 parse_owner
|
||||
|
||||
Descriptions:
|
||||
Split a record written by owner_record into its fields.
|
||||
Arguments:
|
||||
$record: the content of an owner file
|
||||
Returns:
|
||||
A hash ref of the fields, or undef when $record is not such a record.
|
||||
|
||||
=cut
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
sub parse_owner {
|
||||
my ($record) = @_;
|
||||
return undef unless defined($record);
|
||||
my ($format, @lines) = split(/\n/, $record);
|
||||
return undef unless defined($format) && $format eq $FORMAT;
|
||||
my %field;
|
||||
for my $line (@lines) {
|
||||
my ($key, $value) = split(/=/, $line, 2);
|
||||
return undef unless defined($value);
|
||||
$field{$key} = $value;
|
||||
}
|
||||
for my $key (qw(machine boot pid start)) {
|
||||
return undef unless defined($field{$key}) && length($field{$key});
|
||||
}
|
||||
return undef unless $field{pid} =~ /\A[1-9][0-9]*\z/ && $field{start} =~ /\A[0-9]+\z/;
|
||||
return \%field;
|
||||
}
|
||||
|
||||
#--------------------------------------------------------------------------------
|
||||
|
||||
=head3 owner_is_dead
|
||||
|
||||
Descriptions:
|
||||
Decide from facts alone whether a recorded owner is dead. Only the owner's
|
||||
machine can know: any other machine answers "not proven". An unreadable
|
||||
record is never proven dead.
|
||||
Arguments:
|
||||
$owner: a hash ref from parse_owner, or undef
|
||||
$here: hash ref with machine, boot 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} eq $here->{machine};
|
||||
return 1 unless $owner->{boot} eq $here->{boot};
|
||||
my $start = $here->{start_of}->($owner->{pid});
|
||||
return 1 unless defined($start);
|
||||
return $start eq $owner->{start} ? 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];
|
||||
}
|
||||
|
||||
# Build the lock under a private name, then rename it into place: the owner
|
||||
# record and the metadata appear with the lock. rename fails when the target is
|
||||
# a directory that is not empty, so one creator wins.
|
||||
sub _create {
|
||||
my ($path, $record, $meta) = @_;
|
||||
my $tmp = _private_name($path, 'tmp');
|
||||
mkdir($tmp) or return 0;
|
||||
my %files = (%{ $meta // {} }, owner => $record);
|
||||
for my $name (sort keys %files) {
|
||||
my $fh;
|
||||
unless (open($fh, '>', "$tmp/$name") && print({$fh} $files{$name}) && close($fh)) {
|
||||
my $error = $!;
|
||||
remove_tree($tmp);
|
||||
die "Cannot write $tmp/$name: $error\n";
|
||||
}
|
||||
}
|
||||
return 1 if rename($tmp, $path);
|
||||
my $error = $!;
|
||||
remove_tree($tmp);
|
||||
# NFS can retransmit a rename that already succeeded, and the reply is then
|
||||
# an error. The owner file says whether the lock in place is this one.
|
||||
my $current = _read_owner($path);
|
||||
return 1 if defined($current) && $current eq $record;
|
||||
$! = $error;
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Two processes can find the same dead owner. Only the one holding the breaker
|
||||
# removes the lock, and only after it proves the current owner dead again: only
|
||||
# the owner or the breaker removes the lock, so that owner is the one removed.
|
||||
sub _break {
|
||||
my ($path) = @_;
|
||||
my $breaker = "$path.break";
|
||||
my $mine = owner_record();
|
||||
return 0 unless _create($breaker, $mine, {});
|
||||
my $removed = 0;
|
||||
if (_owner_dead(_read_owner($path))) {
|
||||
$removed = _remove($path);
|
||||
}
|
||||
my $held = _read_owner($breaker);
|
||||
_remove($breaker) if defined($held) && $held eq $mine;
|
||||
return $removed;
|
||||
}
|
||||
|
||||
# One rename takes the lock away. The detached tree is deleted afterwards: an
|
||||
# NFS client keeps a file open by renaming it to .nfsXXXX, which only delays
|
||||
# that delete.
|
||||
sub _remove {
|
||||
my ($path) = @_;
|
||||
my $dead = _private_name($path, 'dead');
|
||||
return 0 unless rename($path, $dead);
|
||||
remove_tree($dead);
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Leftovers of earlier runs. A detached tree belongs to nobody. A private build
|
||||
# belongs to its creator until that creator is proven dead.
|
||||
sub _sweep {
|
||||
my ($path) = @_;
|
||||
for my $dead (bsd_glob("$path.dead.*")) {
|
||||
remove_tree($dead) if -d $dead && !-l $dead;
|
||||
}
|
||||
for my $tmp (bsd_glob("$path.tmp.*")) {
|
||||
next unless -d $tmp && !-l $tmp;
|
||||
remove_tree($tmp) if _owner_dead(_read_owner($tmp));
|
||||
}
|
||||
}
|
||||
|
||||
# Whether the owner file names a dead owner. mockbuild-all.pl wrote host, pid and epoch before this
|
||||
# module, without a start time: there, only a pid that no longer exists on this host is proof.
|
||||
sub _owner_dead {
|
||||
my ($record) = @_;
|
||||
return owner_is_dead(parse_owner($record), _here()) if defined(parse_owner($record));
|
||||
return 0 unless defined($record) && $record =~ /\Ahost=(\S+)\npid=([1-9][0-9]*)\nepoch=[0-9]+\n\z/;
|
||||
my ($host, $pid) = ($1, $2);
|
||||
return 0 unless $host eq (hostname() || '');
|
||||
return defined(process_start($pid)) ? 0 : 1;
|
||||
}
|
||||
|
||||
sub _private_name {
|
||||
my ($path, $kind) = @_;
|
||||
return sprintf('%s.%s.%d.%08x', $path, $kind, $$, int(rand(2**32)));
|
||||
}
|
||||
|
||||
sub _read_owner {
|
||||
my ($path) = @_;
|
||||
open(my $fh, '<', "$path/owner") or return undef;
|
||||
local $/;
|
||||
my $record = <$fh>;
|
||||
close($fh);
|
||||
return $record;
|
||||
}
|
||||
|
||||
sub _here {
|
||||
return {
|
||||
machine => _first_line('/etc/machine-id') // (hostname() || 'unknown'),
|
||||
boot => _first_line('/proc/sys/kernel/random/boot_id') // 'unknown',
|
||||
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 %s since %s', $owner->{pid}, $owner->{host} // $owner->{machine},
|
||||
scalar(localtime($owner->{created} // 0)));
|
||||
}
|
||||
|
||||
# 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;
|
||||
+281
@@ -0,0 +1,281 @@
|
||||
#!/usr/bin/perl
|
||||
# XCAT::NFSLock: a directory lock that only its owner, or a process that proves
|
||||
# the owner dead on the owner's machine, removes.
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
use FindBin qw($RealBin);
|
||||
use lib "$RealBin/../lib";
|
||||
use File::Temp qw(tempdir);
|
||||
use File::Slurper qw(read_text write_text);
|
||||
use Errno qw(ENOENT);
|
||||
use POSIX ();
|
||||
use Time::HiRes ();
|
||||
|
||||
my $retransmit;
|
||||
|
||||
BEGIN {
|
||||
no warnings 'once';
|
||||
# An NFS retransmit: the first rename succeeded, the reply said ENOENT.
|
||||
*CORE::GLOBAL::rename = sub {
|
||||
my ($from, $to) = @_;
|
||||
if (defined($retransmit) && $to eq $retransmit) {
|
||||
CORE::rename($from, $to) or die "Cannot stage $to: $!";
|
||||
$! = ENOENT;
|
||||
return 0;
|
||||
}
|
||||
return CORE::rename($from, $to);
|
||||
};
|
||||
}
|
||||
|
||||
use XCAT::NFSLock qw(owner_record parse_owner owner_is_dead process_start);
|
||||
|
||||
my $dir = tempdir(CLEANUP => 1);
|
||||
my $me = parse_owner(owner_record());
|
||||
ok($me, 'the owner record of this process parses');
|
||||
is($me->{pid}, $$, 'the owner record names this process');
|
||||
is($me->{start}, process_start($$), 'the owner record carries the start time of this process');
|
||||
|
||||
# No process can have a pid above the kernel's pid_max (2**22 at most).
|
||||
my $gone = 2**22 + 7;
|
||||
is(process_start($gone), undef, 'a pid that names no process has no start time');
|
||||
|
||||
my $parent = getppid();
|
||||
my $parent_start = process_start($parent);
|
||||
|
||||
sub record {
|
||||
my (%f) = @_;
|
||||
my %r = (%$me, host => 'peer', created => 1, %f);
|
||||
return join('', map { "$_\n" } 'nfslock2', map { "$_=$r{$_}" } qw(machine boot pid start token host created));
|
||||
}
|
||||
|
||||
sub stage {
|
||||
my ($name, $record) = @_;
|
||||
my $path = "$dir/$name";
|
||||
mkdir($path) or die "Cannot stage $path: $!";
|
||||
write_text("$path/owner", $record) if defined($record);
|
||||
return $path;
|
||||
}
|
||||
|
||||
sub leftovers {
|
||||
my ($path) = @_;
|
||||
return [ map { s{\A\Q$dir\E/}{}r } glob("$path.*") ];
|
||||
}
|
||||
|
||||
# A free lock is taken with its metadata and released without leftovers.
|
||||
{
|
||||
my $path = "$dir/free.lock";
|
||||
my $lock = XCAT::NFSLock->acquire($path, meta => { job => "xcat-dep-build-el10\n" });
|
||||
is(read_text("$path/owner"), $lock->{record}, 'a free lock is taken with this owner record');
|
||||
is(read_text("$path/job"), "xcat-dep-build-el10\n", 'the metadata is in the lock');
|
||||
is($lock->release, 1, 'the owner releases its lock');
|
||||
ok(!-e $path, 'the released lock is gone');
|
||||
is_deeply(leftovers($path), [], 'release leaves nothing beside the lock');
|
||||
is($lock->release, 0, 'a second release does nothing');
|
||||
}
|
||||
|
||||
for my $bad ('', "$dir/.", "$dir/..", "$dir/") {
|
||||
eval { XCAT::NFSLock->acquire($bad); 1 };
|
||||
like($@, qr/\AInvalid lock path/, "a lock path that names no entry is refused: '$bad'");
|
||||
}
|
||||
|
||||
for my $retry (0, 0.5, -1) {
|
||||
eval { XCAT::NFSLock->acquire("$dir/bad-retry.lock", retry => $retry); 1 };
|
||||
like($@, qr/\AInvalid retry interval $retry for lock: must be more than 0\.5s/,
|
||||
"a retry interval of ${retry}s is refused");
|
||||
}
|
||||
|
||||
# A waiter takes the lock once its live owner releases it.
|
||||
{
|
||||
my $path = "$dir/handover.lock";
|
||||
pipe(my $ready_r, my $ready_w) or die "Cannot pipe: $!";
|
||||
my $child = fork() // die "Cannot fork: $!";
|
||||
if ($child == 0) {
|
||||
close($ready_r);
|
||||
my $held = XCAT::NFSLock->acquire($path);
|
||||
syswrite($ready_w, "x");
|
||||
Time::HiRes::sleep(0.5);
|
||||
$held->release;
|
||||
POSIX::_exit(0);
|
||||
}
|
||||
close($ready_w);
|
||||
sysread($ready_r, my $byte, 1);
|
||||
my $start = Time::HiRes::time();
|
||||
my $lock = eval { XCAT::NFSLock->acquire($path, timeout => 10, retry => 0.6) };
|
||||
my $spent = Time::HiRes::time() - $start;
|
||||
waitpid($child, 0);
|
||||
ok($lock, 'a waiter takes the lock after its owner releases it') or diag($@);
|
||||
cmp_ok($spent, '<', 3, 'the waiter retries at its interval, not at the timeout');
|
||||
$lock->release if $lock;
|
||||
}
|
||||
|
||||
eval { XCAT::NFSLock->acquire("$dir/bad-meta.lock", meta => { owner => 'x' }); 1 };
|
||||
like($@, qr/\AInvalid metadata name 'owner'/, 'metadata cannot replace the owner record');
|
||||
eval { XCAT::NFSLock->acquire("$dir/bad-meta.lock", meta => { '../x' => 'x' }); 1 };
|
||||
like($@, qr/\AInvalid metadata name '\.\.\/x'/, 'metadata names stay inside the lock');
|
||||
|
||||
# Live owners and owners that cannot be proven dead keep their lock.
|
||||
for my $case (
|
||||
[ 'live owner on this machine', record(pid => $parent, start => $parent_start) ],
|
||||
[ 'owner on another machine', record(machine => 'elsewhere', pid => $gone) ],
|
||||
[ 'record in another format', "somebody-else\n" ],
|
||||
[ 'lock with no owner file', undef ],
|
||||
)
|
||||
{
|
||||
my ($name, $record) = @$case;
|
||||
(my $file = "$name.lock") =~ s/\s+/-/g;
|
||||
my $path = stage($file, $record);
|
||||
write_text("$path/data", 'kept');
|
||||
eval { XCAT::NFSLock->acquire($path, timeout => 0.3, label => 'repository lock'); 1 };
|
||||
like($@, qr/\ATrying to unlock \Q$path\E failed after 0\.3s; repository lock owned by /,
|
||||
"$name: the wait ends with an error that names the lock");
|
||||
is(read_text("$path/data"), 'kept', "$name: the lock is left in place");
|
||||
is_deeply(leftovers($path), [], "$name: no breaker or private tree is left behind");
|
||||
}
|
||||
|
||||
# Owners proven dead on this machine lose their lock.
|
||||
for my $case (
|
||||
[ 'process gone', record(pid => $gone) ],
|
||||
[ 'pid reused', record(pid => $parent, start => $parent_start + 1) ],
|
||||
[ 'machine rebooted', record(boot => 'an-earlier-boot', pid => $parent, start => $parent_start) ],
|
||||
)
|
||||
{
|
||||
my ($name, $record) = @$case;
|
||||
(my $file = "$name.lock") =~ s/\s+/-/g;
|
||||
my $path = stage($file, $record);
|
||||
my $lock = eval { XCAT::NFSLock->acquire($path) };
|
||||
ok($lock, "$name: the lock of a dead owner is taken") or diag($@);
|
||||
is(read_text("$path/owner"), $lock && $lock->{record}, "$name: the lock now names this process");
|
||||
is_deeply(leftovers($path), [], "$name: the breaker and the old lock are gone");
|
||||
$lock->release if $lock;
|
||||
}
|
||||
|
||||
# Locks written by mockbuild-all.pl before XCAT::NFSLock: host, pid and epoch only.
|
||||
{
|
||||
use Sys::Hostname qw(hostname);
|
||||
my $host = hostname();
|
||||
my $old = sub { my ($h, $pid) = @_; return "host=$h\npid=$pid\nepoch=1\n" };
|
||||
|
||||
my $gone_path = stage('legacy-gone.lock', $old->($host, $gone));
|
||||
my $lock = eval { XCAT::NFSLock->acquire($gone_path) };
|
||||
ok($lock, 'an old lock whose process is gone on this host is taken') or diag($@);
|
||||
$lock->release if $lock;
|
||||
|
||||
for my $case ([ 'live on this host', $old->($host, $parent) ],
|
||||
[ 'from another host', $old->('another-host', $gone) ]) {
|
||||
my ($name, $record) = @$case;
|
||||
(my $file = "legacy-$name.lock") =~ s/\s+/-/g;
|
||||
my $path = stage($file, $record);
|
||||
eval { XCAT::NFSLock->acquire($path); 1 };
|
||||
like($@, qr/\ATrying to unlock \Q$path\E /, "an old lock $name is not taken");
|
||||
is(read_text("$path/owner"), $record, "the old lock $name is left in place");
|
||||
}
|
||||
}
|
||||
|
||||
# Another process is breaking the lock: this one does not remove it.
|
||||
{
|
||||
my $dead = record(pid => $gone);
|
||||
my $path = stage('breaking.lock', $dead);
|
||||
my $busy = record(pid => $parent, start => $parent_start);
|
||||
stage('breaking.lock.break', $busy);
|
||||
eval { XCAT::NFSLock->acquire($path, timeout => 0.3); 1 };
|
||||
like($@, qr/\ATrying to unlock /, 'a lock under another breaker is not taken');
|
||||
is(read_text("$path/owner"), $dead, 'the lock under another breaker is left in place');
|
||||
is(read_text("$path.break/owner"), $busy, 'the other breaker is left in place');
|
||||
}
|
||||
|
||||
# The owner is alive by the time of the break: the breaker does not remove the lock.
|
||||
{
|
||||
my $live = record(pid => $parent, start => $parent_start);
|
||||
my $path = stage('changed.lock', $live);
|
||||
is(XCAT::NFSLock::_break($path), 0, 'a lock whose owner is alive at the break is not removed');
|
||||
is(read_text("$path/owner"), $live, 'the owner keeps its lock');
|
||||
is_deeply(leftovers($path), [], 'the breaker is released');
|
||||
}
|
||||
|
||||
# A forked child of the owner does not release the lock.
|
||||
{
|
||||
my $path = "$dir/forked.lock";
|
||||
my $lock = XCAT::NFSLock->acquire($path);
|
||||
my $child = fork() // die "Cannot fork: $!";
|
||||
POSIX::_exit($lock->release ? 1 : 0) if $child == 0;
|
||||
waitpid($child, 0);
|
||||
is($? >> 8, 0, 'the child reports that it released nothing');
|
||||
ok(-d $path, 'the lock survives the child');
|
||||
is($lock->release, 1, 'the owner still releases it');
|
||||
}
|
||||
|
||||
# A delete that NFS holds back (a file still open is renamed to .nfsXXXX and
|
||||
# stays) does not keep the lock: release takes it away first.
|
||||
{
|
||||
my $path = "$dir/held-open.lock";
|
||||
my $lock = XCAT::NFSLock->acquire($path);
|
||||
{
|
||||
no warnings 'redefine';
|
||||
local *XCAT::NFSLock::remove_tree = sub { return 0 };
|
||||
is($lock->release, 1, 'release succeeds while the delete is held back');
|
||||
}
|
||||
ok(!-e $path, 'the lock is gone while its old tree still exists');
|
||||
my $next = eval { XCAT::NFSLock->acquire($path) };
|
||||
ok($next, 'the next owner takes the lock at once') or diag($@);
|
||||
$next->release if $next;
|
||||
}
|
||||
|
||||
# One process takes the lock once: a second acquire is another owner.
|
||||
{
|
||||
my $path = "$dir/twice.lock";
|
||||
my $first = XCAT::NFSLock->acquire($path);
|
||||
my $second = eval { XCAT::NFSLock->acquire($path) };
|
||||
ok(!$second, 'a second acquire in the same process does not take a held lock');
|
||||
is($first->release, 1, 'the first owner still holds and releases it');
|
||||
}
|
||||
|
||||
# The lock was replaced: release leaves the other owner's lock alone.
|
||||
{
|
||||
my $path = "$dir/replaced.lock";
|
||||
my $lock = XCAT::NFSLock->acquire($path);
|
||||
my $other = record(pid => $parent, start => $parent_start);
|
||||
write_text("$path/owner", $other);
|
||||
is($lock->release, 0, 'release does not remove a lock with another record');
|
||||
is(read_text("$path/owner"), $other, 'the other owner keeps its lock');
|
||||
}
|
||||
|
||||
# NFS answered with an error to a rename that had succeeded.
|
||||
{
|
||||
my $path = $retransmit = "$dir/retransmit.lock";
|
||||
my $lock = eval { XCAT::NFSLock->acquire($path) };
|
||||
ok($lock, 'a retransmitted rename that placed this record takes the lock') or diag($@);
|
||||
undef $retransmit;
|
||||
}
|
||||
|
||||
# Leftovers: detached trees go, a private build goes only when its creator is dead.
|
||||
{
|
||||
my $path = "$dir/swept.lock";
|
||||
stage('swept.lock.dead.1.00000001', record(pid => $parent, start => $parent_start));
|
||||
stage('swept.lock.tmp.2.00000002', record(pid => $gone));
|
||||
stage('swept.lock.tmp.3.00000003', record(pid => $parent, start => $parent_start));
|
||||
my $lock = XCAT::NFSLock->acquire($path);
|
||||
is_deeply(leftovers($path), ['swept.lock.tmp.3.00000003'],
|
||||
'the sweep removes detached trees and dead builds, and keeps a live build');
|
||||
$lock->release;
|
||||
}
|
||||
|
||||
# owner_is_dead decides from facts only.
|
||||
{
|
||||
my %here = (machine => 'm1', boot => 'b1', start_of => sub { $_[0] == 10 ? 100 : undef });
|
||||
my %rec = (machine => 'm1', boot => 'b1', pid => 10, start => 100);
|
||||
is(owner_is_dead(undef, \%here), 0, 'an unreadable record is not proven dead');
|
||||
is(owner_is_dead({ %rec }, \%here), 0, 'a live owner is not dead');
|
||||
is(owner_is_dead({ %rec, machine => 'm2' }, \%here), 0, 'another machine proves nothing');
|
||||
is(owner_is_dead({ %rec, machine => 'm2', pid => 11 }, \%here), 0,
|
||||
'another machine proves nothing, even for a pid that is free here');
|
||||
is(owner_is_dead({ %rec, boot => 'b0' }, \%here), 1, 'an owner from an earlier boot is dead');
|
||||
is(owner_is_dead({ %rec, pid => 11 }, \%here), 1, 'an owner whose pid is gone is dead');
|
||||
is(owner_is_dead({ %rec, start => 99 }, \%here), 1, 'an owner whose pid was reused is dead');
|
||||
}
|
||||
|
||||
is(parse_owner("nfslock2\nmachine=m\nboot=b\npid=0\nstart=1\n"), undef, 'a record with pid 0 is rejected');
|
||||
is(parse_owner("nfslock2\nmachine=m\nboot=b\npid=5\n"), undef, 'a record without a start time is rejected');
|
||||
is(parse_owner("nfslock1\nmachine=m\nboot=b\npid=5\nstart=1\n"), undef, 'a record in another format is rejected');
|
||||
|
||||
done_testing();
|
||||
Reference in New Issue
Block a user