1# Blocking Shared Lock Test 2 3use Test; 4use File::NFSLock; 5use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_NB LOCK_SH); 6 7# $m simultaneous processes trying to obtain a shared lock 8my $m = 20; 9my $shared_delay = 5; 10 11$| = 1; # Buffer must be autoflushed because of fork() below. 12plan tests => (13 + 3*$m); 13 14my $datafile = "testfile.dat"; 15 16# Create a blank file 17sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); 18close (FH); 19# test 1 20ok (-e $datafile && !-s _); 21 22 23# test 2 24ok (pipe(RD1,WR1)); # Connected pipe for child1 25if (!fork) { 26 # Child #1 process 27 # Obtain exclusive lock to block the shared attempt later 28 my $lock = new File::NFSLock { 29 file => $datafile, 30 lock_type => LOCK_EX, 31 }; 32 print WR1 !!$lock; # Send boolean success status down pipe 33 close(WR1); # Signal to parent that the Blocking lock is done 34 close(RD1); 35 if ($lock) { 36 sleep 2; # hold the lock for a moment 37 sysopen(FH, $datafile, O_RDWR | O_TRUNC); 38 # And then put a magic word into the file 39 print FH "exclusive\n"; 40 close FH; 41 } 42 exit; 43} 44# test 3 45ok 1; # Fork successful 46close (WR1); 47# Waiting for child1 to finish its lock status 48my $child1_lock = <RD1>; 49close (RD1); 50# Report status of the child1_lock. 51# It should have been successful 52# test 4 53ok ($child1_lock); 54 55 56# test 5 57ok (pipe(RD2,WR2)); # Connected pipe for child2 58if (!fork) { 59 # This should block until the exclusive lock is done 60 my $lock = new File::NFSLock { 61 file => $datafile, 62 lock_type => LOCK_SH, 63 }; 64 if ($lock) { 65 sysopen(FH, $datafile, O_RDWR | O_TRUNC); 66 # Immediately put the magic word into the file 67 print FH "shared\n"; 68 truncate (FH, tell FH); 69 close FH; 70 # Normally shared locks never modify the contents because 71 # of the race condition. (The last one to write wins.) 72 # But in this case, the parent will wait until the lock 73 # status is reported (close RD2) so it defines execution 74 # sequence will be correct. Hopefully the shared lock 75 # will not happen until the exclusive lock has been released. 76 # This is also a good test to make sure that other shared 77 # locks can still be obtained simultaneously. 78 } 79 print WR2 !!$lock; # Send boolean success status down pipe 80 close(WR2); # Signal to parent that the Blocking lock is done 81 close(RD2); 82 # Then hold this shared lock for a moment 83 # while other shared locks are attempted 84 sleep($shared_delay*2); 85 exit; # Release the shared lock 86} 87# test 6 88ok 1; # Fork successful 89close (WR2); 90# Waiting for child2 to finish its lock status 91my $child2_lock = <RD2>; 92close (RD2); 93# Report status of the child2_lock. 94# This should have eventually been successful. 95# test 7 96ok ($child2_lock); 97 98# If all these processes take longer than $shared_delay seconds, 99# then they are probably not running synronously 100# and the shared lock is not working correctly. 101# But if all the children obatin the lock simultaneously, 102# like they're supposed to, then it shouldn't take 103# much longer than the maximum delay of any of the 104# shared locks (at least 5 seconds set above). 105$SIG{ALRM} = sub { 106 # test (unknown) 107 ok 0; 108 die "Shared locks not running simultaneously"; 109}; 110 111# Use pipe to read lock success status from children 112# test 8 113ok (pipe(RD3,WR3)); 114 115# Wait a few seconds less than if all locks were 116# aquired asyncronously to ensure that they overlap. 117alarm($m*$shared_delay-2); 118 119for (my $i = 0; $i < $m ; $i++) { 120 if (!fork) { 121 # All of these locks should immediately be successful since 122 # there already exist a shared lock. 123 my $lock = new File::NFSLock { 124 file => $datafile, 125 lock_type => LOCK_SH, 126 }; 127 # Send boolean success status down pipe 128 print WR3 !!$lock,"\n"; 129 close(WR3); 130 if ($lock) { 131 sleep $shared_delay; # Hold the shared lock for a moment 132 # Appending should always be safe across NFS 133 sysopen(FH, $datafile, O_RDWR | O_APPEND); 134 # Put one line to signal the lock was successful. 135 print FH "1\n"; 136 close FH; 137 $lock->unlock(); 138 } else { 139 warn "Lock [$i] failed!"; 140 } 141 exit; 142 } 143} 144 145# Parent process never writes to pipe 146close(WR3); 147 148 149# There were $m children attempting the shared locks. 150for (my $i = 0; $i < $m ; $i++) { 151 # Report status of each lock attempt. 152 my $got_shared_lock = <RD3>; 153 # test 9 .. 8+$m 154 ok $got_shared_lock; 155} 156 157# There should not be anything left in the pipe. 158my $extra = <RD3>; 159# test 9 + $m 160ok !$extra; 161close (RD3); 162 163# If we made it here, then it must have been faster 164# than the timeout. So reset the timer. 165alarm(0); 166# test 10 + $m 167ok 1; 168 169# There are $m children plus the child1 exclusive locker 170# and the child2 obtaining the first shared lock. 171for (my $i = 0; $i < $m + 2 ; $i++) { 172 # Wait until all the children are finished. 173 wait; 174 # test 11+$m .. 12+2*$m 175 ok 1; 176} 177 178# Load up whatever the file says now 179sysopen(FH, $datafile, O_RDONLY); 180 181# The first line should say "shared" if child2 really 182# waited for child1's exclusive lock to finish. 183$_ = <FH>; 184# test 13 + 2*$m 185ok /shared/; 186 187for (my $i = 0; $i < $m ; $i++) { 188 $_ = <FH>; 189 chomp; 190 # test 14+2*$m .. 13+3*$m 191 ok $_, 1; 192} 193close FH; 194 195# Wipe the temporary file 196unlink $datafile; 197