1# Non-Blocking Exclusive Lock Scope Test 2# 3# This tests to make sure a failed lock leaving 4# scope does not unlock a lock of someone else. 5# 6# Exploits the conditions found by Andy Hird (andyh@myinternet.com.au) 7# Here are his comments: 8# 9# If a process has some file locked (say exclusively although it doesn't matter) and another process attempts to get a lock, if it fails it deletes the lock file - whether or not the first (locking process) has finished with its lock. This means any subsequent process that comes along that attempts to lock the file succeeds - even if the first process thinks it still has a lock. 10# 11 12use Test; 13use File::NFSLock; 14use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); 15 16$| = 1; # Buffer must be autoflushed because of fork() below. 17plan tests => 11; 18 19my $datafile = "testfile.dat"; 20 21# Create a blank file 22sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); 23close (FH); 24ok (-e $datafile && !-s _); 25 26 27ok (pipe(RD1,WR1)); # Connected pipe for child1 28if (!fork) { 29 # Child #1 process 30 my $lock = new File::NFSLock { 31 file => $datafile, 32 lock_type => LOCK_EX | LOCK_NB, 33 }; 34 print WR1 !!$lock; # Send boolean success status down pipe 35 close(WR1); # Signal to parent that the Non-Blocking lock is done 36 close(RD1); 37 if ($lock) { 38 sleep 2; # hold the lock for a moment 39 sysopen(FH, $datafile, O_RDWR); 40 # now put a magic word into the file 41 print FH "child1\n"; 42 close FH; 43 } 44 exit; 45} 46ok 1; # Fork successful 47close (WR1); 48# Waiting for child1 to finish its lock status 49my $child1_lock = <RD1>; 50close (RD1); 51# Report status of the child1_lock. 52# It should have been successful 53ok ($child1_lock); 54 55 56ok (pipe(RD2,WR2)); # Connected pipe for child2 57if (!fork) { 58 # Child #2 process 59 my $lock = new File::NFSLock { 60 file => $datafile, 61 lock_type => LOCK_EX | LOCK_NB, 62 }; 63 print WR2 !!$lock; # Send boolean success status down pipe 64 close(WR2); # Signal to parent that the Non-Blocking lock is done 65 close(RD2); 66 if ($lock) { 67 sysopen(FH, $datafile, O_RDWR); 68 # now put a magic word into the file 69 print FH "child2\n"; 70 close FH; 71 } 72 exit; 73} 74ok 1; # Fork successful 75close (WR2); 76# Waiting for child2 to finish its lock status 77my $child2_lock = <RD2>; 78close (RD2); 79# Report status of the child2_lock. 80# This lock should not have been obtained since 81# the child1 lock should still have been established. 82ok (!$child2_lock); 83 84ok (pipe(RD3,WR3)); # Connected pipe for child3 85if (!fork) { 86 # Child #3 process 87 my $lock = new File::NFSLock { 88 file => $datafile, 89 lock_type => LOCK_EX | LOCK_NB, 90 }; 91 print WR3 !!$lock; # Send boolean success status down pipe 92 close(WR3); # Signal to parent that the Non-Blocking lock is done 93 close(RD3); 94 if ($lock) { 95 sysopen(FH, $datafile, O_RDWR); 96 # now put a magic word into the file 97 print FH "child3\n"; 98 close FH; 99 } 100 exit; 101} 102ok 1; # Fork successful 103close (WR3); 104# Waiting for child2 to finish its lock status 105my $child3_lock = <RD3>; 106close (RD3); 107# Report status of the child3_lock. 108# This lock should also fail since the child1 109# lock should still have been established. 110ok (!$child3_lock); 111 112# Wait until the children have finished. 113wait; wait; wait; 114 115# Load up whatever the file says now 116sysopen(FH, $datafile, O_RDONLY); 117$_ = <FH>; 118close FH; 119 120# It should be child1 if it was really nonblocking 121# since it got the lock first. 122ok /child1/; 123 124# Wipe the temporary file 125unlink $datafile; 126