diff --git a/BUILD.md b/BUILD.md index 797226b..078e373 100644 --- a/BUILD.md +++ b/BUILD.md @@ -140,9 +140,9 @@ Use these flags to skip specific operations: - `--dry-run` - Prints planned actions without executing them. - `--try-unlock-timeout ` - - Waits up to N seconds (default 0) for a lock that a live process holds, then fails and prints - the command that removes the lock. A lock whose owner is proven dead on this host is removed - at once. + - Waits about N seconds for a lock that a live process holds, in retries of 3 seconds with + at least one retry, then fails and prints the command that removes the lock. A lock whose + owner is proven dead on this host is taken over at once. # Prerequisites @@ -251,9 +251,10 @@ and contain no OpenEmbedded copies. The build locks its work area (`/.lock`), each repository cell it deploys (`/rh/..lock`) and, while it publishes, the common repository (`/.common-publish.lock`). The per-arch runs of one build lock different -cells, so they run in parallel. A lock whose owner is dead is removed only on the -owner's host; from any other host the build waits `--try-unlock-timeout` seconds, -then fails with the `mv` command that moves the lock away. +cells, so they run in parallel. A lock whose owner is dead is taken over only on the +owner's host. From any other host the build waits `--try-unlock-timeout` seconds, +then fails with the command that removes the lock. The protocol is documented at the +top of `lib/XCAT/NFSLock.pm`. The build prepares the complete common repository in a temporary directory, then replaces the previous repository only after package verification, metadata diff --git a/lib/XCAT/NFSLock.pm b/lib/XCAT/NFSLock.pm index f8ea15d..c68a80a 100644 --- a/lib/XCAT/NFSLock.pm +++ b/lib/XCAT/NFSLock.pm @@ -1,140 +1,196 @@ package XCAT::NFSLock; -# A lock on a shared, possibly re-exported, NFS tree. +# NFS lock protocol # -# 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 +# 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 .borrow, beside lock.d +# R, T, δ the options retries, delay and jitter # # 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. +# 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. # -# 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. +# Metadata +# lock.d/metadata contains: +# machine-id, boot-id, pid, pstart, token, hash # -# 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. +# 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. # -# 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. +# 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. # -# 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. +# Retry +# R = max retries, T = base delay, δ = jitter +# R > 0, δ >= 0, T >= 3, T > 2δ # -# release(l) -# 1. If l's record is r, rename l away. +# Generic retry: +# if retries >= R: fail +# sleep(T + rand(-δ, δ)) +# retries++ +# goto 1 # -# dead(r) ⇔ r.host = this host -# ∧ (r.boot ≠ current boot ∨ r.pid does not exist ∨ start time of r.pid ≠ r.start) +# 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 # -# 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 +# 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 Errno qw(EEXIST ENOENT ENOTEMPTY ESTALE); +use Digest::SHA qw(sha256_hex); +use Errno qw(EEXIST ENOENT); 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); +our @EXPORT_OK = qw(this_process format_metadata parse_metadata owner_is_dead process_start); -my $FORMAT = 'nfslock2'; +my @IDENTITY = qw(machine-id boot-id pid pstart token); #-------------------------------------------------------------------------------- =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. + Take the lock at $path with steps 1 to 7 of the protocol. Arguments: - $path: path of the lock directory + $path: path of lock.d %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 + 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 when the wait ends, naming the owner and the mv - command that moves the lock away. The next acquire deletes a lock moved - to .dead.*. + A lock object. Dies after R retries, naming the lock and its owner. =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/; + 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 $self = bless { path => $abs, label => $label, pid => $$ }, $class; - $self->{record} = owner_record(); - my $deadline = Time::HiRes::time() + $timeout; - my $owner; + 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; - _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); + 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; - 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); + # 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(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"; + 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"; } #-------------------------------------------------------------------------------- @@ -142,9 +198,9 @@ sub acquire { =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. + 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: @@ -156,69 +212,116 @@ sub acquire { 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}); + 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 owner_record +=head3 this_process 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. + The ownership identity of this process with a fresh token. Arguments: none Returns: - The record string. + A hash ref with machine-id, boot-id, pid, pstart and token. =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()); +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 parse_owner +=head3 format_metadata Descriptions: - Split a record written by owner_record into its fields. + The content of lock.d/metadata: one "key=value" line per field, sorted + by key, and the hash line. Arguments: - $record: the content of an owner file + $fields: hash ref with machine-id, boot-id, pid, pstart and token Returns: - A hash ref of the fields, or undef when $record is not such a record. + The metadata string. =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; +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 (@lines) { - my ($key, $value) = split(/=/, $line, 2); - return undef unless defined($value); + 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; } - for my $key (qw(machine boot pid start)) { - return undef unless defined($field{$key}) && length($field{$key}); + 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{start} =~ /\A[0-9]+\z/; + 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; } @@ -227,14 +330,13 @@ sub parse_owner { =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. + 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_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 + $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. @@ -244,11 +346,11 @@ sub parse_owner { 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}; + 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->{start} ? 0 : 1; + return $start eq $owner->{pstart} ? 0 : 1; } #-------------------------------------------------------------------------------- @@ -278,103 +380,60 @@ sub process_start { 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; +sub _canonical { + my ($fields) = @_; + return join('', map { "$_=$fields->{$_}\n" } sort @IDENTITY); } -# 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 { +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) = @_; - 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; + open(my $fh, '<', "$path/metadata") or return undef; local $/; - my $record = <$fh>; + my $text = <$fh>; close($fh); - return $record; + 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 => _first_line('/etc/machine-id') // (hostname() || 'unknown'), - boot => _first_line('/proc/sys/kernel/random/boot_id') // 'unknown', + '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, }; } @@ -392,8 +451,7 @@ sub _first_line { 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))); + return sprintf('pid %s on machine %s', $owner->{pid}, $owner->{'machine-id'}); } # An absolute path in the message, without resolving the lock itself. diff --git a/mockbuild-all.pl b/mockbuild-all.pl index 4689046..f7957a2 100755 --- a/mockbuild-all.pl +++ b/mockbuild-all.pl @@ -1446,10 +1446,10 @@ Options: --output-root PATH Override the derived build tree root (default: /mockbuild-all) --repo-dep PATH Override the deployable output root; rh8/rh9/rh10/ and common are assembled and signed here (default: /xcat-dep) - --try-unlock-timeout N Wait up to N seconds (default 0) for a lock that a live - process holds, then fail with the command that removes it. - A lock whose owner is proven dead on this host is removed - at once. Locks: /.lock, one /rh/..lock + --try-unlock-timeout N Wait about N seconds (default 0: one retry of 3s) for a lock + that a live process holds, then fail with the command that + removes it. A lock whose owner is proven dead on this host + is taken over at once. Locks: /.lock, one /rh/..lock per target, and /.common-publish.lock for common --finalize-xcat-dep Post-build cross-arch genesis mode (builds nothing). Requires --x86_64-repo and --ppc64le-repo. For each matching /x86_64 and diff --git a/t/genesis_openembedded_consumer.t b/t/genesis_openembedded_consumer.t index e2a67f3..20b31d0 100644 --- a/t/genesis_openembedded_consumer.t +++ b/t/genesis_openembedded_consumer.t @@ -951,8 +951,9 @@ sub test_rpm_repository_lock { # The cell this target deploys is locked by a run on another machine. my $cell_lock = "$repository/rh10/.$arch.lock"; make_path($cell_lock); - write_binary("$cell_lock/owner", - "nfslock2\nmachine=another-machine\nboot=b\npid=1\nstart=1\ntoken=t\nhost=other\ncreated=1\n"); + write_binary("$cell_lock/metadata", + XCAT::NFSLock::format_metadata({ 'machine-id' => 'another-machine', 'boot-id' => 'b', + pid => 1, pstart => 1, token => 't' })); my @perl_lib; push(@perl_lib, write_forkmanager_stub("$tmp/perl-lock-stub")) @@ -974,7 +975,7 @@ sub test_rpm_repository_lock { '--skip-createrepo', '--skip-tarball', '--dry-run', ); isnt($status, 0, 'a repository cell cannot have two publishers'); - like(read_binary($log), qr/^Trying to unlock \Q$cell_lock\E failed after 0s;/m, + like(read_binary($log), qr/^Trying to unlock \Q$cell_lock\E failed after 1 retry;/m, 'the lock failure names the locked cell'); ok(-d $cell_lock, 'a lock held on another machine is left in place'); remove_tree($cell_lock); @@ -1009,8 +1010,9 @@ sub test_finalize_cell_lock { # A build on another machine is still deploying the x86_64 cell. my $cell_lock = "$x86/rh10/.x86_64.lock"; make_path($cell_lock); - write_binary("$cell_lock/owner", - "nfslock2\nmachine=another-machine\nboot=b\npid=1\nstart=1\ntoken=t\nhost=other\ncreated=1\n"); + write_binary("$cell_lock/metadata", + XCAT::NFSLock::format_metadata({ 'machine-id' => 'another-machine', 'boot-id' => 'b', + pid => 1, pstart => 1, token => 't' })); my $log = "$tmp/finalize-lock.log"; my $status = run_capture( @@ -1020,7 +1022,7 @@ sub test_finalize_cell_lock { '--finalize-xcat-dep', '--x86_64-repo', $x86, '--ppc64le-repo', $ppc, ); isnt($status, 0, 'finalize does not rewrite a cell that a build holds'); - like(read_binary($log), qr/^Trying to unlock \Q$cell_lock\E failed after 0s;/m, + like(read_binary($log), qr/^Trying to unlock \Q$cell_lock\E failed after 1 retry;/m, 'finalize names the cell lock it waited for'); ok(-d $cell_lock, 'the build keeps its cell lock'); ok(!-e "$ppc/rh10/.ppc64le.lock", 'finalize releases the cell locks it took'); @@ -1088,7 +1090,7 @@ sub test_publish_lock { my $run_log = "$tmp/deb-run-locked.log"; my $run_status = run_apt_consumer(log => $run_log, output => $output, apt_dir => $apt_root); isnt($run_status, 0, 'a second amd64 run does not start beside a live one'); - like(read_binary($run_log), qr/^Trying to unlock \Q$run_lock\E failed after 0s;/m, + like(read_binary($run_log), qr/^Trying to unlock \Q$run_lock\E failed after 1 retry;/m, 'the refusal names the run lock'); $running->release; } @@ -1103,7 +1105,7 @@ sub test_publish_lock { extra => [ '--publish-lock-wait', '2' ], ); isnt($locked_status, 0, 'a locked apt tree is not published into'); - like(read_binary($locked_log), qr/^Trying to unlock \Q$lockfile\E failed after 2s;/m, + like(read_binary($locked_log), qr/^Trying to unlock \Q$lockfile\E failed after 1 retry;/m, 'the refusal names the lock another run owns'); ok(!-d "$apt_root/dists", 'nothing is published while another run holds the lock'); diff --git a/t/nfslock.t b/t/nfslock.t index a1d6f16..67ff32d 100644 --- a/t/nfslock.t +++ b/t/nfslock.t @@ -1,6 +1,5 @@ #!/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. +# XCAT::NFSLock: the NFS lock protocol at the top of lib/XCAT/NFSLock.pm. use strict; use warnings; use Test::More; @@ -8,33 +7,25 @@ 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; +my $renames = 0; +my @mkdirs; 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); - }; + *CORE::GLOBAL::rename = sub { $renames++; return CORE::rename($_[0], $_[1]) }; + *CORE::GLOBAL::mkdir = sub { push(@mkdirs, $_[0]); return @_ > 1 ? CORE::mkdir($_[0], $_[1]) : CORE::mkdir($_[0]) }; } -use XCAT::NFSLock qw(owner_record parse_owner owner_is_dead process_start); +use XCAT::NFSLock qw(this_process format_metadata parse_metadata 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'); +my $me = this_process(); +is($me->{pid}, $$, 'the identity names this process'); +is($me->{pstart}, process_start($$), 'the identity carries the start time of this process'); +isnt(this_process()->{token}, $me->{token}, 'each identity has a fresh token'); # No process can have a pid above the kernel's pid_max (2**22 at most). my $gone = 2**22 + 7; @@ -43,34 +34,49 @@ 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 { +sub metadata { 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)); + return format_metadata({ %$me, token => 'ab' x 16, %f }); } sub stage { - my ($name, $record) = @_; + my ($name, $text) = @_; my $path = "$dir/$name"; mkdir($path) or die "Cannot stage $path: $!"; - write_text("$path/owner", $record) if defined($record); + write_text("$path/metadata", $text) if defined($text); return $path; } -sub leftovers { - my ($path) = @_; - return [ map { s{\A\Q$dir\E/}{}r } glob("$path.*") ]; +# Record the waits instead of sleeping. $on_sleep runs at each wait. +my @slept; +our $on_sleep; +{ + no warnings 'redefine'; + *XCAT::NFSLock::_sleep = sub { push(@slept, $_[0]); $on_sleep->() if $on_sleep }; } -# A free lock is taken with its metadata and released without leftovers. +# Metadata: fields, hash, validation. +{ + my $text = metadata(); + is_deeply(parse_metadata($text), { %$me, token => 'ab' x 16 }, 'valid metadata parses to its identity'); + like($text, qr/\Aboot-id=.*\nmachine-id=.*\npid=.*\npstart=.*\ntoken=.*\nhash=[0-9a-f]{64}\n\z/, + 'the fields are sorted and the hash comes last'); + is(parse_metadata(substr($text, 0, length($text) - 10)), undef, 'a partial read is invalid'); + is(parse_metadata($text =~ s/pid=\d+/pid=1/r), undef, 'a changed field no longer matches the hash'); + is(parse_metadata($text =~ s/^token=.*\n//mr), undef, 'a missing field is invalid'); + is(parse_metadata("extra=1\n$text"), undef, 'an unknown field is invalid'); + is(parse_metadata(undef), undef, 'missing metadata is invalid'); +} + +# A free lock is taken 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'); + my $lock = XCAT::NFSLock->acquire($path); + my $meta = parse_metadata(read_text("$path/metadata")); + is($meta && $meta->{pid}, $$, 'a free lock is taken with the identity of this process'); 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'); + ok(!-e $path, 'the released lock.d is gone'); + ok(!-e "$path.borrow", 'release removes lock.borrow'); is($lock->release, 0, 'a second release does nothing'); } @@ -79,10 +85,153 @@ for my $bad ('', "$dir/.", "$dir/..", "$dir/") { 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"); +for my $case ( + [ { retries => 0 }, qr/\AInvalid retries 0 for lock/ ], + [ { retries => 1.5 }, qr/\AInvalid retries 1\.5 for lock/ ], + [ { delay => 2.9 }, qr/\AInvalid delay 2\.9 for lock: must be 3s or more/ ], + [ { jitter => -1 }, qr/\AInvalid jitter -1 for lock: must be 0 or more/ ], + [ { delay => 3, jitter => 1.5 }, qr/\AInvalid jitter 1\.5 for lock: must be less than half the delay/ ], + ) +{ + my ($opt, $error) = @$case; + eval { XCAT::NFSLock->acquire("$dir/bad-option.lock", %$opt); 1 }; + like($@, $error, 'an invalid retry option is refused: ' . join(',', %$opt)); + ok(!-e "$dir/bad-option.lock", 'an invalid option creates no lock'); +} + +# Retry: R waits of T ± δ, then an error that names the lock. +{ + my $path = stage('retried.lock', metadata(pid => $parent, pstart => $parent_start)); + @slept = (); + eval { XCAT::NFSLock->acquire($path, retries => 4, delay => 5, jitter => 2, label => 'cell lock'); 1 }; + like($@, qr/\ATrying to unlock \Q$path\E failed after 4 retries; cell lock owned by pid $parent on machine /, + 'the error names the lock, the retries and the owner'); + is(scalar(@slept), 4, 'acquire waits R times'); + is(scalar(grep { $_ >= 3 && $_ <= 7 } @slept), 4, 'each wait is within T ± δ'); + + @slept = (); + eval { XCAT::NFSLock->acquire($path, timeout => 10); 1 }; + like($@, qr/failed after 4 retries;/, 'a timeout of 10s with the default delay of 3s is 4 retries'); + @slept = (); + eval { XCAT::NFSLock->acquire($path); 1 }; + like($@, qr/failed after 1 retry;/, 'a lock with no timeout still retries once'); +} + +# The lock stays with an owner that is not proven dead. +for my $case ( + [ 'live owner on this machine', metadata(pid => $parent, pstart => $parent_start) ], + [ 'owner on another machine', metadata('machine-id' => 'elsewhere', pid => $gone) ], + [ 'partial metadata', substr(metadata(pid => $gone), 0, 40) ], + [ 'metadata with a bad hash', metadata(pid => $gone) =~ s/hash=(.)/'hash=' . ($1 eq '0' ? '1' : '0')/er ], + [ 'no metadata', undef ], + ) +{ + my ($name, $text) = @$case; + (my $file = "$name.lock") =~ s/\s+/-/g; + my $path = stage($file, $text); + @mkdirs = (); + eval { XCAT::NFSLock->acquire($path, retries => 2); 1 }; + like($@, qr/\ATrying to unlock \Q$path\E failed after 2 retries;/, "$name: the lock is not taken"); + is(scalar(grep { $_ eq "$path.borrow" } @mkdirs), $name =~ /live owner/ ? 3 : 0, + "$name: lock.borrow is tried only for an owner on this machine with valid metadata"); + is(-e "$path/metadata" ? read_text("$path/metadata") : undef, $text, "$name: the metadata is unchanged"); + ok(!-e "$path.borrow", "$name: lock.borrow is not left behind"); +} + +# A dead owner on this machine loses the lock. +for my $case ( + [ 'process gone', metadata(pid => $gone) ], + [ 'pid reused', metadata(pid => $parent, pstart => $parent_start + 1) ], + [ 'machine rebooted', metadata('boot-id' => 'an-earlier-boot', pid => $parent, pstart => $parent_start) ], + ) +{ + my ($name, $text) = @$case; + (my $file = "$name.lock") =~ s/\s+/-/g; + my $path = stage($file, $text); + @slept = (); + my $lock = eval { XCAT::NFSLock->acquire($path) }; + ok($lock, "$name: the lock of a dead owner is taken") or diag($@); + is(scalar(@slept), 0, "$name: the lock is taken without a wait"); + my $meta = parse_metadata(read_text("$path/metadata")); + is($meta && $meta->{pid}, $$, "$name: the metadata now names this process"); + isnt($meta && $meta->{token}, 'ab' x 16, "$name: the new metadata has a fresh token"); + ok(!-e "$path.borrow", "$name: lock.borrow is removed"); + is($lock->release, 1, "$name: the new owner releases the lock") if $lock; +} + +# Another process holds lock.borrow: this one does not take the lock. +{ + my $dead = metadata(pid => $gone); + my $path = stage('borrowed.lock', $dead); + mkdir("$path.borrow") or die "Cannot stage $path.borrow: $!"; + eval { XCAT::NFSLock->acquire($path, retries => 2); 1 }; + like($@, qr/\ATrying to unlock /, 'a lock under another borrower is not taken'); + is(read_text("$path/metadata"), $dead, 'the metadata under another borrower is unchanged'); + ok(-d "$path.borrow", 'the other borrower keeps lock.borrow'); +} + +# The owner changed between step 2 and step 4: this attempt does not take the lock, +# even when the new owner is dead too. +{ + my $path = stage('changed.lock', metadata(pid => $gone)); + my $other = metadata(pid => $gone, token => 'cd' x 16); + my $read = \&XCAT::NFSLock::_read_metadata; + my $reads = 0; + no warnings 'redefine'; + local *XCAT::NFSLock::_read_metadata = sub { + write_text("$path/metadata", $other) if ++$reads == 2; + return $read->(@_); + }; + @slept = (); + my $lock = eval { XCAT::NFSLock->acquire($path, retries => 1) }; + ok($lock, 'the lock is taken on the next attempt') or diag($@); + is(scalar(@slept), 1, 'a changed owner costs one retry'); + ok(!-e "$path.borrow", 'lock.borrow is removed'); + $lock->release if $lock; +} + +# release waits for a process that holds lock.borrow. +{ + my $path = "$dir/release-borrowed.lock"; + my $lock = XCAT::NFSLock->acquire($path); + mkdir("$path.borrow") or die "Cannot stage $path.borrow: $!"; + @slept = (); + local $on_sleep = sub { rmdir("$path.borrow") }; + is($lock->release, 1, 'release removes the lock once lock.borrow is free'); + is(scalar(@slept), 1, 'release waits while lock.borrow is held'); + ok(!-e $path && !-e "$path.borrow", 'lock.d and lock.borrow are gone'); +} + +# 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'); +} + +# The metadata names another acquisition: release leaves the lock alone. +{ + my $path = "$dir/replaced.lock"; + my $lock = XCAT::NFSLock->acquire($path); + my $other = metadata(pid => $parent, pstart => $parent_start); + write_text("$path/metadata", $other); + is($lock->release, 0, 'release does not remove a lock of another acquisition'); + is(read_text("$path/metadata"), $other, 'the other owner keeps its lock'); + ok(!-e "$path.borrow", 'release removes lock.borrow'); +} + +# 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'); } # A waiter takes the lock once its live owner releases it. @@ -100,182 +249,25 @@ for my $retry (0, 0.5, -1) { } 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); + local $on_sleep = sub { waitpid($child, 0) }; + my $lock = eval { XCAT::NFSLock->acquire($path, retries => 1) }; 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, + my %here = ('machine-id' => 'm1', 'boot-id' => 'b1', start_of => sub { $_[0] == 10 ? 100 : undef }); + my %rec = ('machine-id' => 'm1', 'boot-id' => 'b1', pid => 10, pstart => 100); + is(owner_is_dead(undef, \%here), 0, 'invalid metadata is not proven dead'); + is(owner_is_dead({%rec}, \%here), 0, 'a live owner is not dead'); + is(owner_is_dead({ %rec, 'machine-id' => '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, 'boot-id' => '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(owner_is_dead({ %rec, pstart => 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'); +is($renames, 0, 'the lock never renames'); done_testing(); diff --git a/t/repo-lock-race.t b/t/repo-lock-race.t index 548174b..8a1e63e 100644 --- a/t/repo-lock-race.t +++ b/t/repo-lock-race.t @@ -11,9 +11,9 @@ use File::Temp qw(tempdir); use File::Path qw(make_path); use File::Slurper qw(read_text write_text); use MockBuildUtils qw(recover_common_repository); -use XCAT::NFSLock qw(owner_record parse_owner process_start); +use XCAT::NFSLock qw(this_process format_metadata process_start); -my $me = parse_owner(owner_record()); +my $me = this_process(); # No process can have a pid above the kernel's pid_max (2**22 at most). my $gone = 2**22 + 7; @@ -21,9 +21,7 @@ my $parent = getppid(); 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)); + return format_metadata({ %$me, %f }); } # A repository left by an interrupted publication: common/ moved aside, a staging tree beside it. @@ -34,7 +32,7 @@ sub interrupted { write_text("$base/.common.previous.999/marker", "previous repository\n"); if (defined($holder)) { make_path("$base/.common-publish.lock"); - write_text("$base/.common-publish.lock/owner", $holder); + write_text("$base/.common-publish.lock/metadata", $holder); } return $base; } @@ -48,8 +46,8 @@ sub interrupted { } for my $case ( - [ 'a live run on this host', record(pid => $parent, start => process_start($parent)) ], - [ 'a run on another host', record(machine => 'elsewhere', pid => $gone) ], + [ 'a live run on this host', record(pid => $parent, pstart => process_start($parent)) ], + [ 'a run on another host', record('machine-id' => 'elsewhere', pid => $gone) ], ) { my ($name, $holder) = @$case; @@ -63,7 +61,7 @@ for my $case ( "the skip names the lock $name holds"); ok(-d "$base/.common.staging", "the staging tree of $name is left in place"); ok(!-e "$base/common", "the common tree stays where $name put it"); - is(read_text("$base/.common-publish.lock/owner"), $holder, "$name keeps the common lock"); + is(read_text("$base/.common-publish.lock/metadata"), $holder, "$name keeps the common lock"); } {