# Blocking Shared Lock Test use strict; use warnings; use Test::More; if( $^O eq 'MSWin32' ) { plan skip_all => 'Tests fail on Win32 due to forking'; } else { plan tests => 13+3*20; } 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. my $datafile = "testfile.dat"; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); close ($fh); # test 1 ok (-e $datafile && !-s _); my ($rd1, $wr1); 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(my $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); my ($rd2, $wr2); 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(my $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 my ($rd3, $wr3); 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(my $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(my $fh2, $datafile, O_RDONLY); # The first line should say "shared" if child2 really # waited for child1's exclusive lock to finish. $_ = <$fh2>; # test 13 + 2*$m ok /shared/; for (my $i = 0; $i < $m ; $i++) { $_ = <$fh2>; chomp; # test 14+2*$m .. 13+3*$m is $_, 1; } close $fh2; # Wipe the temporary file unlink $datafile;