1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
# Non-Blocking Exclusive Lock Scope Test
#
# This tests to make sure a failed lock leaving
# scope does not unlock a lock of someone else.
#
# Exploits the conditions found by Andy Hird (andyh@myinternet.com.au)
# Here are his comments:
#
# 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.
#
use strict;
use warnings;
use File::Temp qw(tempfile);
use Test::More;
if( $^O eq 'MSWin32' ) {
plan skip_all => 'Tests fail on Win32 due to forking';
}
else {
plan tests => 11;
}
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB);
$| = 1; # Buffer must be autoflushed because of fork() below.
my $datafile = (tempfile 'XXXXXXXXXX')[1];
# Create a blank file
sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
close ($fh);
ok (-e $datafile && !-s _);
my ($rd1, $wr1);
ok (pipe($rd1, $wr1)); # Connected pipe for child1
if (!fork) {
# Child #1 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
print $wr1 !!$lock; # Send boolean success status down pipe
close($wr1); # Signal to parent that the Non-Blocking lock is done
close($rd1);
if ($lock) {
sleep 2; # hold the lock for a moment
sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
print $fh "child1\n";
close $fh;
}
exit;
}
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
ok ($child1_lock);
my ($rd2, $wr2);
ok (pipe($rd2, $wr2)); # Connected pipe for child2
if (!fork) {
# Child #2 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
print $wr2 !!$lock; # Send boolean success status down pipe
close($wr2); # Signal to parent that the Non-Blocking lock is done
close($rd2);
if ($lock) {
sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
print $fh "child2\n";
close $fh;
}
exit;
}
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 lock should not have been obtained since
# the child1 lock should still have been established.
ok (!$child2_lock);
my ($rd3, $wr3);
ok (pipe($rd3, $wr3)); # Connected pipe for child3
if (!fork) {
# Child #3 process
my $lock = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX | LOCK_NB,
};
print $wr3 !!$lock; # Send boolean success status down pipe
close($wr3); # Signal to parent that the Non-Blocking lock is done
close($wr3);
if ($lock) {
sysopen(my $fh, $datafile, O_RDWR);
# now put a magic word into the file
print $fh "child3\n";
close $fh;
}
exit;
}
ok 1; # Fork successful
close ($wr3);
# Waiting for child2 to finish its lock status
my $child3_lock = <$rd3>;
close ($rd3);
# Report status of the child3_lock.
# This lock should also fail since the child1
# lock should still have been established.
ok (!$child3_lock);
# Wait until the children have finished.
wait; wait; wait;
# Load up whatever the file says now
sysopen(my $fh2, $datafile, O_RDONLY);
$_ = <$fh2>;
close $fh2;
# It should be child1 if it was really nonblocking
# since it got the lock first.
ok /child1/;
# Wipe the temporary file
unlink $datafile;
|
