# Blocking Shared Lock Test
use Test;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_NB LOCK_SH);
# $m simultaneous processes trying to obtain a shared lock
my $m = 20;
my $shared_delay = 5;
$| = 1; # Buffer must be autoflushed because of fork() below.
plan tests => (13 + 3*$m);
my $datafile = "testfile.dat";
# Create a blank file
sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC );
close (FH);
# test 1
ok (-e $datafile && !-s _);
# test 2
ok (pipe(RD1,WR1)); # Connected pipe for child1
if (!fork) {
# Child #1 process
# Obtain exclusive lock to block the shared attempt later
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX,
};
print WR1 !!$lock; # Send boolean success status down pipe
close(WR1); # Signal to parent that the Blocking lock is done
close(RD1);
if ($lock) {
sleep 2; # hold the lock for a moment
sysopen(FH, $datafile, O_RDWR | O_TRUNC);
# And then put a magic word into the file
print FH "exclusive\n";
close FH;
}
exit;
}
# test 3
ok 1; # Fork successful
close (WR1);
# Waiting for child1 to finish its lock status
my $child1_lock = <RD1>;
close (RD1);
# Report status of the child1_lock.
# It should have been successful
# test 4
ok ($child1_lock);
# test 5
ok (pipe(RD2,WR2)); # Connected pipe for child2
if (!fork) {
# This should block until the exclusive lock is done
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_SH,
};
if ($lock) {
sysopen(FH, $datafile, O_RDWR | O_TRUNC);
# Immediately put the magic word into the file
print FH "shared\n";
truncate (FH, tell FH);
close FH;
# Normally shared locks never modify the contents because
# of the race condition. (The last one to write wins.)
# But in this case, the parent will wait until the lock
# status is reported (close RD2) so it defines execution
# sequence will be correct. Hopefully the shared lock
# will not happen until the exclusive lock has been released.
# This is also a good test to make sure that other shared
# locks can still be obtained simultaneously.
}
print WR2 !!$lock; # Send boolean success status down pipe
close(WR2); # Signal to parent that the Blocking lock is done
close(RD2);
# Then hold this shared lock for a moment
# while other shared locks are attempted
sleep($shared_delay*2);
exit; # Release the shared lock
}
# test 6
ok 1; # Fork successful
close (WR2);
# Waiting for child2 to finish its lock status
my $child2_lock = <RD2>;
close (RD2);
# Report status of the child2_lock.
# This should have eventually been successful.
# test 7
ok ($child2_lock);
# If all these processes take longer than $shared_delay seconds,
# then they are probably not running synronously
# and the shared lock is not working correctly.
# But if all the children obatin the lock simultaneously,
# like they're supposed to, then it shouldn't take
# much longer than the maximum delay of any of the
# shared locks (at least 5 seconds set above).
$SIG{ALRM} = sub {
# test (unknown)
ok 0;
die "Shared locks not running simultaneously";
};
# Use pipe to read lock success status from children
# test 8
ok (pipe(RD3,WR3));
# Wait a few seconds less than if all locks were
# aquired asyncronously to ensure that they overlap.
alarm($m*$shared_delay-2);
for (my $i = 0; $i < $m ; $i++) {
if (!fork) {
# All of these locks should immediately be successful since
# there already exist a shared lock.
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_SH,
};
# Send boolean success status down pipe
print WR3 !!$lock,"\n";
close(WR3);
if ($lock) {
sleep $shared_delay; # Hold the shared lock for a moment
# Appending should always be safe across NFS
sysopen(FH, $datafile, O_RDWR | O_APPEND);
# Put one line to signal the lock was successful.
print FH "1\n";
close FH;
$lock->unlock();
} else {
warn "Lock [$i] failed!";
}
exit;
}
}
# Parent process never writes to pipe
close(WR3);
# There were $m children attempting the shared locks.
for (my $i = 0; $i < $m ; $i++) {
# Report status of each lock attempt.
my $got_shared_lock = <RD3>;
# test 9 .. 8+$m
ok $got_shared_lock;
}
# There should not be anything left in the pipe.
my $extra = <RD3>;
# test 9 + $m
ok !$extra;
close (RD3);
# If we made it here, then it must have been faster
# than the timeout. So reset the timer.
alarm(0);
# test 10 + $m
ok 1;
# There are $m children plus the child1 exclusive locker
# and the child2 obtaining the first shared lock.
for (my $i = 0; $i < $m + 2 ; $i++) {
# Wait until all the children are finished.
wait;
# test 11+$m .. 12+2*$m
ok 1;
}
# Load up whatever the file says now
sysopen(FH, $datafile, O_RDONLY);
# The first line should say "shared" if child2 really
# waited for child1's exclusive lock to finish.
$_ = <FH>;
# test 13 + 2*$m
ok /shared/;
for (my $i = 0; $i < $m ; $i++) {
$_ = <FH>;
chomp;
# test 14+2*$m .. 13+3*$m
ok $_, 1;
}
close FH;
# Wipe the temporary file
unlink $datafile;