← Back to branch summary

~ubuntu-branches/ubuntu/trusty/mariadb-5.5/trusty-proposed

« back to all changes in this revision

Viewing changes to mysql-test/lib/My/SafeProcess.pm

  • Committer: Package Import Robot
  • Author(s): Otto Kekäläinen
  • Date: 2013-12-22 10:27:05 UTC
  • Revision ID: package-import@ubuntu.com-20131222102705-mndw7s12mz0szrcn
Tags: upstream-5.5.32
Import upstream version 5.5.32

Show diffs side-by-side

added added

removed removed

Lines of Context:
mysql-test/lib/My/SafeProcess.pm
 
1
# -*- cperl -*-
 
2
# Copyright (c) 2007, 2011, Oracle and/or its affiliates.
 
3
# Copyright (c) 2009, 2011 Monty Program Ab
 
4
#
 
5
# This program is free software; you can redistribute it and/or
 
6
# modify it under the terms of the GNU Library General Public
 
7
# License as published by the Free Software Foundation; version 2
 
8
# of the License.
 
9
#
 
10
# This program is distributed in the hope that it will be useful,
 
11
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
13
# Library General Public License for more details.
 
14
#
 
15
# You should have received a copy of the GNU General Public License
 
16
# along with this program; if not, write to the Free Software
 
17
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 
18
 
 
19
package My::SafeProcess;
 
20
 
 
21
#
 
22
# Class that encapsulates process creation, monitoring and cleanup
 
23
#
 
24
# Spawns a monitor process which spawns a new process locally or
 
25
# remote using subclasses My::Process::Local or My::Process::Remote etc.
 
26
#
 
27
# The monitor process runs a simple event loop more or less just
 
28
# waiting for a reason to zap the process it monitors. Thus the user
 
29
# of this class does not need to care about process cleanup, it's
 
30
# handled automatically.
 
31
#
 
32
# The monitor process wait for:
 
33
#  - the parent process to close the pipe, in that case it
 
34
#    will zap the "monitored process" and exit
 
35
#  - the "monitored process" to exit, in which case it will exit
 
36
#    itself with same exit code as the "monitored process"
 
37
#  - the parent process to send the "shutdown" signal in wich case
 
38
#    monitor will kill the "monitored process" hard and exit
 
39
#
 
40
#
 
41
# When used it will look something like this:
 
42
# $> ps
 
43
#  [script.pl]
 
44
#   - [monitor for `mysqld`]
 
45
#     - [mysqld]
 
46
#   - [monitor for `mysqld`]
 
47
#     - [mysqld]
 
48
#   - [monitor for `mysqld`]
 
49
#     - [mysqld]
 
50
#
 
51
#
 
52
 
 
53
use strict;
 
54
use Carp;
 
55
use POSIX qw(WNOHANG);
 
56
 
 
57
use My::SafeProcess::Base;
 
58
use base 'My::SafeProcess::Base';
 
59
 
 
60
use My::Find;
 
61
use My::Platform;
 
62
 
 
63
my %running;
 
64
my $_verbose= 0;
 
65
my $start_exit= 0;
 
66
 
 
67
END {
 
68
  # Kill any children still running
 
69
  for my $proc (values %running){
 
70
    if ( $proc->is_child($$) and ! $start_exit){
 
71
      #print "Killing: $proc\n";
 
72
      if ($proc->wait_one(0)){
 
73
        $proc->kill();
 
74
      }
 
75
    }
 
76
  }
 
77
}
 
78
 
 
79
 
 
80
sub is_child {
 
81
  my ($self, $parent_pid)= @_;
 
82
  croak "usage: \$safe_proc->is_child()" unless (@_ == 2 and ref $self);
 
83
  return ($self->{PARENT} == $parent_pid);
 
84
}
 
85
 
 
86
 
 
87
my @safe_process_cmd;
 
88
my $safe_kill;
 
89
my $bindir;
 
