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-1335  USA
18
19package 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 which 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
53use strict;
54use Carp;
55use POSIX qw(WNOHANG);
56
57use My::SafeProcess::Base;
58use base 'My::SafeProcess::Base';
59
60use My::Find;
61use My::Platform;
62
63my %running;
64my $_verbose= 0;
65my $start_exit= 0;
66
67END {
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
80sub 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
87our @safe_process_cmd;
88my $safe_kill;
89my $bindir;
90
91if(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}
97else
98{
99  use Cwd;
100  $bindir = getcwd();
101}
102
103# Find the safe process binary or script
104sub 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
125sub 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
213sub 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#
223sub 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
285sub _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#
300sub 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
337sub dump_core {
338  my ($self)= @_;
339  my $pid= $self->{SAFE_PID};
340  die "Can't get core from not started process" unless defined $pid;
341
342  if (IS_WINDOWS) {
343    system("$safe_kill $pid dump");
344    return 1;
345  }
346
347  _verbose("Sending ABRT to $self");
348  kill ("ABRT", $pid);
349  return 1;
350}
351
352
353#
354# Kill the process as fast as possible
355# and wait for it to return
356#
357sub kill {
358  my ($self)= @_;
359  croak "usage: \$safe_proc->kill()" unless (@_ == 1 and ref $self);
360
361  $self->start_kill();
362  $self->wait_one();
363  return 1;
364}
365
366
367sub _collect {
368  my ($self, $exit_code)= @_;
369
370  $self->{EXIT_STATUS}= $exit_code;
371  _verbose("_collect: $self");
372
373  # Take the process out of running list
374  my $pid= $self->{SAFE_PID};
375  die unless delete($running{$pid});
376}
377
378
379# Wait for process to exit
380# optionally with a timeout
381#
382# timeout
383#   undef -> wait blocking infinitely
384#   0     -> just poll with WNOHANG
385#   >0    -> wait blocking for max timeout seconds
386#
387# RETURN VALUES
388#  0 Not running
389#  1 Still running
390#
391sub wait_one {
392  my ($self, $timeout, $keep)= @_;
393  croak "usage: \$safe_proc->wait_one([timeout] [, keep])" unless ref $self;
394
395  _verbose("wait_one $self, $timeout, $keep");
396
397  if ( ! defined($self->{SAFE_PID}) ) {
398    # No pid => not running
399    _verbose("No pid => not running");
400    return 0;
401  }
402
403  if ( defined $self->{EXIT_STATUS} ) {
404    # Exit status already set => not running
405    _verbose("Exit status already set => not running");
406    return 0;
407  }
408
409  my $pid= $self->{SAFE_PID};
410
411  my $use_alarm;
412  my $blocking;
413  if (defined $timeout)
414  {
415    if ($timeout == 0)
416    {
417      # 0 -> just poll with WNOHANG
418      $blocking= 0;
419      $use_alarm= 0;
420    }
421    else
422    {
423      # >0 -> wait blocking for max timeout seconds
424      $blocking= 1;
425      $use_alarm= 1;
426    }
427  }
428  else
429  {
430    # undef -> wait blocking infinitely
431    $blocking= 1;
432    $use_alarm= 0;
433  }
434  #_verbose("blocking: $blocking, use_alarm: $use_alarm");
435
436  my $retpid;
437  my $exit_code;
438  eval
439  {
440    # alarm should break the wait
441    local $SIG{ALRM}= sub { die "waitpid timeout"; };
442
443    alarm($timeout) if $use_alarm;
444
445    $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG);
446    $exit_code= $?;
447
448    alarm(0) if $use_alarm;
449  };
450
451  if ($@)
452  {
453    die "Got unexpected: $@" if ($@ !~ /waitpid timeout/);
454    if (!defined $retpid) {
455      # Got timeout
456      _verbose("Got timeout");
457      return 1;
458    }
459    # Got pid _and_ alarm, continue
460    _verbose("Got pid and alarm, continue");
461  }
462
463  if ( $retpid == 0 ) {
464    # 0 => still running
465    _verbose("0 => still running");
466    return 1;
467  }
468
469  #if ( not $blocking and $retpid == -1 ) {
470  #  # still running
471  #  _verbose("still running");
472  #  return 1;
473  #}
474
475  #warn "wait_one: expected pid $pid but got $retpid"
476  #  unless( $retpid == $pid );
477
478  $self->_collect($exit_code) unless $keep;
479  return 0;
480}
481
482
483#
484# Wait for any process to exit
485#
486# Returns a reference to the SafeProcess that
487# exited or undefined
488#
489sub wait_any {
490  my $ret_pid;
491  my $exit_code;
492
493  if (IS_WIN32PERL) {
494    # Can't wait for -1 => use a polling loop
495    do {
496      Win32::Sleep(10); # 10 milli seconds
497      foreach my $pid (keys %running){
498	$ret_pid= waitpid($pid, &WNOHANG);
499	last if $pid == $ret_pid;
500      }
501    } while ($ret_pid == 0);
502    $exit_code= $?;
503  }
504  else
505  {
506    $ret_pid= waitpid(-1, 0);
507    if ($ret_pid <= 0){
508      # No more processes to wait for
509      print STDERR "wait_any, got invalid pid: $ret_pid\n";
510      return undef;
511    }
512    $exit_code= $?;
513  }
514
515  # Look it up in "running" table
516  my $proc= $running{$ret_pid};
517  unless (defined $proc){
518    print STDERR "Could not find pid: $ret_pid in running list\n";
519    print STDERR "running: ". join(", ", keys(%running)). "\n";
520    return undef;
521  }
522  $proc->_collect($exit_code);
523  return $proc;
524}
525
526
527#
528# Wait for any process to exit, or a timeout
529#
530# Returns a reference to the SafeProcess that
531# exited or a pseudo-process with $proc->{timeout} == 1
532#
533
534sub wait_any_timeout {
535  my $class= shift;
536  my $timeout= shift;
537  my $proc;
538  my $millis=10;
539
540  do {
541    ::mtr_milli_sleep($millis);
542    # Slowly increse interval up to max. 1 second
543    $millis++ if $millis < 1000;
544    # Return a "fake" process for timeout
545    if (::has_expired($timeout)) {
546      $proc= bless
547	({
548	  SAFE_PID  => 0,
549	  SAFE_NAME => "timer",
550	  timeout => 1,
551	 }, $class);
552    } else {
553      $proc= check_any();
554    }
555  } while (! $proc);
556
557  return $proc;
558}
559
560
561#
562# Wait for all processes to exit
563#
564sub wait_all {
565  while(keys %running)
566  {
567    wait_any();
568  }
569}
570
571#
572# Set global flag to tell all safe_process to exit after starting child
573#
574
575sub start_exit {
576  $start_exit= 1;
577}
578
579#
580# Check if any process has exited, but don't wait.
581#
582# Returns a reference to the SafeProcess that
583# exited or undefined
584#
585sub check_any {
586  for my $proc (values %running){
587    if ( $proc->is_child($$) ) {
588      if (not $proc->wait_one(0)) {
589	_verbose ("Found exited $proc");
590	return $proc;
591      }
592    }
593  }
594  return undef;
595}
596
597
598# Overload string operator
599# and fallback to default functions if no
600# overloaded function is found
601#
602use overload
603  '""' => \&self2str,
604  fallback => 1;
605
606
607#
608# Return the process as a nicely formatted string
609#
610sub self2str {
611  my ($self)= @_;
612  my $pid=  $self->{SAFE_PID};
613  my $winpid=  $self->{SAFE_WINPID};
614  my $name= $self->{SAFE_NAME};
615  my $exit_status= $self->{EXIT_STATUS};
616
617  my $str= "[$name - pid: $pid";
618  $str.= ", winpid: $winpid"      if defined $winpid;
619  $str.= ", exit: $exit_status"   if defined $exit_status;
620  $str.= "]";
621}
622
623sub _verbose {
624  return unless $_verbose;
625  print STDERR " ## @_\n";
626}
627
628
629sub pid {
630  my ($self)= @_;
631  return $self->{SAFE_PID};
632}
633
634sub user_data {
635  my ($self)= @_;
636  return $self->{SAFE_USER_DATA};
637}
638
639
6401;
641