Project

General

Profile

Bug #4484 ยป lockfile.pl

Youzhong Yang, 2014-01-15 07:53 PM

 
1
use POSIX ":sys_wait_h";
2
use Fcntl qw(:DEFAULT :flock O_RDONLY O_WRONLY O_APPEND O_CREAT LOCK_EX);
3

    
4
my $code = 0;
5
our $OK                      =   $code++;
6
our $FATAL_ERROR             =   $code++;
7
our $ARGS_ERROR              =  $code++;
8
our $PROCESS_RUNNING = $code++;
9
our $PROCESS_TERMINATED = $code++;
10
our $PROCESS_TIMEDOUT = $code++;
11
our $PROCESS_UNKNOWN = $code++;
12

    
13
# Purpose: fork and execute a procedure
14
# Input: 
15
#       1. ref to a scalar variable to return pid of the forked child process
16
#       2. ref to procedure 
17
#       3. args to the procedure 
18
# Output: status code 
19
sub forkToExecute
20
{
21
	my ( $refPid, $refProcedure, @args ) = @_;
22
	my $pid;
23

    
24
	if(!defined($refPid) || !defined($refProcedure) || ref($refPid) ne 'SCALAR' || ref($refProcedure) ne 'CODE')
25
	{
26
		printf("ERROR: Wrong arguments (pid %d line %d of %s in %s)\n",
27
			$$,__LINE__,__FILE__,(caller(0))[3]);		
28
		return $ARGS_ERROR;
29
	}
30
	$| = 1;
31
	FORK: {
32
		if ( $pid = fork() ) {
33
			# child process pid is available in $pid
34
			print "INFO: Successfully forked $pid\n";
35
			$$refPid = $pid;
36
			return $OK;
37
		}
38
		elsif ( defined $pid ) {
39
			# $pid is zero 
40
			# execute procedure
41
			&$refProcedure (@args);
42
			# child must go
43
			exit;
44
		}
45
		else {
46
			# fork error
47
			my $errMsg = $!;
48
			printf("ERROR: Cannot fork [%s] (pid %d line %d of %s in %s)\n",
49
				$errMsg, $$,__LINE__,__FILE__,(caller(0))[3]);
50
			$$refPid = undef;
51
			return $FATAL_ERROR;
52
		}
53
  	}		
54
}
55

    
56
#
57
# Purpose: get status of forked process
58
#
59
# Input:
60
#        1. pid
61
#        2. start time of the process(seconds returned by time function)
62
#        3. timeout seconds
63
#
64
# Output: status code, indicating timedout, terminated, running, or unknown
65
#
66
sub getPidStatus
67
{
68
	my $pid = shift;
69
	my $startTime = shift;
70
	my $timeoutSeconds = shift;
71
	my $kid = 0;
72
	
73
	if(!defined($pid))
74
	{
75
		printf("ERROR: Wrong arguments (pid %d line %d of %s in %s)\n",
76
			$$,__LINE__,__FILE__,(caller(0))[3]);		
77
		return $PROCESS_UNKNOWN;
78
	}
79
	
80
	if(!defined($timeoutSeconds)){$timeoutSeconds = 0;}
81
	
82
	# Waits for a particular child process to terminate and 
83
	#    returns the pid of the deceased process, 
84
	#    or -1 if there is no such child process. 
85
	# On some systems, a value of 0 indicates that there are processes still running.
86
	
87
	# Note that on some systems, a return value of -1 could mean that 
88
	# child processes are being automatically reaped
89
	$kid = waitpid( $pid, WNOHANG );
90
	my $currentTime = time;
91
	if ( $timeoutSeconds > 0 && (($currentTime - $startTime) >= $timeoutSeconds) && ($kid != -1) && ($kid != $pid))
92
	{
93
		return $PROCESS_TIMEDOUT;
94
	} 
95
	if(($kid == -1) || ($kid == $pid))
96
	{
97
		return $PROCESS_TERMINATED;
98
	}
99
	if($kid == 0)
100
	{
101
		return $PROCESS_RUNNING;
102
	}
103
	return return $PROCESS_UNKNOWN;
104
}
105

    
106
# Locks a file 
107
sub lockFile
108
{
109
	my ($file) = @_;
110

    
111
	my $fh;
112
	unless (sysopen ($fh, $file, O_WRONLY))
113
	{
114
		print "ERROR: pid $$ - Could not open $file: $!\n";
115
		return 0;
116
	}
117

    
118
	unless (flock($fh, LOCK_EX))
119
	{
120
		print "ERROR: pid $$ - Could not flock $file: $!\n";
121
		close $fh;
122
		return 0;
123
	}
124

    
125
	close $fh;
126
	return 1;
127
}
128

    
129
# Procedure to be executed by forked process
130
sub childProcedure
131
{
132
	my ($file, $seconds_to_run) = @_;
133
	my $stime;
134
	my $cnt = 0;
135

    
136
	if(!defined($file) || !defined($seconds_to_run))
137
	{
138
		return;
139
	}
140
	$stime = time;
141

    
142
	while(time - $stime < $seconds_to_run)
143
	{
144
		$cnt ++ if(lockFile($file));
145
	}
146
	print "INFO: pid $$ successfully locked file $cnt times in " . (time-$stime) . " seconds\n";
147
}
148

    
149
sub main
150
{
151
	my ($numOfProcesses, $file, $seconds_to_run);
152
	my %hashPids = ();
153
	my @arrPids = ();
154
	my $cnt = 0;
155
	my $status;
156
	my $childPid;
157
	my $cntDonePids;
158
	my $fh;
159
	
160
	if(scalar(@ARGV) < 3)
161
	{
162
		print "Usage:\n";
163
		print "  $0 <number of processes> <existing file> <seconds to run>\n";
164
		print "\n";
165
		exit;
166
	}
167
	$numOfProcesses = $ARGV[0]; 
168
	$file = $ARGV[1];
169
	$seconds_to_run = $ARGV[2];
170
	
171
	if( ! -f $file )
172
	{
173
		print "ERROR: $file is not an existing file.\n";
174
		exit;
175
	}
176
	unless (sysopen ($fh, $file, O_WRONLY))
177
	{
178
		print "ERROR: Could not open $file for write: $!\n";
179
		exit;
180
	}
181
	close($fh);
182

    
183
	# fork child processes
184
	while($cnt < $numOfProcesses)
185
	{
186
		$status = forkToExecute(\$childPid, \&childProcedure, $file, $seconds_to_run);
187
		if($status == $OK)
188
		{
189
			push @arrPids, $childPid;
190
			$hashPids{$childPid} = 0;
191
		}
192
		$cnt ++;
193
	}
194
	
195
	# wait for children to finish 
196
	$cntDonePids = 0;
197
	while(1)
198
	{
199
		foreach $childPid (@arrPids)
200
		{
201
			next if($hashPids{$childPid});
202
			$status = getPidStatus($childPid, time, 0);
203
			if($status == $PROCESS_TERMINATED)
204
			{
205
				$hashPids{$childPid} = 1;
206
				$cntDonePids ++;
207
			}
208
		}
209
		last if($cntDonePids == scalar(@arrPids));
210
		sleep 1;
211
	}
212
}
213

    
214
main();
    (1-1/1)