90
 
 
91
if(defined $ENV{MTR_BINDIR})
 
92
{
 
93
  # This is an out-of-source build. Build directory
 
94
  # is given in MTR_BINDIR env.variable
 
95
  $bindir = $ENV{MTR_BINDIR}."/mysql-test";
 
96
}
 
97
else
 
98
{
 
99
  use Cwd;
 
100
  $bindir = getcwd();
 
101
}
 
102
 
 
103
# Find the safe process binary or script
 
104
sub find_bin {
 
105
  if (IS_WIN32PERL or IS_CYGWIN)
 
106
  {
 
107
    # Use my_safe_process.exe
 
108
    my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
 
109
                         "my_safe_process");
 
110
    push(@safe_process_cmd, $exe);
 
111
 
 
112
    # Use my_safe_kill.exe
 
113
    $safe_kill= my_find_bin($bindir, "lib/My/SafeProcess", "my_safe_kill");
 
114
  }
 
115
  else
 
116
  {
 
117
    # Use my_safe_process
 
118
    my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
 
119
                         "my_safe_process");
 
120
    push(@safe_process_cmd, $exe);
 
121
  }
 
122
}
 
123
 
 
124
 
 
125
sub new {
 
126
  my $class= shift;
 
127
 
 
128
  my %opts=
 
129
    (
 
130
     verbose     => 0,
 
131
     @_
 
132
    );
 
133
 
 
134
  my $path     = delete($opts{'path'})    or croak "path required @_";
 
135
  my $args     = delete($opts{'args'})    or croak "args required @_";
 
136
  my $input    = delete($opts{'input'});
 
137
  my $output   = delete($opts{'output'});
 
138
  my $error    = delete($opts{'error'});
 
139
  my $verbose  = delete($opts{'verbose'}) || $::opt_verbose;
 
140
  my $nocore   = delete($opts{'nocore'});
 
141
  my $host     = delete($opts{'host'});
 
142
  my $shutdown = delete($opts{'shutdown'});
 
143
  my $user_data= delete($opts{'user_data'});
 
144
  my $envs     = delete($opts{'envs'});
 
145
 
 
146
#  if (defined $host) {
 
147
#    $safe_script=  "lib/My/SafeProcess/safe_process_cpcd.pl";
 
148
#  }
 
149
 
 
150
  if (IS_CYGWIN){
 
151
    $path= mixed_path($path);
 
152
    $input= mixed_path($input);
 
153
    $output= mixed_path($output);
 
154
    $error= mixed_path($error);
 
155
  }
 
156
 
 
157
  my @safe_args;
 
158
  my ($safe_path, $safe_script)= @safe_process_cmd;
 
159
  push(@safe_args, $safe_script) if defined $safe_script;
 
160
 
 
161
  push(@safe_args, "--verbose") if $verbose > 0;
 
162
  push(@safe_args, "--nocore") if $nocore;
 
163
 
 
164
  # Point the safe_process at the right parent if running on cygwin
 
165
  push(@safe_args, "--parent-pid=".Cygwin::pid_to_winpid($$)) if IS_CYGWIN;
 
166
 
 
167
  foreach my $env_var (@$envs) {
 
168
    croak("Missing = in env string") unless $env_var =~ /=/;
 
169
    croak("Env string $env_var seen, probably missing value for --mysqld-env")
 
170
      if $env_var =~ /^--/;
 
171
    push @safe_args, "--env $env_var";
 
172
  }
 
173
 
 
174
  push(@safe_args, "--");
 
175
  push(@safe_args, $path); # The program safe_process should execute
 
176
 
 
177
  if ($start_exit) {     # Bypass safe_process instead, start program directly
 
178
    @safe_args= ();
 
179
    $safe_path= $path;
 
180
  }
 
181
  push(@safe_args, @$$args);
 
182
 
 
183
  print "### safe_path: ", $safe_path, " ", join(" ", @safe_args), "\n"
 
184
    if $verbose > 1;
 
185
 
 
186
  my $pid= create_process(
 
187
                          path      => $safe_path,
 
188
                          input     => $input,
 
189
                          output    => $output,
 
190
                          error     => $error,
 
191
                          append    => $opts{append},
 
192
                          args      => \@safe_args,
 
193
                         );
 
194
 
 
195
  my $name     = delete($opts{'name'}) || "SafeProcess$pid";
 
196
  my $proc= bless
 
197
    ({
 
198
      SAFE_PID  => $pid,
 
199
      SAFE_WINPID  => $pid, # Inidicates this is always a real process
 
200
      SAFE_NAME => $name,
 
201
      SAFE_SHUTDOWN => $shutdown,
 
202
      PARENT => $$,
 
203
      SAFE_USER_DATA => $user_data,
 
204
     }, $class);
 
205
 
 
206
  # Put the new process in list of running
 
207
  $running{$pid}= $proc;
 
208
  return $proc;
 
209
 
 
210
}
 
