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