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
|
# Shared Fork Test
#
# This tests the capabilities of fork after lock to
# ensure parent retains shared lock even if child releases it.
use strict;
use warnings;
use File::Temp qw(tempfile);
use Test::More tests => 6;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB);
$| = 1; # Buffer must be autoflushed because of fork() below.
my $datafile = (tempfile 'XXXXXXXXXX')[1];
# Wipe lock file in case it exists
unlink ("$datafile$File::NFSLock::LOCK_EXTENSION");
# Create a blank file
sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
close ($fh);
ok (-e $datafile && !-s _);
pipe(my $dad_rd, my $dad_wr);
{
# Forced dummy scope
my $lock1 = new File::NFSLock {
file => $datafile,
lock_type => LOCK_SH,
};
ok ($lock1);
my $pid = fork;
if (!defined $pid) {
die "fork failed!";
} elsif (!$pid) {
# Child process
# Fork worked
ok 1;
# Let go of the other side $dad_rd
close $dad_wr;
# Test possible race condition
# by making parent reach newpid()
# and attempt relock before child
# even calls newpid() the first time.
sleep 2;
$lock1->newpid;
# Child continues on while parent holds onto the lock...
} else {
# Parent process
# Notify lock that we've forked.
$lock1->newpid;
# Parent hangs onto the lock for a bit
sleep 5;
# Parent finally releases the lock
undef $lock1;
# And releases $dad_rd to signal the child
# that's the lock should be free.
close $dad_wr;
# Clear the Child Zombie
wait;
# Avoid normal "exit" checking plan counts.
require POSIX;
POSIX::_exit(0);
# Don't continue on since the child should have already done the tests.
}
}
# Lock is out of scope, but should
# still be acquired by the parent.
# Try to get a non-blocking lock.
# Quickly, before the parent releases it.
# This lock should fail.
{
# Forced dummy scope
my $lock2 = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX|LOCK_NB,
};
ok (!$lock2);
}
# Wait for the parent process to release the lock
scalar <$dad_rd>;
ok(1);
# Try again now that the parent is done.
# This time it should work.
{
# Forced dummy scope
my $lock2 = new File::NFSLock {
file => $datafile,
lock_type => LOCK_EX|LOCK_NB,
};
ok($lock2);
}
# Wipe the temporary file
unlink $datafile;
|