211
 
 
212
 
 
213
sub run {
 
214
  my $proc= new(@_);
 
215
  $proc->wait_one();
 
216
  return $proc->exit_status();
 
217
}
 
218
 
 
219
#
 
220
# Shutdown process nicely, and wait for shutdown_timeout seconds
 
221
# If processes hasn't shutdown, kill them hard and wait for return
 
222
#
 
223
sub shutdown {
 
224
  my $shutdown_timeout= shift;
 
225
  my @processes= @_;
 
226
  _verbose("shutdown, timeout: $shutdown_timeout, @processes");
 
227
 
 
228
  return if (@processes == 0);
 
229
 
 
230
  # Call shutdown function if process has one, else
 
231
  # use kill
 
232
  foreach my $proc (@processes){
 
233
    _verbose("  proc: $proc");
 
234
    my $shutdown= $proc->{SAFE_SHUTDOWN};
 
235
    if ($shutdown_timeout > 0 and defined $shutdown){
 
236
      $shutdown->();
 
237
      $proc->{WAS_SHUTDOWN}= 1;
 
238
    }
 
239
    else {
 
240
      $proc->start_kill();
 
241
    }
 
242
  }
 
243
 
 
244
  my @kill_processes= ();
 
245
 
 
246
  # Wait max shutdown_timeout seconds for those process
 
247
  # that has been shutdown
 
248
  foreach my $proc (@processes){
 
249
    next unless $proc->{WAS_SHUTDOWN};
 
250
    my $ret= $proc->wait_one($shutdown_timeout);
 
251
    if ($ret != 0) {
 
252
      push(@kill_processes, $proc);
 
253
    }
 
254
    # Only wait for the first process with shutdown timeout
 
255
    $shutdown_timeout= 0;
 
256
  }
 
257
 
 
258
  # Wait infinitely for those process
 
259
  # that has been killed
 
260
  foreach my $proc (@processes){
 
261
    next if $proc->{WAS_SHUTDOWN};
 
262
    my $ret= $proc->wait_one(undef);
 
263
    if ($ret != 0) {
 
264
      warn "Wait for killed process failed!";
 
265
      push(@kill_processes, $proc);
 
266
      # Try one more time, best option...
 
267
    }
 
268
  }
 
269
 
 
270
  # Return if all servers has exited
 
271
  return if (@kill_processes == 0);
 
272
 
 
273
  foreach my $proc (@kill_processes){
 
274
    $proc->start_kill();
 
275
  }
 
276
 
 
277
  foreach my $proc (@kill_processes){
 
278
    $proc->wait_one(undef);
 
279
  }
 
280
 
 
281
  return;
 
282
}
 
283
 
 
284
 
 
285
sub _winpid ($) {
 
286
  my ($pid)= @_;
 
287
 
 
288
  # In win32 perl, the pid is already the winpid
 
289
  return $pid unless IS_CYGWIN;
 
290
 
 
291
  # In cygwin, the pid is the pseudo process ->
 
292
  # get the real winpid of my_safe_process
 
293
  return Cygwin::pid_to_winpid($pid);
 
294
}
 
