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