line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Proc::PersistentControl; # -*-perl-*- |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Author: Michael Staats 2014 |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# $Id: PersistentControl.pm 711 2015-03-11 14:29:23Z michael $ |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Proc::PersistentControl - Start and Control Background Processes ("jobs", process groups) |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Proc::PersistentControl; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my $controller = Proc::PersistentControl->new(); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $Proc = |
19
|
|
|
|
|
|
|
$controller->StartProc({ [ timeout => 42, psynctime => 5, |
20
|
|
|
|
|
|
|
Key => 'Value', ... ] }, |
21
|
|
|
|
|
|
|
"runme args"); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my @Procs = $controller->ProcList(['Key', 'Value']); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my @Procs = $controller->RipeList(); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $alive = $Proc->IsAlive(); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $ripe = $Proc->IsRipe(); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $info = $Proc->Info(); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my $info = $Proc->Reap(); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
$Proc->Kill(); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 DESCRIPTION |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
WARNING: This module (and its pod) is beta. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
The method that is used by this module is calling for race conditions all |
42
|
|
|
|
|
|
|
over the place... Since version 1.0 most of these should be found. But there |
43
|
|
|
|
|
|
|
will still be bugs. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
This module creates background processes and allows to track |
46
|
|
|
|
|
|
|
them from multiple invocations of a perl program, i. e. not only |
47
|
|
|
|
|
|
|
from the parent. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
This is done in quite a KISS way: Information about background |
50
|
|
|
|
|
|
|
processes is stored in one directory per started process. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Special care is taken so that killing processes will also kill |
53
|
|
|
|
|
|
|
all child processes (i. e. grandchildren). |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
A timeout for the processes can be specified. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
This module works on Unix and Windows. On Windows, Win32, Win32::Process |
58
|
|
|
|
|
|
|
and Win32::Job is required. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
This module is intended to be as simple as possible. It should have as |
61
|
|
|
|
|
|
|
few other modules as prerequisites as possible, only modules |
62
|
|
|
|
|
|
|
that are likely to be installed in a "typical" perl installation (i. e. |
63
|
|
|
|
|
|
|
core modules, or "standard" Win32 modules on Windows). It should be |
64
|
|
|
|
|
|
|
usable on any Unix with the perl that comes with the OS. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
The intended typical use cases of this module are things like programs |
67
|
|
|
|
|
|
|
that need to start and control "a few" background processes (something |
68
|
|
|
|
|
|
|
like max. 10 per minute or so), but consistently over multiple invocations |
69
|
|
|
|
|
|
|
of the program (like when they are scheduled by cron). |
70
|
|
|
|
|
|
|
Probably not a busy web server that needs to start hundreds of CGI |
71
|
|
|
|
|
|
|
processes per second. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 The Controller Object, Process objects, and their Methods |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 Methods for the controller object |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=over 4 |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item Proc::PersistentControl->new([directory => $dir]); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Creates a controller object using $dir as place to store the persistent |
82
|
|
|
|
|
|
|
process information. If 'directory' is not specified, a directory |
83
|
|
|
|
|
|
|
called "ProcPersCtrl" will be created in "/var/tmp/$>" (Unix with /var/tmp), |
84
|
|
|
|
|
|
|
or in File::Spec->tmpdir() . "/$>" (Unix without /var/tmp), or in |
85
|
|
|
|
|
|
|
File::Spec->tmpdir() (Windows). (Note that tmpdir() is not tempdir(), |
86
|
|
|
|
|
|
|
i. e. the directory will always be the same. For certain values |
87
|
|
|
|
|
|
|
of 'always'.) |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Note that preferring /var/tmp over tmpdir() allows information to survive |
90
|
|
|
|
|
|
|
a reboot on systems where /tmp is a tmpfs or similar. (This does not mean that |
91
|
|
|
|
|
|
|
your jobs will survive a reboot (they won't), and also the controller |
92
|
|
|
|
|
|
|
information might be corrupt if a reboot (or crash, or kill -9) kills your |
93
|
|
|
|
|
|
|
processes the hard way). |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item $controller->StartProc({ [ timeout => 42, BLA => 'bla', ... ] }, |
96
|
|
|
|
|
|
|
"runme args"); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=item $controller->StartProc({ [ timeout => 42, BLA => 'bla', ... ] }, |
99
|
|
|
|
|
|
|
"runme", "arg1", "arg2", ...); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Start the program "runme" with command line arguments, optionally specifying |
102
|
|
|
|
|
|
|
a timeout after which the program will be killed. Other key-value pairs in |
103
|
|
|
|
|
|
|
the options are user defined only and can be retrieved via the Info() and |
104
|
|
|
|
|
|
|
Reap() methods, and be used to find processes by key-value pairs with the |
105
|
|
|
|
|
|
|
ProcList() method. Keys must not start with underscore, these are used |
106
|
|
|
|
|
|
|
internally (but will also be returned by Info() etc). |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
The program can be a "binary/excutable" that is in the $PATH (%PATH%), |
109
|
|
|
|
|
|
|
or a "script". |
110
|
|
|
|
|
|
|
Just try. Unix magic "#!" will also work under Windows (and even more...). |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
This method returns an object of class Proc::PersistentControl::Proc which |
113
|
|
|
|
|
|
|
has the methods described further below. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Since the internal information of the controller is stored in the filesystem, |
116
|
|
|
|
|
|
|
you can just terminate your program that uses the controller, start a new one |
117
|
|
|
|
|
|
|
later (giving the same directory to new()) and use all the methods described |
118
|
|
|
|
|
|
|
below. (But see Reap(), which destroys information). |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=item $controller->ProcList(['Key', 'Value']) |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Returns a list of Proc::PersistentControl::Proc objects that are |
123
|
|
|
|
|
|
|
under control of the controller object. |
124
|
|
|
|
|
|
|
If a Key-Value pair is given, only processes with this Key-Value |
125
|
|
|
|
|
|
|
pair in their options are returned (see StartProc()). |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=item $controller->RipeList() |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Returns a list of Proc::PersistentControl::Proc objects that are |
130
|
|
|
|
|
|
|
under control of the controller object and have terminated, i. e. |
131
|
|
|
|
|
|
|
are ready for reaping. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=back |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 Methods for process objects |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=over 4 |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=item $Proc->IsAlive() |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Returns true if $Proc is still running. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=item $Proc->IsRipe() |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
equivalent to "not $Proc->IsAlive()" |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item $Proc->Info() |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Returns a reference to hash that contains information about a process. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Usage: |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub type { |
154
|
|
|
|
|
|
|
print "$_[0]:\n"; |
155
|
|
|
|
|
|
|
open(T, $_[0]); |
156
|
|
|
|
|
|
|
print while (); |
157
|
|
|
|
|
|
|
close(T); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub printInfo { |
161
|
|
|
|
|
|
|
my $r = shift; |
162
|
|
|
|
|
|
|
foreach my $k (keys(%$r)) { |
163
|
|
|
|
|
|
|
my $v = $r->{$k}; |
164
|
|
|
|
|
|
|
print "$k=$v\n"; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
type($r->{_dir} . '/STDOUT'); |
167
|
|
|
|
|
|
|
type($r->{_dir} . '/STDERR'); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
printInfo($Proc->Info()); |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=item $Proc->Reap() |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Returns the process object's "Info()" information if $Proc->IsRipe(). |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
The reaped information will be DESTROY'd after the process |
177
|
|
|
|
|
|
|
object goes out of scope. So make sure you use/copy the information |
178
|
|
|
|
|
|
|
before that. |
179
|
|
|
|
|
|
|
(Reap it and eat it before it gets bad). |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=item $Proc->Kill() |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Kills the operating system process(es) that belong to $Proc. |
184
|
|
|
|
|
|
|
Should also kill grandchildren. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=back |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 BUGS |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
The "make test" tests could be more detailed (but check out the |
191
|
|
|
|
|
|
|
examples, too.) |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
If you use controller objects with the same directory in parallel, be |
194
|
|
|
|
|
|
|
aware that Reap() will reap anything it can. If two calls to Reap() for |
195
|
|
|
|
|
|
|
the same process intersect, the result is unpredictable. So just don't |
196
|
|
|
|
|
|
|
do that, call Reap() only in one of the programs. Other behaviour when |
197
|
|
|
|
|
|
|
using one directory with more than one controller at the same time |
198
|
|
|
|
|
|
|
is considered to be a feature. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Using this module might interfere with your code if it also installs |
201
|
|
|
|
|
|
|
signal handlers, wait()s, etc. So don't do that. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
The method to store information about the processes should use a more |
204
|
|
|
|
|
|
|
structured data format (like Persistent::File or so, but no more pre-reqs |
205
|
|
|
|
|
|
|
should be added). |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head1 Examples |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Examples should be available in the Proc/PersistentControl/example |
210
|
|
|
|
|
|
|
directory (depending on your installation). |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=head1 AUTHOR |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Michael Staats, Emichael.staats@gmx.euE |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Copyright (C) 2014 by Michael Staats |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
221
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.14.2 or, |
222
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=cut |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
require Exporter; |
227
|
7
|
|
|
7
|
|
32921
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
616
|
|
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
$VERSION = '1.0'; |
232
|
|
|
|
|
|
|
|
233
|
7
|
|
|
7
|
|
35
|
use strict; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
217
|
|
234
|
7
|
|
|
7
|
|
28
|
use File::Path qw(mkpath rmtree); # legacy interface, works with older perls |
|
7
|
|
|
|
|
49
|
|
|
7
|
|
|
|
|
462
|
|
235
|
7
|
|
|
7
|
|
28
|
use File::Spec; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
168
|
|
236
|
7
|
|
|
7
|
|
5033
|
use File::Temp 'tempdir'; # also old behaviour, we need the dir permanently |
|
7
|
|
|
|
|
134890
|
|
|
7
|
|
|
|
|
455
|
|
237
|
7
|
|
|
7
|
|
3185
|
use POSIX ":sys_wait_h"; |
|
7
|
|
|
|
|
35525
|
|
|
7
|
|
|
|
|
63
|
|
238
|
7
|
|
|
7
|
|
8281
|
use Carp; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
749
|
|
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
BEGIN { |
241
|
7
|
50
|
|
7
|
|
22239
|
if ($^O =~ /^MSWin/) { |
242
|
0
|
|
|
|
|
0
|
require Win32; Win32->import(); |
|
0
|
|
|
|
|
0
|
|
243
|
0
|
|
|
|
|
0
|
require Win32::Process; Win32::Process->import(); |
|
0
|
|
|
|
|
0
|
|
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
###################################################################### |
248
|
|
|
|
|
|
|
# the new() method for the controller object |
249
|
|
|
|
|
|
|
# |
250
|
|
|
|
|
|
|
my $_debugfh = undef; # quick and dirty global var... |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub new { |
253
|
7
|
|
|
7
|
1
|
1393
|
my $class = shift; |
254
|
7
|
|
|
|
|
21
|
my %opthash = @_; |
255
|
|
|
|
|
|
|
|
256
|
7
|
|
50
|
|
|
49
|
$opthash{nannyname} ||= 'ppc-nanny'; |
257
|
7
|
|
50
|
|
|
28
|
$opthash{closefdmax} ||= 12; |
258
|
|
|
|
|
|
|
|
259
|
7
|
|
|
|
|
21
|
my $self = { _opts => \%opthash }; |
260
|
7
|
|
|
|
|
21
|
$self->{sdir} = $opthash{directory}; |
261
|
7
|
50
|
|
|
|
28
|
if (not $self->{sdir}) { |
262
|
7
|
50
|
|
|
|
42
|
if ($^O !~ /^MSWin/) { |
263
|
7
|
50
|
|
|
|
161
|
$self->{sdir} = |
264
|
|
|
|
|
|
|
((-d '/var/tmp') ? '/var/tmp' : File::Spec->tmpdir()) . |
265
|
|
|
|
|
|
|
"/$>/ProcPersCtrl"; |
266
|
|
|
|
|
|
|
} else { |
267
|
0
|
|
|
|
|
0
|
$self->{sdir} = |
268
|
|
|
|
|
|
|
Win32::GetLongPathName(File::Spec->tmpdir()) . "\\ProcPersCtrl"; |
269
|
|
|
|
|
|
|
#File::Spec->tmpdir() . "\\ProcPersCtrl"; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
7
|
|
|
|
|
21
|
my $sdir = $self->{sdir}; |
274
|
7
|
50
|
|
|
|
14
|
eval { mkpath($sdir) unless (-d $sdir); }; |
|
7
|
|
|
|
|
196
|
|
275
|
7
|
50
|
|
|
|
70
|
croak "'$sdir' is not a directory and could not mkpath() it: $!\n" |
276
|
|
|
|
|
|
|
if (not -d $sdir); |
277
|
|
|
|
|
|
|
|
278
|
7
|
50
|
|
|
|
21
|
if ($opthash{debug}) { |
279
|
0
|
|
|
|
|
0
|
my $file = $sdir . '/debug.out'; |
280
|
0
|
|
|
|
|
0
|
my $size = (stat($file))[7]; |
281
|
0
|
0
|
0
|
|
|
0
|
if ($size and $size > 102400) { |
282
|
0
|
|
|
|
|
0
|
rename($file, $file . '.old'); |
283
|
|
|
|
|
|
|
} |
284
|
0
|
0
|
|
|
|
0
|
open($_debugfh, '>>', $file) || |
285
|
|
|
|
|
|
|
carp "Cannot append to $file: $!"; |
286
|
0
|
|
|
|
|
0
|
select((select($_debugfh), $|=1)[0]); |
287
|
0
|
|
|
|
|
0
|
eval { require Time::HiRes; }; |
|
0
|
|
|
|
|
0
|
|
288
|
0
|
0
|
|
|
|
0
|
if ($@) { |
289
|
0
|
|
|
|
|
0
|
print $_debugfh "No Time::HiRes ($@), sorry...\n"; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
7
|
|
|
|
|
21
|
my $rdir = $sdir . '/reaped'; |
294
|
7
|
50
|
33
|
|
|
168
|
if (-e $rdir and not -d $rdir) { |
295
|
0
|
|
|
|
|
0
|
carp "'$rdir' exists and is not a directory...\n"; |
296
|
0
|
|
|
|
|
0
|
unlink($rdir); |
297
|
|
|
|
|
|
|
} |
298
|
7
|
50
|
|
|
|
77
|
if (not -d $rdir) { |
299
|
0
|
0
|
|
|
|
0
|
mkpath($rdir) or croak "Could not mkpath('$rdir'): $!\n"; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
7
|
|
|
|
|
28
|
bless $self, $class; |
303
|
7
|
|
|
|
|
21
|
return $self; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub debug { |
307
|
132
|
50
|
|
132
|
0
|
471
|
return undef unless $_debugfh; |
308
|
0
|
|
|
|
|
0
|
my $clf = (caller(1))[3]; |
309
|
0
|
|
0
|
|
|
0
|
$clf ||= (caller())[1]; |
310
|
|
|
|
|
|
|
|
311
|
0
|
|
|
|
|
0
|
my $msg = join(' ', @_); |
312
|
0
|
0
|
|
|
|
0
|
$msg .= "\n" unless ($msg =~ /\n$/); |
313
|
0
|
0
|
|
|
|
0
|
my $ts = $INC{'Time/HiRes.pm'} ? Time::HiRes::time() : time(); |
314
|
0
|
|
|
|
|
0
|
print $_debugfh $ts, ' ', $$, ' ', $clf, ': ', $msg; |
315
|
0
|
|
|
|
|
0
|
return 1; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
###################################################################### |
319
|
|
|
|
|
|
|
# system dependent stuff |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub _pid_alive($) { |
322
|
3
|
|
|
3
|
|
21
|
my $pid = shift; |
323
|
|
|
|
|
|
|
|
324
|
3
|
|
|
|
|
34
|
debug($pid); |
325
|
|
|
|
|
|
|
|
326
|
3
|
50
|
33
|
|
|
39
|
return 0 if (not $pid or $pid <= 0); |
327
|
|
|
|
|
|
|
|
328
|
3
|
50
|
|
|
|
20
|
if ($^O !~ /^MSWin/) { |
329
|
3
|
|
|
|
|
30
|
my $ret = kill(0, $pid); |
330
|
3
|
|
|
|
|
12
|
debug("returning $ret"); |
331
|
3
|
|
|
|
|
18
|
return $ret |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Windows |
335
|
0
|
|
|
|
|
0
|
my $process; |
336
|
0
|
0
|
|
|
|
0
|
if (Win32::Process::Open($process, $pid, 0)) { |
337
|
0
|
|
|
|
|
0
|
debug("Win32::Process::Open ok"); |
338
|
0
|
|
|
|
|
0
|
my $RC; |
339
|
0
|
|
|
|
|
0
|
$process->GetExitCode($RC); |
340
|
0
|
|
|
|
|
0
|
debug("Win32 GetExitCode RC=$RC"); |
341
|
0
|
0
|
|
|
|
0
|
if ($RC == Win32::Process::STILL_ACTIVE()) { |
342
|
0
|
|
|
|
|
0
|
debug("returning 1"); |
343
|
0
|
|
|
|
|
0
|
return 1; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
} |
346
|
0
|
|
|
|
|
0
|
debug("returning 0"); |
347
|
0
|
|
|
|
|
0
|
return 0; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# Using these two variables looks like a bug: it seems they |
351
|
|
|
|
|
|
|
# are re-used for new children. But they aren't, the are |
352
|
|
|
|
|
|
|
# only used in the fork()ed child, and this forks only one |
353
|
|
|
|
|
|
|
# grandchild. |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
my $_unix_grandch_pid; |
356
|
|
|
|
|
|
|
my $_unix_grandch_dir; |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub _unix_intr_sighandler { |
359
|
0
|
|
|
0
|
|
0
|
my $sig = shift; |
360
|
0
|
|
|
|
|
0
|
$SIG{INT} = 'IGNORE'; |
361
|
0
|
|
|
|
|
0
|
$SIG{QUIT} = 'IGNORE'; |
362
|
0
|
|
|
|
|
0
|
$SIG{TERM} = 'IGNORE'; |
363
|
|
|
|
|
|
|
|
364
|
0
|
0
|
|
|
|
0
|
if ($_unix_grandch_pid) { |
365
|
0
|
|
|
|
|
0
|
carp "$0:ProcPersCtrl:$$: Caught SIG$sig, killing '$_unix_grandch_pid'...\n"; |
366
|
0
|
|
|
|
|
0
|
_unix_kill($_unix_grandch_pid); # calls the CHLD handler... |
367
|
|
|
|
|
|
|
} |
368
|
0
|
|
|
|
|
0
|
exit(0); |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub _unix_chld_sighandler { |
372
|
3
|
|
|
3
|
|
17
|
my $child; |
373
|
3
|
|
|
|
|
133
|
while (($child = waitpid(-1, WNOHANG)) > 0) { |
374
|
3
|
|
|
|
|
57
|
my $RC = $? >> 8; |
375
|
3
|
|
|
|
|
56
|
debug("Child $child died with RC=$RC (my grandchild $_unix_grandch_pid)"); |
376
|
3
|
50
|
|
|
|
18
|
if ($child == $_unix_grandch_pid) { |
377
|
|
|
|
|
|
|
# this is what we have been waiting for |
378
|
3
|
|
|
|
|
9
|
$_unix_grandch_pid = undef; |
379
|
3
|
|
|
|
|
14
|
debug("Writing rc and endtime to $_unix_grandch_dir"); |
380
|
3
|
50
|
|
|
|
396
|
open(RC, '>', $_unix_grandch_dir . "/RC=$RC") or |
381
|
|
|
|
|
|
|
carp "Could not write $_unix_grandch_dir/RC=$RC: $!"; |
382
|
3
|
|
|
|
|
49
|
close(RC); |
383
|
3
|
50
|
|
|
|
128
|
open(I, '>>', $_unix_grandch_dir . "/info") or |
384
|
|
|
|
|
|
|
carp "Could not append to $_unix_grandch_dir/info: $!"; |
385
|
3
|
|
|
|
|
39
|
print I "_endtime=", time(), "\n"; |
386
|
3
|
|
|
|
|
82
|
close(I); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
} |
389
|
3
|
|
|
|
|
400576
|
$SIG{CHLD} = \&_unix_chld_sighandler; # ... sysV |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
sub _unix_spawn { |
393
|
15
|
|
|
15
|
|
30
|
my $pdir = shift; |
394
|
15
|
|
|
|
|
15
|
my $opt = shift; |
395
|
15
|
|
|
|
|
33
|
my @cmd = @_; |
396
|
|
|
|
|
|
|
|
397
|
15
|
|
|
|
|
78
|
debug("called with $pdir for $cmd[0] ..."); |
398
|
|
|
|
|
|
|
|
399
|
15
|
|
|
|
|
206
|
$SIG{CHLD} = 'IGNORE'; # for now |
400
|
|
|
|
|
|
|
|
401
|
15
|
|
|
|
|
12704
|
my $childpid = fork(); |
402
|
15
|
50
|
|
|
|
433
|
croak "Cannot fork(): $!\n" if (not defined $childpid); |
403
|
|
|
|
|
|
|
|
404
|
15
|
100
|
|
|
|
173
|
if ($childpid == 0) { |
405
|
6
|
|
|
|
|
412
|
debug("I'm the new child for $opt->{nannyname} $cmd[0] ..."); |
406
|
|
|
|
|
|
|
# child |
407
|
|
|
|
|
|
|
# fill the info directory, |
408
|
|
|
|
|
|
|
|
409
|
6
|
50
|
|
|
|
1066
|
open(I, '>', $pdir . '/info') or croak "Cannot write '$pdir/info': $!\n"; |
410
|
6
|
|
|
|
|
46
|
my $start = time(); |
411
|
6
|
|
|
|
|
172
|
print I "_starttime=$start\n"; |
412
|
6
|
|
|
|
|
164
|
print I "_cmd=", join(",", map { s/([,\\])/\\$1/g; s/\n/\\n/g; $_ } |
|
6
|
|
|
|
|
184
|
|
|
6
|
|
|
|
|
68
|
|
|
6
|
|
|
|
|
76
|
|
413
|
|
|
|
|
|
|
my @tmp = @cmd), "\n"; |
414
|
6
|
|
|
|
|
168
|
foreach my $o (keys(%$opt)) { |
415
|
28
|
|
|
|
|
98
|
my $v = $opt->{$o}; |
416
|
28
|
|
|
|
|
62
|
$v =~ s/\n/\\n/sg; |
417
|
28
|
|
|
|
|
32
|
$v =~ s/\r/\\r/sg; |
418
|
28
|
|
|
|
|
140
|
print I "$o=$v\n"; |
419
|
|
|
|
|
|
|
} |
420
|
6
|
|
|
|
|
394
|
close(I); |
421
|
|
|
|
|
|
|
|
422
|
6
|
|
|
|
|
500
|
open(STDIN, '/dev/null'); |
423
|
6
|
50
|
|
|
|
744
|
open(STDOUT, '>', $pdir . '/STDOUT') or |
424
|
|
|
|
|
|
|
croak "Cannot write '$pdir/STDOUT': $!\n"; |
425
|
6
|
50
|
|
|
|
616
|
open(STDERR, '>', $pdir . '/STDERR') or |
426
|
|
|
|
|
|
|
croak "Cannot write '$pdir/STDERR': $!\n"; |
427
|
|
|
|
|
|
|
|
428
|
6
|
50
|
|
|
|
66
|
if ($opt->{_closefdmax} >= 3) { |
429
|
6
|
|
|
|
|
42
|
for (my $fd = 3; $fd <= $opt->{_closefdmax}; $fd++) { |
430
|
60
|
50
|
33
|
|
|
356
|
POSIX::close($fd) |
431
|
|
|
|
|
|
|
unless ($_debugfh and $fd == fileno($_debugfh)); |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
6
|
|
|
|
|
40
|
$_unix_grandch_dir = $pdir; |
436
|
|
|
|
|
|
|
|
437
|
6
|
|
|
|
|
276
|
$0 = $opt->{nannyname} . ' ' . join(' ', @cmd); |
438
|
|
|
|
|
|
|
|
439
|
6
|
|
|
|
|
114
|
$SIG{CHLD} = \&_unix_chld_sighandler; |
440
|
|
|
|
|
|
|
|
441
|
6
|
|
|
|
|
8092
|
$_unix_grandch_pid = fork(); # fork again for grandchild |
442
|
6
|
100
|
|
|
|
283
|
if ($_unix_grandch_pid == 0) { |
443
|
3
|
|
|
|
|
366
|
debug("I'm the new grandchild for $cmd[0] ..."); |
444
|
|
|
|
|
|
|
#grandchild |
445
|
3
|
|
|
|
|
108
|
$SIG{CHLD} = 'DEFAULT'; |
446
|
3
|
|
|
|
|
132
|
setpgrp(0, 0); |
447
|
|
|
|
|
|
|
# Sometimes (esp. on AIX) it seems that the following exec |
448
|
|
|
|
|
|
|
# can terminate before $_unix_grandch_pid is set in the |
449
|
|
|
|
|
|
|
# parent, which is bad since the sighandler checks it... |
450
|
|
|
|
|
|
|
# so wait for the pid file |
451
|
3
|
|
100
|
|
|
89
|
my $psynctime = $opt->{psynctime} || 10; |
452
|
3
|
|
|
|
|
19
|
my $waited = 0; |
453
|
3
|
|
|
|
|
40
|
debug("waiting max $psynctime s for 'start' file"); |
454
|
3
|
|
|
|
|
33
|
for (my $nwait = 1; $nwait < 10 * $psynctime; $nwait++) { |
455
|
4
|
100
|
|
|
|
188
|
last if (-e $pdir . "/start"); |
456
|
1
|
|
|
|
|
4
|
$waited++; |
457
|
1
|
|
|
|
|
100185
|
select(undef, undef, undef, 0.1); |
458
|
|
|
|
|
|
|
} |
459
|
3
|
|
|
|
|
108
|
debug("waited " . (0.1 * $waited) . " s for 'start' file"); |
460
|
3
|
0
|
|
|
|
0
|
exec(@cmd) or |
461
|
|
|
|
|
|
|
croak "Could not exec(", join(', ', @cmd), ")\n"; |
462
|
|
|
|
|
|
|
} |
463
|
3
|
50
|
|
|
|
36
|
croak "Cannot fork(): $!\n" if (not defined $_unix_grandch_pid); |
464
|
|
|
|
|
|
|
|
465
|
3
|
|
|
|
|
275
|
$SIG{INT} = \&_unix_term_sighandler; |
466
|
3
|
|
|
|
|
69
|
$SIG{TERM} = \&_unix_term_sighandler; |
467
|
3
|
|
|
|
|
43
|
$SIG{QUIT} = \&_unix_term_sighandler; |
468
|
|
|
|
|
|
|
|
469
|
3
|
|
|
|
|
443
|
open(PID, '>', $pdir . "/pid=$_unix_grandch_pid"); close(PID); |
|
3
|
|
|
|
|
72
|
|
470
|
3
|
|
|
|
|
205
|
open(STA, '>', $pdir . "/start"); print STA time(), "\n"; close(STA); |
|
3
|
|
|
|
|
108
|
|
|
3
|
|
|
|
|
139
|
|
471
|
3
|
|
|
|
|
150
|
debug("child says: \$_unix_grandch_pid = $_unix_grandch_pid " . |
472
|
|
|
|
|
|
|
"for $cmd[0] ..."); |
473
|
|
|
|
|
|
|
|
474
|
3
|
100
|
|
|
|
37
|
my $timeout = $opt->{timeout} ? int($opt->{timeout}) : 86400000; |
475
|
3
|
|
|
|
|
12
|
my $maxtime = time + $timeout; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# $_unix_grandch_pid will be set to undef in the sighandler... |
478
|
|
|
|
|
|
|
# well, sometimes it seems it doesn't (some perls on some AIX, eg.) |
479
|
|
|
|
|
|
|
# so we also test with kill(0, ...) |
480
|
3
|
|
|
|
|
20
|
debug("Before wait loop for $cmd[0] ..."); |
481
|
3
|
|
66
|
|
|
189
|
while ($_unix_grandch_pid and kill(0, $_unix_grandch_pid) and time < $maxtime) { |
|
|
|
100
|
|
|
|
|
482
|
3
|
|
|
|
|
26
|
my $remain = $maxtime - time; |
483
|
|
|
|
|
|
|
# check each min to avoid race condition, see below |
484
|
3
|
100
|
|
|
|
15
|
$remain = 60 if ($remain > 60); |
485
|
3
|
|
|
|
|
301
|
debug("Waiting for grandchild... sleep($remain) at " |
486
|
|
|
|
|
|
|
. scalar(localtime)); |
487
|
3
|
50
|
|
|
|
7777850
|
sleep($remain) # will be interrupted by SIGCHLD, this is what we want |
488
|
|
|
|
|
|
|
# but if the sighandler jumps in exactly HERE |
489
|
|
|
|
|
|
|
# we still have a race cond. |
490
|
|
|
|
|
|
|
# That's why we sleep at most 60 s |
491
|
|
|
|
|
|
|
if ($_unix_grandch_pid); # just to be sure... |
492
|
|
|
|
|
|
|
} |
493
|
3
|
|
|
|
|
177
|
debug("after wait loop for $cmd[0] ... at " . scalar(localtime)); |
494
|
3
|
100
|
66
|
|
|
46
|
if ($_unix_grandch_pid and kill(0, $_unix_grandch_pid)) { |
495
|
1
|
|
|
|
|
657
|
carp "ProcPersCtrl:$$: Child $_unix_grandch_pid is alive after $timeout s, killing it\n"; |
496
|
1
|
50
|
|
|
|
287
|
open(I, '>>', $pdir . '/info') or |
497
|
|
|
|
|
|
|
croak "Cannot append to '$pdir/info': $!\n"; |
498
|
1
|
|
|
|
|
10
|
print I "_timed_out=1\n"; |
499
|
1
|
|
|
|
|
33
|
close(I); |
500
|
1
|
|
|
|
|
9
|
_unix_kill($_unix_grandch_pid); |
501
|
|
|
|
|
|
|
} |
502
|
3
|
|
|
|
|
361
|
exit(0); |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
# parent |
505
|
9
|
|
|
|
|
779
|
debug("parent says: child $childpid"); |
506
|
9
|
|
|
|
|
164
|
return $childpid; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
sub _win_spawn { |
510
|
0
|
|
|
0
|
|
0
|
my $pdir = shift; |
511
|
0
|
|
|
|
|
0
|
my $opt = shift; |
512
|
0
|
|
|
|
|
0
|
my @cmd = @_; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# find the helper script |
515
|
0
|
|
|
|
|
0
|
my $module_path = $INC{'Proc/PersistentControl.pm'}; |
516
|
0
|
|
|
|
|
0
|
$module_path =~ s|(.*)[/\\].*|$1|; |
517
|
0
|
|
|
|
|
0
|
my $helper = '"' . $module_path . '/PersistentControl/winjob.pl' . '"'; |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
# construct args the DOS way, hopefully... |
520
|
0
|
|
|
|
|
0
|
my $Arg = 'perl ' . $helper . " "; |
521
|
0
|
0
|
|
|
|
0
|
$Arg .= ' -d ' if ($_debugfh); |
522
|
0
|
0
|
|
|
|
0
|
my $timeout = $opt->{timeout} ? $opt->{timeout} : 0; |
523
|
0
|
0
|
|
|
|
0
|
$Arg .= " -t $timeout " if ($timeout > 0); |
524
|
|
|
|
|
|
|
# well, if you have a '"' inside one of the arguments, I'm sorry... |
525
|
0
|
|
|
|
|
0
|
$Arg .= "\"$pdir\" \"" . join('" "', @cmd) . '"'; |
526
|
|
|
|
|
|
|
|
527
|
0
|
|
|
|
|
0
|
debug("perl \$Arg = '$Arg'"); |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# launch windows process (helper script, in background) |
530
|
0
|
|
|
|
|
0
|
my $process; |
531
|
0
|
0
|
|
|
|
0
|
Win32::Process::Create($process, $^X, $Arg, 0, 0, '.') or |
532
|
|
|
|
|
|
|
croak "Cannot Win32::Process::Create(): $!\n"; |
533
|
|
|
|
|
|
|
|
534
|
0
|
|
|
|
|
0
|
my $childpid = $process->GetProcessID(); |
535
|
|
|
|
|
|
|
|
536
|
0
|
|
|
|
|
0
|
debug("\$childpid = $childpid"); |
537
|
|
|
|
|
|
|
|
538
|
0
|
0
|
|
|
|
0
|
open(I, '>', $pdir . '/info') or croak "Cannot write '$pdir/info': $!\n"; |
539
|
0
|
|
|
|
|
0
|
my $start = time(); |
540
|
0
|
|
|
|
|
0
|
print I "_starttime=$start\n"; |
541
|
0
|
|
|
|
|
0
|
print I "_cmd=", join(",", map { s/([,\\])/\\$1/g; s/\n/\\n/g; $_ } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
542
|
|
|
|
|
|
|
my @tmp = @cmd), "\n"; |
543
|
0
|
|
|
|
|
0
|
foreach my $o (keys(%$opt)) { |
544
|
0
|
|
|
|
|
0
|
my $v = $opt->{$o}; |
545
|
0
|
|
|
|
|
0
|
$v =~ s/\n/\\n/sg; |
546
|
0
|
|
|
|
|
0
|
$v =~ s/\r/\\r/sg; |
547
|
0
|
|
|
|
|
0
|
print I "$o=$v\n"; |
548
|
|
|
|
|
|
|
} |
549
|
0
|
|
|
|
|
0
|
close(I); |
550
|
|
|
|
|
|
|
|
551
|
0
|
|
|
|
|
0
|
return $childpid; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub _unix_kill { |
555
|
2
|
|
|
2
|
|
6
|
my @pids = @_; |
556
|
2
|
|
|
|
|
4
|
my @ret; |
557
|
2
|
|
|
|
|
8
|
foreach my $p (@pids) { |
558
|
2
|
|
|
|
|
7
|
debug("killing $p"); |
559
|
|
|
|
|
|
|
# first the process group if we have one |
560
|
2
|
100
|
66
|
|
|
200956
|
kill(-15, $p) and |
561
|
|
|
|
|
|
|
(select(undef, undef, undef, 0.2), kill -3, $p) and |
562
|
|
|
|
|
|
|
(select(undef, undef, undef, 0.4), kill -9, $p); |
563
|
|
|
|
|
|
|
# then a single process |
564
|
2
|
50
|
33
|
|
|
19
|
kill( 15, $p) and |
565
|
|
|
|
|
|
|
(select(undef, undef, undef, 0.2), kill 3, $p) and |
566
|
|
|
|
|
|
|
(select(undef, undef, undef, 0.4), kill 9, $p); |
567
|
2
|
50
|
|
|
|
18
|
push(@ret, $p) unless (kill(0, $p)); |
568
|
|
|
|
|
|
|
} |
569
|
2
|
|
|
|
|
12
|
return @ret; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub _win_kill { |
573
|
0
|
|
|
0
|
|
0
|
my @pids = @_; |
574
|
0
|
|
|
|
|
0
|
foreach my $p (@pids) { |
575
|
0
|
|
|
|
|
0
|
my $exitcode = 130; |
576
|
0
|
|
|
|
|
0
|
debug("killing $p"); |
577
|
0
|
|
|
|
|
0
|
Win32::Process::KillProcess($p, $exitcode); |
578
|
|
|
|
|
|
|
} |
579
|
0
|
|
|
|
|
0
|
return @pids; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
###################################################################### |
583
|
|
|
|
|
|
|
# internal functions |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
sub _UID_alive($$) { |
586
|
10
|
|
|
10
|
|
18
|
my $sdir = shift; |
587
|
10
|
|
|
|
|
552
|
my $UID = shift; |
588
|
|
|
|
|
|
|
|
589
|
10
|
|
|
|
|
31
|
my $pdir = $sdir . '/' . $UID; |
590
|
10
|
|
|
|
|
10
|
my $pid; |
591
|
|
|
|
|
|
|
my $RC; |
592
|
|
|
|
|
|
|
|
593
|
10
|
|
|
|
|
335
|
opendir(D, $pdir); |
594
|
10
|
|
|
|
|
220
|
while ($_ = readdir(D)) { |
595
|
77
|
100
|
|
|
|
168
|
$pid = $1 if (m/^pid=(\d+)/); |
596
|
77
|
100
|
|
|
|
473
|
$RC = $1 if (m/^RC=(\d+)/); |
597
|
|
|
|
|
|
|
} |
598
|
10
|
|
|
|
|
149
|
closedir(D); |
599
|
10
|
100
|
|
|
|
121
|
return defined($RC) ? 0 : _pid_alive($pid); |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
sub _get_all_uids { |
603
|
0
|
|
|
0
|
|
0
|
my $sdir = shift; |
604
|
0
|
|
|
|
|
0
|
my @ret; |
605
|
|
|
|
|
|
|
|
606
|
0
|
0
|
|
|
|
0
|
opendir(D, $sdir) or croak "Cannot opendir '$sdir': $!\n"; |
607
|
0
|
|
|
|
|
0
|
while (my $d = readdir(D)) { |
608
|
0
|
0
|
|
|
|
0
|
if ($d =~ m/^PPC-/) { |
609
|
0
|
|
|
|
|
0
|
push(@ret, $d); |
610
|
0
|
|
|
|
|
0
|
debug("found job info dir \"$d\""); |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
} |
613
|
0
|
|
|
|
|
0
|
closedir(D); |
614
|
0
|
|
|
|
|
0
|
debug("returning " . join(' ', @ret)); |
615
|
0
|
|
|
|
|
0
|
return @ret; |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
sub _get_pid_by_uid { |
619
|
1
|
|
|
1
|
|
2
|
my $sdir = shift; |
620
|
1
|
|
|
|
|
3
|
my $UID = shift; |
621
|
|
|
|
|
|
|
|
622
|
1
|
|
|
|
|
4
|
debug("in $sdir $UID"); |
623
|
1
|
|
|
|
|
2
|
my $pdir = $sdir . '/' . $UID; |
624
|
1
|
|
|
|
|
2
|
my $pid; |
625
|
1
|
50
|
|
|
|
18
|
if (opendir(DD, $pdir)) { |
626
|
1
|
|
|
|
|
7
|
while (my $f = readdir(DD)) { |
627
|
7
|
|
|
|
|
11
|
debug("read $f"); |
628
|
7
|
100
|
|
|
|
31
|
$pid = $1 if ($f =~ m/pid=(\d+)$/); |
629
|
|
|
|
|
|
|
} |
630
|
1
|
|
|
|
|
5
|
closedir(DD); |
631
|
1
|
50
|
|
|
|
9
|
carp "Could not find pid file in $pdir\n" unless ($pid); |
632
|
|
|
|
|
|
|
} else { |
633
|
0
|
|
|
|
|
0
|
carp "Can't opendir $pdir for $UID\n"; |
634
|
|
|
|
|
|
|
} |
635
|
1
|
|
|
|
|
4
|
debug("returning $pid"); |
636
|
1
|
|
|
|
|
3
|
return ($pid); |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
sub _get_info_by_uid { |
640
|
2
|
|
|
2
|
|
2
|
my $sdir = shift; |
641
|
2
|
|
|
|
|
4
|
my $UID = shift; |
642
|
|
|
|
|
|
|
|
643
|
2
|
|
|
|
|
3
|
my %ret; |
644
|
|
|
|
|
|
|
|
645
|
2
|
|
|
|
|
7
|
my $pdir = $sdir . '/' . $UID; |
646
|
2
|
|
|
|
|
7
|
my $infofile = $pdir . '/info'; |
647
|
|
|
|
|
|
|
|
648
|
2
|
50
|
|
|
|
80
|
open(I, $infofile) or return undef; |
649
|
|
|
|
|
|
|
|
650
|
2
|
|
|
|
|
42
|
while () { |
651
|
17
|
|
|
|
|
23
|
chomp; |
652
|
17
|
50
|
|
|
|
154
|
$ret{$1} = $2 if (m/([^=]+)=(.*)/); |
653
|
|
|
|
|
|
|
} |
654
|
2
|
|
|
|
|
20
|
close(I); |
655
|
|
|
|
|
|
|
|
656
|
2
|
|
|
|
|
6
|
$ret{_dir} = $pdir; |
657
|
2
|
50
|
|
|
|
12
|
$ret{_dir} =~ s|/|\\|g if ($^O =~ /^MSWin/); # cosmetics, also works without |
658
|
|
|
|
|
|
|
|
659
|
2
|
|
100
|
|
|
16
|
my $rctryt = $ret{psynctime} || 10; |
660
|
|
|
|
|
|
|
|
661
|
2
|
|
|
|
|
4
|
my $pidalive = 0; |
662
|
2
|
|
|
|
|
10
|
debug("waiting max $rctryt s for 'RC' file"); |
663
|
2
|
|
|
|
|
12
|
for (my $ntry = 0; $ntry < 10 * $rctryt; $ntry++, select(undef, undef, undef, 0.1)) { |
664
|
|
|
|
|
|
|
# try a few times, just in case this function is called |
665
|
|
|
|
|
|
|
# after the process has terminated but before RC could be written |
666
|
|
|
|
|
|
|
# nevertheless it's still a race condition... |
667
|
2
|
|
|
|
|
11
|
debug("try " . ($ntry + 1) . " to get RC in $pdir"); |
668
|
2
|
50
|
|
|
|
55
|
opendir(D, $pdir) or croak "cannot opendir $pdir: $!"; |
669
|
2
|
|
|
|
|
18
|
while ($_ = readdir(D)) { |
670
|
16
|
|
|
|
|
37
|
debug("readdir() gives: $_"); |
671
|
16
|
100
|
|
|
|
40
|
$ret{_pid} = $1 if (m/^pid=(\d+)/); |
672
|
16
|
100
|
|
|
|
60
|
$ret{_RC} = $1 if (m/^RC=(\d+)/); |
673
|
|
|
|
|
|
|
} |
674
|
2
|
|
|
|
|
11
|
closedir(D); |
675
|
2
|
50
|
|
|
|
8
|
last if (exists($ret{_RC})); # found ret code, fine |
676
|
0
|
0
|
|
|
|
0
|
if ($ret{_pid}) { |
677
|
0
|
|
|
|
|
0
|
$pidalive = _pid_alive($ret{_pid}); |
678
|
0
|
0
|
|
|
|
0
|
last if ($pidalive); # still alive, also ok |
679
|
|
|
|
|
|
|
} |
680
|
0
|
|
|
|
|
0
|
debug("No RC found in $pdir although process is dead..."); |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
2
|
50
|
|
|
|
7
|
if (exists($ret{_RC})) { |
684
|
2
|
|
|
|
|
5
|
$ret{_alive} = 0; |
685
|
|
|
|
|
|
|
} else { |
686
|
0
|
0
|
|
|
|
0
|
if ($pidalive) { |
687
|
0
|
|
|
|
|
0
|
$ret{_alive} = 1; |
688
|
|
|
|
|
|
|
} else { |
689
|
|
|
|
|
|
|
# no RC and not alive => terminated the hard way... |
690
|
0
|
|
|
|
|
0
|
$ret{_alive} = 0; |
691
|
0
|
|
|
|
|
0
|
debug("Could not determine RC, setting it to 130"); |
692
|
0
|
|
|
|
|
0
|
carp "Could not determine return code of job in $pdir, " . |
693
|
|
|
|
|
|
|
"setting it to 130"; |
694
|
0
|
|
|
|
|
0
|
$ret{_RC} = 130; |
695
|
0
|
|
|
|
|
0
|
open(RC, '>', $pdir . '/RC=130'); close(RC); |
|
0
|
|
|
|
|
0
|
|
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
7
|
|
|
7
|
|
63
|
no warnings "uninitialized"; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
5684
|
|
700
|
2
|
|
|
|
|
16
|
debug("\$ret{_RC} = $ret{_RC} \$ret{_dir} = $ret{_dir} " . |
701
|
|
|
|
|
|
|
"\$ret{_pid} = $ret{_pid} \$ret{TAG} = $ret{TAG}"); |
702
|
|
|
|
|
|
|
|
703
|
2
|
|
|
|
|
17
|
return \%ret; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
sub _make_uid_list { |
707
|
|
|
|
|
|
|
# return a uid list for @in IDs |
708
|
0
|
|
|
0
|
|
0
|
my $sdir = shift; |
709
|
0
|
|
|
|
|
0
|
my @in = @_; |
710
|
0
|
|
|
|
|
0
|
my @out; |
711
|
|
|
|
|
|
|
|
712
|
0
|
|
|
|
|
0
|
debug("in: ", join('-', @in)); |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
# empty input, return all UIDS |
715
|
0
|
0
|
|
|
|
0
|
if (not $in[0]) { |
716
|
0
|
|
|
|
|
0
|
@out = _get_all_uids($sdir); |
717
|
|
|
|
|
|
|
} else { |
718
|
|
|
|
|
|
|
# otherwise: return UIDS for input ids |
719
|
0
|
|
|
|
|
0
|
foreach my $UID (@in) { |
720
|
0
|
|
|
|
|
0
|
my $pdir = $sdir . '/' . $UID; |
721
|
0
|
0
|
|
|
|
0
|
push(@out, $UID) if (-f $pdir . '/info'); |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
} |
724
|
0
|
|
|
|
|
0
|
debug("out: ", join('-', @out)); |
725
|
0
|
|
|
|
|
0
|
return @out; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
###################################################################### |
729
|
|
|
|
|
|
|
# Proc::PersistentControl object methods, actually all of them return |
730
|
|
|
|
|
|
|
# objects of class Proc::PersistentControl::Proc |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
sub StartProc { |
733
|
|
|
|
|
|
|
# this is one of the "new" method for |
734
|
|
|
|
|
|
|
# Proc::PersistentControl::Proc |
735
|
|
|
|
|
|
|
|
736
|
15
|
|
|
15
|
1
|
397
|
my $self = shift; |
737
|
15
|
|
|
|
|
22
|
my $opt = shift; |
738
|
15
|
|
|
|
|
38
|
my @cmd = @_; |
739
|
|
|
|
|
|
|
|
740
|
15
|
|
|
|
|
68
|
my $sdir = $self->{sdir}; |
741
|
|
|
|
|
|
|
|
742
|
15
|
|
|
|
|
22
|
my $w = "Invalid option to StartProc(): Option should not"; |
743
|
15
|
|
|
|
|
121
|
foreach my $o (keys(%$opt)) { |
744
|
27
|
50
|
|
|
|
117
|
carp "$w contain '='" if ($o =~ m/=/); |
745
|
27
|
50
|
|
|
|
70
|
carp "$w start with '_'" if ($o =~ m/^_/); |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
|
748
|
15
|
|
|
|
|
101
|
debug("command '" . join(' ', @cmd) . "'"); |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
# create a directory for process information |
751
|
15
|
|
|
|
|
260
|
my $psd = tempdir('PPC-XXXX', DIR => $sdir); |
752
|
15
|
50
|
33
|
|
|
8819
|
croak "Cannot make tempdir: $!" unless ($psd and -d $psd); |
753
|
|
|
|
|
|
|
|
754
|
15
|
|
|
|
|
106
|
$psd =~ m/.*(PPC-.*)/; |
755
|
15
|
|
|
|
|
89
|
my $UID = $1; |
756
|
|
|
|
|
|
|
|
757
|
15
|
|
|
|
|
46
|
$opt->{_PPCUID} = $UID; |
758
|
15
|
|
33
|
|
|
136
|
$opt->{nannyname} ||= $self->{_opts}->{nannyname}; |
759
|
15
|
|
|
|
|
38
|
$opt->{_closefdmax} = $self->{_opts}->{closefdmax}; |
760
|
|
|
|
|
|
|
|
761
|
15
|
50
|
|
|
|
92
|
($^O !~ /^MSWin/) ? |
762
|
|
|
|
|
|
|
_unix_spawn($psd, $opt, @cmd) : |
763
|
|
|
|
|
|
|
_win_spawn( $psd, $opt, @cmd); |
764
|
|
|
|
|
|
|
|
765
|
9
|
|
|
|
|
267
|
my $Proc = { |
766
|
|
|
|
|
|
|
_PPCUID => $UID, |
767
|
|
|
|
|
|
|
_controller => $self |
768
|
|
|
|
|
|
|
}; |
769
|
|
|
|
|
|
|
|
770
|
9
|
|
100
|
|
|
145
|
my $psynctime = $opt->{psynctime} || 10; |
771
|
9
|
|
|
|
|
33
|
my $waited = 0; |
772
|
9
|
|
|
|
|
66
|
for (my $nwait = 1; $nwait < 10 * $psynctime; $nwait++) { |
773
|
18
|
100
|
|
|
|
1344
|
last if (-e $psd . "/start"); |
774
|
9
|
|
|
|
|
32
|
$waited++; |
775
|
9
|
|
|
|
|
901863
|
select(undef, undef, undef, 0.1); |
776
|
|
|
|
|
|
|
} |
777
|
9
|
|
|
|
|
556
|
debug("waited " . (0.1 * $waited) . " s for 'start' file"); |
778
|
9
|
50
|
|
|
|
238
|
if (-e $psd . "/start") { |
779
|
9
|
|
|
|
|
218
|
bless $Proc, 'Proc::PersistentControl::Proc'; |
780
|
9
|
|
|
|
|
1817
|
debug("returning Proc object for $UID, pid file " . |
781
|
|
|
|
|
|
|
(glob($psd . '/pid=*'))[0]); |
782
|
9
|
|
|
|
|
329
|
return $Proc; |
783
|
|
|
|
|
|
|
} else { |
784
|
0
|
|
|
|
|
0
|
carp "StartProc could not start child process after " . |
785
|
|
|
|
|
|
|
(0.1 * $waited) . " s\n"; |
786
|
0
|
|
|
|
|
0
|
return undef; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
sub ProcList { |
791
|
|
|
|
|
|
|
# this is also a "new" method for |
792
|
|
|
|
|
|
|
# Proc::PersistentControl::Proc |
793
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
794
|
0
|
|
|
|
|
0
|
my $key = shift; |
795
|
0
|
|
|
|
|
0
|
my $val = shift; |
796
|
|
|
|
|
|
|
|
797
|
0
|
|
|
|
|
0
|
my @ret; |
798
|
|
|
|
|
|
|
|
799
|
0
|
|
|
|
|
0
|
debug("called from " . join('-', caller())); |
800
|
|
|
|
|
|
|
|
801
|
0
|
|
|
|
|
0
|
my @uidlist = _make_uid_list($self->{sdir}); |
802
|
|
|
|
|
|
|
|
803
|
0
|
|
|
|
|
0
|
UID: foreach my $UID (@uidlist) { |
804
|
0
|
0
|
|
|
|
0
|
if ($key) { |
805
|
0
|
|
|
|
|
0
|
my $i = _get_info_by_uid($self->{sdir}, $UID); |
806
|
0
|
0
|
|
|
|
0
|
next UID unless ($i->{$key} eq $val); |
807
|
|
|
|
|
|
|
} |
808
|
0
|
|
|
|
|
0
|
my $Proc = { |
809
|
|
|
|
|
|
|
_PPCUID => $UID, |
810
|
|
|
|
|
|
|
_controller => $self |
811
|
|
|
|
|
|
|
}; |
812
|
0
|
|
|
|
|
0
|
bless $Proc, 'Proc::PersistentControl::Proc'; |
813
|
0
|
|
|
|
|
0
|
push(@ret, $Proc); |
814
|
|
|
|
|
|
|
} |
815
|
0
|
|
|
|
|
0
|
return(@ret); |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub RipeList { |
819
|
|
|
|
|
|
|
# another "new" method for |
820
|
|
|
|
|
|
|
# Proc::PersistentControl::Proc |
821
|
|
|
|
|
|
|
|
822
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
823
|
0
|
|
|
|
|
0
|
my @ret; |
824
|
|
|
|
|
|
|
|
825
|
0
|
|
|
|
|
0
|
debug("called from " . join('-', caller())); |
826
|
|
|
|
|
|
|
|
827
|
0
|
|
|
|
|
0
|
my @uidlist = _make_uid_list($self->{sdir}); |
828
|
|
|
|
|
|
|
|
829
|
0
|
|
|
|
|
0
|
foreach my $UID (@uidlist) { |
830
|
0
|
|
|
|
|
0
|
debug("checking $UID"); |
831
|
0
|
0
|
|
|
|
0
|
if (not _UID_alive($self->{sdir}, $UID)) { |
832
|
0
|
|
|
|
|
0
|
my $Proc = { |
833
|
|
|
|
|
|
|
_PPCUID => $UID, |
834
|
|
|
|
|
|
|
_controller => $self |
835
|
|
|
|
|
|
|
}; |
836
|
0
|
|
|
|
|
0
|
bless $Proc, 'Proc::PersistentControl::Proc'; |
837
|
0
|
|
|
|
|
0
|
push(@ret, $Proc); |
838
|
0
|
|
|
|
|
0
|
debug("$UID not alive, ready for reaping"); |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
} |
841
|
0
|
|
|
|
|
0
|
return(@ret); |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
###################################################################### |
845
|
|
|
|
|
|
|
###################################################################### |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
package Proc::PersistentControl::Proc; |
848
|
7
|
|
|
7
|
|
4144
|
use File::Copy; |
|
7
|
|
|
|
|
14168
|
|
|
7
|
|
|
|
|
448
|
|
849
|
7
|
|
|
7
|
|
5131
|
use File::Path qw(mkpath rmtree); # legacy interface, works with older perls |
|
7
|
|
|
|
|
21
|
|
|
7
|
|
|
|
|
371
|
|
850
|
7
|
|
|
7
|
|
35
|
use Carp; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
4039
|
|
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
sub _getUID { |
853
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
854
|
0
|
|
|
|
|
0
|
return $self->{_PPCUID}; |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
sub Kill { |
858
|
1
|
|
|
1
|
|
1000190
|
my $self = shift; |
859
|
|
|
|
|
|
|
|
860
|
1
|
|
|
|
|
21
|
Proc::PersistentControl::debug("called from " . join('-', caller())); |
861
|
|
|
|
|
|
|
|
862
|
1
|
50
|
|
|
|
12
|
return undef unless (Proc::PersistentControl::_UID_alive( |
863
|
|
|
|
|
|
|
$self->{_controller}->{sdir}, |
864
|
|
|
|
|
|
|
$self->{_PPCUID})); |
865
|
|
|
|
|
|
|
|
866
|
1
|
|
|
|
|
12
|
my $pid = Proc::PersistentControl::_get_pid_by_uid( |
867
|
|
|
|
|
|
|
$self->{_controller}->{sdir}, |
868
|
|
|
|
|
|
|
$self->{_PPCUID}); |
869
|
|
|
|
|
|
|
|
870
|
1
|
50
|
|
|
|
12
|
my @ret = ($^O !~ /^MSWin/) ? |
871
|
|
|
|
|
|
|
Proc::PersistentControl::_unix_kill(($pid)) : |
872
|
|
|
|
|
|
|
Proc::PersistentControl::_win_kill( ($pid)); |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
# wait max 1 sec until process has finished and info is written |
875
|
1
|
|
|
|
|
13
|
for (my $nwait = 0; $nwait < 10; $nwait++) { |
876
|
1
|
50
|
|
|
|
6
|
last if (not $self->IsAlive()); |
877
|
0
|
|
|
|
|
0
|
Proc::PersistentControl::debug("Process not dead after Kill() ($nwait)..."); |
878
|
0
|
|
|
|
|
0
|
select(undef, undef, undef, 0.1); |
879
|
|
|
|
|
|
|
} |
880
|
1
|
50
|
|
|
|
4
|
carp "Something is strange, Kill()ed process seems to be still alive..." |
881
|
|
|
|
|
|
|
if ($self->IsAlive()); |
882
|
|
|
|
|
|
|
|
883
|
1
|
|
|
|
|
6
|
return $ret[0]; |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
sub Info { |
887
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
888
|
|
|
|
|
|
|
|
889
|
0
|
|
|
|
|
0
|
Proc::PersistentControl::debug("called from " . join('-', caller())); |
890
|
|
|
|
|
|
|
|
891
|
0
|
|
|
|
|
0
|
return Proc::PersistentControl::_get_info_by_uid( |
892
|
|
|
|
|
|
|
$self->{_controller}->{sdir}, |
893
|
|
|
|
|
|
|
$self->{_PPCUID}); |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
sub IsAlive { |
897
|
9
|
|
|
9
|
|
1000602
|
my $self = shift; |
898
|
|
|
|
|
|
|
|
899
|
9
|
|
|
|
|
79
|
return Proc::PersistentControl::_UID_alive( |
900
|
|
|
|
|
|
|
$self->{_controller}->{sdir}, |
901
|
|
|
|
|
|
|
$self->{_PPCUID}); |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
sub IsRipe { |
905
|
3
|
|
|
3
|
|
7
|
my $self = shift; |
906
|
3
|
|
|
|
|
8
|
return not $self->IsAlive(); |
907
|
|
|
|
|
|
|
} |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
sub Reap { |
910
|
2
|
|
|
2
|
|
85
|
my $self = shift; |
911
|
|
|
|
|
|
|
|
912
|
2
|
|
|
|
|
18
|
Proc::PersistentControl::debug("called from " . join('-', caller())); |
913
|
|
|
|
|
|
|
|
914
|
2
|
50
|
|
|
|
8
|
return undef unless ($self->IsRipe()); |
915
|
|
|
|
|
|
|
|
916
|
2
|
|
|
|
|
8
|
my $sdir = $self->{_controller}->{sdir}; |
917
|
2
|
|
|
|
|
4
|
my $UID = $self->{_PPCUID}; |
918
|
|
|
|
|
|
|
|
919
|
2
|
|
|
|
|
7
|
my $source = $sdir . '/' . $UID; |
920
|
2
|
|
|
|
|
5
|
my $target = $sdir . '/reaped/' . $UID; |
921
|
|
|
|
|
|
|
|
922
|
2
|
50
|
|
|
|
41
|
if (not -d $target) { |
923
|
2
|
0
|
33
|
|
|
170
|
rename($source, $target) or |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
924
|
|
|
|
|
|
|
move($source, $target) or |
925
|
|
|
|
|
|
|
# sometimes (on windows) the dir seems to be "locked" |
926
|
|
|
|
|
|
|
# also after process termination etc. |
927
|
|
|
|
|
|
|
(Proc::PersistentControl::debug("rename/1st move($source, $target) failed, trying again"), |
928
|
|
|
|
|
|
|
select(undef, undef, undef, 0.2), |
929
|
|
|
|
|
|
|
move($source, $target)) or |
930
|
|
|
|
|
|
|
(Proc::PersistentControl::debug("2nd move($source, $target) failed, trying again"), |
931
|
|
|
|
|
|
|
select(undef, undef, undef, 0.8), |
932
|
|
|
|
|
|
|
move($source, $target)) or |
933
|
|
|
|
|
|
|
(Proc::PersistentControl::debug("3rd move($source, $target) failed")); |
934
|
|
|
|
|
|
|
# do not check return value of move |
935
|
|
|
|
|
|
|
# this is unreliable, maybe (on windows...) |
936
|
2
|
50
|
|
|
|
37
|
carp "Cannot move('$source', '$target'): $!\n" unless (-d $target); |
937
|
|
|
|
|
|
|
} else { |
938
|
|
|
|
|
|
|
### Reap called twice??? |
939
|
0
|
|
|
|
|
0
|
carp "Reap: '$target' already exists, Reap() called twice?\n" |
940
|
|
|
|
|
|
|
} |
941
|
2
|
|
|
|
|
14
|
return Proc::PersistentControl::_get_info_by_uid($sdir . '/reaped', $UID); |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
###################################################################### |
945
|
|
|
|
|
|
|
sub DESTROY { |
946
|
6
|
|
|
6
|
|
182
|
my $self = shift; |
947
|
|
|
|
|
|
|
|
948
|
6
|
|
|
|
|
100
|
my $pdir = $self->{_controller}->{sdir} . '/reaped/' . $self->{_PPCUID}; |
949
|
|
|
|
|
|
|
|
950
|
6
|
100
|
|
|
|
177
|
if (-d $pdir) { |
951
|
2
|
50
|
|
|
|
2073562
|
rmtree($pdir) or |
952
|
|
|
|
|
|
|
carp "Could not rmtree($pdir): $!"; |
953
|
|
|
|
|
|
|
} |
954
|
6
|
|
|
|
|
507
|
return 1; |
955
|
|
|
|
|
|
|
} |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
1; |