295
 
 
296
 
 
297
#
 
298
# Tell the process to die as fast as possible
 
299
#
 
300
sub start_kill {
 
301
  my ($self)= @_;
 
302
  croak "usage: \$safe_proc->start_kill()" unless (@_ == 1 and ref $self);
 
303
  _verbose("start_kill: $self");
 
304
  my $ret= 1;
 
305
 
 
306
  my $pid= $self->{SAFE_PID};
 
307
  die "INTERNAL ERROR: no pid" unless defined $pid;
 
308
 
 
309
  if (IS_WINDOWS and defined $self->{SAFE_WINPID})
 
310
  {
 
311
    die "INTERNAL ERROR: no safe_kill" unless defined $safe_kill;
 
312
 
 
313
    my $winpid= _winpid($pid);
 
314
    $ret= system($safe_kill, $winpid) >> 8;
 
315
 
 
316
    if ($ret == 3){
 
317
      print "Couldn't open the winpid: $winpid ".
 
318
        "for pid: $pid, try one more time\n";
 
319
      sleep(1);
 
320
      $winpid= _winpid($pid);
 
321
      $ret= system($safe_kill, $winpid) >> 8;
 
322
      print "Couldn't open the winpid: $winpid ".
 
323
        "for pid: $pid, continue and see what happens...\n";
 
324
    }
 
325
  }
 
326
  else
 
327
  {
 
328
    $pid= $self->{SAFE_PID};
 
329
    die "Can't kill not started process" unless defined $pid;
 
330
    $ret= kill("TERM", $pid);
 
331
  }
 
332
 
 
333
  return $ret;
 
334
}
 
335
 
 
336
 
 
337
sub dump_core {
 
338
  my ($self)= @_;
 
339
  return if IS_WINDOWS;
 
340
  my $pid= $self->{SAFE_PID};
 
341
  die "Can't cet core from not started process" unless defined $pid;
 
342
  _verbose("Sending ABRT to $self");
 
343
  kill ("ABRT", $pid);
 
344
  return 1;
 
345
}
 
346
 
 
347
 
 
348
#
 
349
# Kill the process as fast as possible
 
350
# and wait for it to return
 
351
#
 
352
sub kill {
 
353
  my ($self)= @_;
 
354
  croak "usage: \$safe_proc->kill()" unless (@_ == 1 and ref $self);
 
355
 
 
356
  $self->start_kill();
 
357
  $self->wait_one();
 
358
  return 1;
 
359
}
 
360
 
 
361
 
 
362
sub _collect {
 
363
  my ($self, $exit_code)= @_;
 
364
 
 
365
  $self->{EXIT_STATUS}= $exit_code;
 
366
  _verbose("_collect: $self");
 
367
 
 
368
  # Take the process out of running list
 
369
  my $pid= $self->{SAFE_PID};
 
370
  die unless delete($running{$pid});
 
371
}
 
372
 
 
373
 
 
374
# Wait for process to exit
 
375
# optionally with a timeout
 
376
#
 
377
# timeout
 
378
#   undef -> wait blocking infinitely
 
379
#   0     -> just poll with WNOHANG
 
380
#   >0    -> wait blocking for max timeout seconds
 
381
#
 
382
# RETURN VALUES
 
383
#  0 Not running
 
384
#  1 Still running
 
385
#
 
386
sub wait_one {
 
387
  my ($self, $timeout)= @_;
 
388
  croak "usage: \$safe_proc->wait_one([timeout])" unless ref $self;
 
389
 
 
390
  _verbose("wait_one $self, $timeout");
 
391
 
 
392
  if ( ! defined($self->{SAFE_PID}) ) {
 
393
    # No pid => not running
 
394
    _verbose("No pid => not running");
 
395
    return 0;
 
396
  }
 
397
 
 
398
  if ( defined $self->{EXIT_STATUS} ) {
 
399
    # Exit status already set => not running
 
400
    _verbose("Exit status already set => not running");
 
401
    return 0;
 
402
  }
 
403
 
 
404
  my $pid= $self->{SAFE_PID};
 
405
 
 
406
  my $use_alarm;
 
407
  my $blocking;
 
408
  if (defined $timeout)
 
409
  {
 
410
    if ($timeout == 0)
 
411
    {
 
412
      # 0 -> just poll with WNOHANG
 
413
      $blocking= 0;
 
414
      $use_alarm= 0;
 
415
    }
 
416
    else
 
417
    {
 
418
      # >0 -> wait blocking for max timeout seconds
 
419
      $blocking= 1;
 
420
      $use_alarm= 1;
 
421
    }
 
422
  }
 
423
  else
 
424
  {
 
425
    # undef -> wait blocking infinitely
 
426
    $blocking= 1;
 
427
    $use_alarm= 0;
 
428
  }
 
429
  #_verbose("blocking: $blocking, use_alarm: $use_alarm");
 
430
 
 
431
  my $retpid;
 
432
  my $exit_code;
 
433
  eval
 
434
  {
 
435
    # alarm should break the wait
 
436
    local $SIG{ALRM}= sub { die "waitpid timeout"; };
 
437
 
 
438
    alarm($timeout) if $use_alarm;
 
439
 
 
440
    $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG);
 
441
    $exit_code= $?;
 
442
 
 
443
    alarm(0) if $use_alarm;
 
444
  };
 
445
 
 
446
  if ($@)
 
447
  {
 
448
    die "Got unexpected: $@" if ($@ !~ /waitpid timeout/);
 
449
    if (!defined $retpid) {
 
450
      # Got timeout
 
451
      _verbose("Got timeout");
 
452
      return 1;
 
453
    }
 
454
    # Got pid _and_ alarm, continue
 
455
    _verbose("Got pid and alarm, continue");
 
456
  }
 
457
 
 
458
  if ( $retpid == 0 ) {
 
459
    # 0 => still running
 
460
    _verbose("0 => still running");
 
461
    return 1;
 
462
  }
 
463
 
 
464
  if ( not $blocking and $retpid == -1 ) {
 
465
    # still running
 
466
    _verbose("still running");
 
467
    return 1;
 
468
  }
 
469
 
 
470
  #warn "wait_one: expected pid $pid but got $retpid"
 
471
  #  unless( $retpid == $pid );
 
472
 
 
473
  $self->_collect($exit_code);
 
474
  return 0;
 
475
}
 
476
 
 
477
 
 
478
#
 
479
# Wait for any process to exit
 
480
#
 
481
# Returns a reference to the SafeProcess that
 
482
# exited or undefined
 
483
#
 
484
sub wait_any {
 
485
  my $ret_pid;
 
486
  my $exit_code;
 
487
 
 
488
  if (IS_WIN32PERL) {
 
489
    # Can't wait for -1 => use a polling loop
 
490
    do {
 
491
      Win32::Sleep(10); # 10 milli seconds
 
492
      foreach my $pid (keys %running){
 
493
        $ret_pid= waitpid($pid, &WNOHANG);
 
494
        last if $pid == $ret_pid;
 
495
      }
 
496
    } while ($ret_pid == 0);
 
497
    $exit_code= $?;
 
498
  }
 
499
  else
 
500
  {
 
501
    $ret_pid= waitpid(-1, 0);
 
502
    if ($ret_pid <= 0){
 
503
      # No more processes to wait for
 
504
      print STDERR "wait_any, got invalid pid: $ret_pid\n";
 
505
      return undef;
 
506
    }
 
507
    $exit_code= $?;
 
508
  }
 
509
 
 
510
  # Look it up in "running" table
 
511
  my $proc= $running{$ret_pid};
 
512
  unless (defined $proc){
 
513
    print STDERR "Could not find pid: $ret_pid in running list\n";
 
514
    print STDERR "running: ". join(", ", keys(%running)). "\n";
 
515
    return undef;
 
516
  }
 
517
  $proc->_collect($exit_code);
 
518
  return $proc;
 
519
}
 
520
 
 
521
 
 
522
#
 
523
# Wait for any process to exit, or a timeout
 
524
#
 
525
# Returns a reference to the SafeProcess that
 
526
# exited or a pseudo-process with $proc->{timeout} == 1
 
527
#
 
528
 
 
529
sub wait_any_timeout {
 
530
  my $class= shift;
 
531
  my $timeout= shift;
 
532
  my $proc;
 
533
  my $millis=10;
 
534
 
 
535
  do {
 
536
    ::mtr_milli_sleep($millis);
 
537
    # Slowly increse interval up to max. 1 second
 
538
    $millis++ if $millis < 1000;
 
539
    # Return a "fake" process for timeout
 
540
    if (::has_expired($timeout)) {
 
541
      $proc= bless
 
542
        ({
 
543
          SAFE_PID  => 0,
 
544
          SAFE_NAME => "timer",
 
545
          timeout => 1,
 
546
         }, $class);
 
547
    } else {
 
548
      $proc= check_any();
 
549
    }
 
550
  } while (! $proc);
 
551
 
 
552
  return $proc;
 
553
}
 
554
 
 
555
 
 
556
#
 
557
# Wait for all processes to exit
 
558
#
 
559
sub wait_all {
 
560
  while(keys %running)
 
561
  {
 
562
    wait_any();
 
563
  }
 
564
}
 
565
 
 
566
#
 
567
# Set global flag to tell all safe_process to exit after starting child
 
568
#
 
569
 
 
570
sub start_exit {
 
571
  $start_exit= 1;
 
572
}
 
573
 
 
574
#
 
575
# Check if any process has exited, but don't wait.
 
576
#
 
577
# Returns a reference to the SafeProcess that
 
578
# exited or undefined
 
579
#
 
580
sub check_any {
 
581
  for my $proc (values %running){
 
582
    if ( $proc->is_child($$) ) {
 
583
      if (not $proc->wait_one(0)) {
 
584
        _verbose ("Found exited $proc");
 
585
        return $proc;
 
586
      }
 
587
    }
 
588
  }
 
589
  return undef;
 
590
}
 
591
 
 
592
 
 
593
# Overload string operator
 
594
# and fallback to default functions if no
 
595
# overloaded function is found
 
596
#
 
597
use overload
 
598
  '""' => \&self2str,
 
599
  fallback => 1;
 
600
 
 
601
 
 
602
#
 
603
# Return the process as a nicely formatted string
 
604
#
 
605
sub self2str {
 
606
  my ($self)= @_;
 
607
  my $pid=  $self->{SAFE_PID};
 
608
  my $winpid=  $self->{SAFE_WINPID};
 
609
  my $name= $self->{SAFE_NAME};
 
610
  my $exit_status= $self->{EXIT_STATUS};
 
611
 
 
612
  my $str= "[$name - pid: $pid";
 
613
  $str.= ", winpid: $winpid"      if defined $winpid;
 
614
  $str.= ", exit: $exit_status"   if defined $exit_status;
 
615
  $str.= "]";
 
616
}
 
617
 
 
618
sub _verbose {
 
619
  return unless $_verbose;
 
620
  print STDERR " ## ". @_. "\n";
 
621
}
 
622
 
 
623
 
 
624
sub pid {
 
625
  my ($self)= @_;
 
626
  return $self->{SAFE_PID};
 
627
}
 
628
 
 
629
sub user_data {
 
630
  my ($self)= @_;
 
631
  return $self->{SAFE_USER_DATA};
 
632
}
 
633
 
 
634
 
 
635
1;