← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/lib/dtr_process.pl

  • Committer: Stewart Smith
  • Date: 2010-08-12 16:48:46 UTC
  • mto: This revision was merged to the branch mainline in revision 1707.
  • Revision ID: stewart@flamingspork.com-20100812164846-s9bhy47g60bvqs41
https://launchpad.net/bugs/611379
bug lp:611379 Equivalent queries with Impossible where return different results

The following two equivalent queries return different results in maria 5.2 and 5.3 (and identical results in mysql 5.5.5) :

SELECT SUM( DISTINCT table1 .`pk` ) FROM B table1 STRAIGHT_JOIN ( BB table2 JOIN CC ON table2 .`col_varchar_key` ) ON table2 .`pk` ;

SELECT * FROM ( SELECT SUM( DISTINCT table1 .`pk` ) FROM B table1 STRAIGHT_JOIN ( BB table2 JOIN CC ON table2 .`col_varchar_key` ) ON table2 .`pk` );

MariaDB returns 0 on the second query and NULL on the first, whereas MySQL returns NULL on both. In MariaDB, both EXPLAIN plans agree that "Impossible WHERE noticed after reading const tables"



We have some slightly different output in drizzle:

main.bug_lp611379 [ fail ]
drizzletest: At line 9: query 'explain select * from (select sum(distinct t1.a) from t1,t2 where t1.a=t2.a)
as t' failed: 1048: Column 'sum(distinct t1.a)' cannot be null

but the fix gets us the correct query results, although with slightly different execution plans.



This fix is directly ported from MariaDB.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/lib/dtr_process.pl
1
 
# -*- cperl -*-
2
 
# Copyright (C) 2004-2006 MySQL AB
3
 
# 
4
 
# This program is free software; you can redistribute it and/or modify
5
 
# it under the terms of the GNU General Public License as published by
6
 
# the Free Software Foundation; version 2 of the License.
7
 
# 
8
 
# This program is distributed in the hope that it will be useful,
9
 
# but WITHOUT ANY WARRANTY; without even the implied warranty of
10
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11
 
# GNU General Public License for more details.
12
 
# 
13
 
# You should have received a copy of the GNU General Public License
14
 
# along with this program; if not, write to the Free Software
15
 
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
16
 
 
17
 
# This is a library file used by the Perl version of drizzle-test-run,
18
 
# and is part of the translation of the Bourne shell script with the
19
 
# same name.
20
 
 
21
 
use Socket;
22
 
use Errno;
23
 
use strict;
24
 
 
25
 
use POSIX qw(WNOHANG SIGHUP);
26
 
 
27
 
sub dtr_run ($$$$$$;$);
28
 
sub dtr_spawn ($$$$$$;$);
29
 
sub dtr_check_stop_servers ($);
30
 
sub dtr_kill_leftovers ();
31
 
sub dtr_wait_blocking ($);
32
 
sub dtr_record_dead_children ();
33
 
sub dtr_ndbmgm_start($$);
34
 
sub dtr_exit ($);
35
 
sub sleep_until_file_created ($$$);
36
 
sub dtr_kill_processes ($);
37
 
sub dtr_ping_with_timeout($);
38
 
sub dtr_ping_port ($);
39
 
 
40
 
# Local function
41
 
sub spawn_impl ($$$$$$$);
42
 
 
43
 
##############################################################################
44
 
#
45
 
#  Execute an external command
46
 
#
47
 
##############################################################################
48
 
 
49
 
sub dtr_run ($$$$$$;$) {
50
 
  my $path=       shift;
51
 
  my $arg_list_t= shift;
52
 
  my $input=      shift;
53
 
  my $output=     shift;
54
 
  my $error=      shift;
55
 
  my $pid_file=   shift; # Not used
56
 
  my $spawn_opts= shift;
57
 
 
58
 
  return spawn_impl($path,$arg_list_t,'run',$input,$output,$error,
59
 
    $spawn_opts);
60
 
}
61
 
 
62
 
sub dtr_run_test ($$$$$$;$) {
63
 
  my $path=       shift;
64
 
  my $arg_list_t= shift;
65
 
  my $input=      shift;
66
 
  my $output=     shift;
67
 
  my $error=      shift;
68
 
  my $pid_file=   shift; # Not used
69
 
  my $spawn_opts= shift;
70
 
 
71
 
  return spawn_impl($path,$arg_list_t,'test',$input,$output,$error,
72
 
    $spawn_opts);
73
 
}
74
 
 
75
 
sub dtr_spawn ($$$$$$;$) {
76
 
  my $path=       shift;
77
 
  my $arg_list_t= shift;
78
 
  my $input=      shift;
79
 
  my $output=     shift;
80
 
  my $error=      shift;
81
 
  my $pid_file=   shift; # Not used
82
 
  my $spawn_opts= shift;
83
 
 
84
 
  return spawn_impl($path,$arg_list_t,'spawn',$input,$output,$error,
85
 
    $spawn_opts);
86
 
}
87
 
 
88
 
 
89
 
 
90
 
sub spawn_impl ($$$$$$$) {
91
 
  my $path=       shift;
92
 
  my $arg_list_t= shift;
93
 
  my $mode=       shift;
94
 
  my $input=      shift;
95
 
  my $output=     shift;
96
 
  my $error=      shift;
97
 
  my $spawn_opts= shift;
98
 
 
99
 
  if ( $::opt_script_debug )
100
 
  {
101
 
    dtr_report("");
102
 
    dtr_debug("-" x 73);
103
 
    dtr_debug("STDIN  $input") if $input;
104
 
    dtr_debug("STDOUT $output") if $output;
105
 
    dtr_debug("STDERR $error") if $error;
106
 
    dtr_debug("$mode: $path ", join(" ",@$arg_list_t));
107
 
    dtr_debug("spawn options:");
108
 
    if ($spawn_opts)
109
 
    {
110
 
      foreach my $key (sort keys %{$spawn_opts})
111
 
      {
112
 
        dtr_debug("  - $key: $spawn_opts->{$key}");
113
 
      }
114
 
    }
115
 
    else
116
 
    {
117
 
      dtr_debug("  none");
118
 
    }
119
 
    dtr_debug("-" x 73);
120
 
    dtr_report("");
121
 
  }
122
 
 
123
 
  dtr_error("Can't spawn with empty \"path\"") unless defined $path;
124
 
 
125
 
 
126
 
 FORK:
127
 
  {
128
 
    my $pid= fork();
129
 
 
130
 
    if ( ! defined $pid )
131
 
    {
132
 
      if ( $! == $!{EAGAIN} )           # See "perldoc Errno"
133
 
      {
134
 
        dtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
135
 
        sleep(1);
136
 
        redo FORK;
137
 
      }
138
 
 
139
 
      dtr_error("$path ($pid) can't be forked, error: $!");
140
 
 
141
 
    }
142
 
 
143
 
    if ( $pid )
144
 
    {
145
 
      select(STDOUT) if $::glob_win32_perl;
146
 
      return spawn_parent_impl($pid,$mode,$path);
147
 
    }
148
 
    else
149
 
    {
150
 
      # Child, redirect output and exec
151
 
 
152
 
      $SIG{INT}= 'DEFAULT';         # Parent do some stuff, we don't
153
 
 
154
 
      my $log_file_open_mode = '>';
155
 
 
156
 
      if ($spawn_opts and $spawn_opts->{'append_log_file'})
157
 
      {
158
 
        $log_file_open_mode = '>>';
159
 
      }
160
 
 
161
 
      if ( $output )
162
 
      {
163
 
        if ( $::glob_win32_perl )
164
 
        {
165
 
          # Don't redirect stdout on ActiveState perl since this is
166
 
          # just another thread in the same process.
167
 
        }
168
 
        elsif ( ! open(STDOUT,$log_file_open_mode,$output) )
169
 
        {
170
 
          dtr_child_error("can't redirect STDOUT to \"$output\": $!");
171
 
        }
172
 
      }
173
 
 
174
 
      if ( $error )
175
 
      {
176
 
        if ( !$::glob_win32_perl and $output eq $error )
177
 
        {
178
 
          if ( ! open(STDERR,">&STDOUT") )
179
 
          {
180
 
            dtr_child_error("can't dup STDOUT: $!");
181
 
          }
182
 
        }
183
 
        else
184
 
        {
185
 
          if ( ! open(STDERR,$log_file_open_mode,$error) )
186
 
          {
187
 
            dtr_child_error("can't redirect STDERR to \"$error\": $!");
188
 
          }
189
 
        }
190
 
      }
191
 
 
192
 
      if ( $input )
193
 
      {
194
 
        if ( ! open(STDIN,"<",$input) )
195
 
        {
196
 
          dtr_child_error("can't redirect STDIN to \"$input\": $!");
197
 
        }
198
 
      }
199
 
 
200
 
      if ( ! exec($path,@$arg_list_t) )
201
 
      {
202
 
        dtr_child_error("failed to execute \"$path\": $!");
203
 
      }
204
 
      dtr_error("Should never come here 1!");
205
 
    }
206
 
    dtr_error("Should never come here 2!");
207
 
  }
208
 
  dtr_error("Should never come here 3!");
209
 
}
210
 
 
211
 
 
212
 
sub spawn_parent_impl {
213
 
  my $pid=  shift;
214
 
  my $mode= shift;
215
 
  my $path= shift;
216
 
 
217
 
  if ( $mode eq 'run' or $mode eq 'test' )
218
 
  {
219
 
    if ( $mode eq 'run' )
220
 
    {
221
 
      # Simple run of command, wait blocking for it to return
222
 
      my $ret_pid= waitpid($pid,0);
223
 
      if ( $ret_pid != $pid )
224
 
      {
225
 
        # The "simple" waitpid has failed, print debug info
226
 
        # and try to handle the error
227
 
        dtr_warning("waitpid($pid, 0) returned $ret_pid " .
228
 
                    "when waiting for '$path', error: '$!'");
229
 
        if ( $ret_pid == -1 )
230
 
        {
231
 
          # waitpid returned -1, that would indicate the process
232
 
          # no longer exist and waitpid couldn't wait for it.
233
 
          return 1;
234
 
        }
235
 
        dtr_error("Error handling failed");
236
 
      }
237
 
 
238
 
      return dtr_process_exit_status($?);
239
 
    }
240
 
    else
241
 
    {
242
 
      # We run drizzletest and wait for it to return. But we try to
243
 
      # catch dying drizzled processes as well.
244
 
      #
245
 
      # We do blocking waitpid() until we get the return from the
246
 
      # "drizzletest" call. But if a drizzled process dies that we
247
 
      # started, we take this as an error, and kill drizzletest.
248
 
 
249
 
 
250
 
      my $exit_value= -1;
251
 
      my $saved_exit_value;
252
 
      my $ret_pid;                      # What waitpid() returns
253
 
 
254
 
      while ( ($ret_pid= waitpid(-1,0)) != -1 )
255
 
      {
256
 
        # Someone terminated, don't know who. Collect
257
 
        # status info first before $? is lost,
258
 
        # but not $exit_value, this is flagged from
259
 
 
260
 
        my $timer_name= dtr_timer_timeout($::glob_timers, $ret_pid);
261
 
        if ( $timer_name )
262
 
        {
263
 
          if ( $timer_name eq "suite" )
264
 
          {
265
 
            # We give up here
266
 
            # FIXME we should only give up the suite, not all of the run?
267
 
            print STDERR "\n";
268
 
            dtr_error("Test suite timeout");
269
 
          }
270
 
          elsif ( $timer_name eq "testcase" )
271
 
          {
272
 
            $saved_exit_value=  63;       # Mark as timeout
273
 
            kill(9, $pid);                # Kill drizzletest
274
 
            next;                         # Go on and catch the termination
275
 
          }
276
 
        }
277
 
 
278
 
        if ( $ret_pid == $pid )
279
 
        {
280
 
          # We got termination of drizzletest, we are done
281
 
          $exit_value= dtr_process_exit_status($?);
282
 
          last;
283
 
        }
284
 
 
285
 
        # One of the child processes died, unless this was expected
286
 
        # drizzletest should be killed and test aborted
287
 
 
288
 
        check_expected_crash_and_restart($ret_pid);
289
 
      }
290
 
 
291
 
      if ( $ret_pid != $pid )
292
 
      {
293
 
        # We terminated the waiting because a "drizzled" process died.
294
 
        # Kill the drizzletest process.
295
 
        dtr_verbose("Kill drizzletest because another process died");
296
 
        kill(9,$pid);
297
 
 
298
 
        $ret_pid= waitpid($pid,0);
299
 
 
300
 
        if ( $ret_pid != $pid )
301
 
        {
302
 
          dtr_error("$path ($pid) got lost somehow");
303
 
        }
304
 
      }
305
 
 
306
 
      return $saved_exit_value || $exit_value;
307
 
    }
308
 
  }
309
 
  else
310
 
  {
311
 
    # We spawned a process we don't wait for
312
 
    return $pid;
313
 
  }
314
 
}
315
 
 
316
 
 
317
 
# ----------------------------------------------------------------------
318
 
# We try to emulate how an Unix shell calculates the exit code
319
 
# ----------------------------------------------------------------------
320
 
 
321
 
sub dtr_process_exit_status {
322
 
  my $raw_status= shift;
323
 
 
324
 
  if ( $raw_status & 127 )
325
 
  {
326
 
    return ($raw_status & 127) + 128;  # Signal num + 128
327
 
  }
328
 
  else
329
 
  {
330
 
    return $raw_status >> 8;           # Exit code
331
 
  }
332
 
}
333
 
 
334
 
 
335
 
##############################################################################
336
 
#
337
 
#  Kill processes left from previous runs
338
 
#
339
 
##############################################################################
340
 
 
341
 
 
342
 
# Kill all processes(drizzled, ndbd, ndb_mgmd and im) that would conflict with
343
 
# this run
344
 
# Make sure to remove the PID file, if any.
345
 
# kill IM manager first, else it will restart the servers
346
 
sub dtr_kill_leftovers () {
347
 
 
348
 
  dtr_report("Killing Possible Leftover Processes");
349
 
  dtr_debug("dtr_kill_leftovers(): started.");
350
 
 
351
 
  my @kill_pids;
352
 
  my %admin_pids;
353
 
 
354
 
  foreach my $srv (@{$::master}, @{$::slave})
355
 
  {
356
 
    dtr_debug("  - drizzled " .
357
 
              "(pid: $srv->{pid}; " .
358
 
              "pid file: '$srv->{path_pid}'; " .
359
 
              "socket: '$srv->{sockfile}'; ".
360
 
              "port: $srv->{port})");
361
 
 
362
 
    my $pid= dtr_server_shutdown($srv);
363
 
 
364
 
    # Save the pid of the drizzle client process
365
 
    $admin_pids{$pid}= 1;
366
 
 
367
 
    push(@kill_pids,{
368
 
                     pid      => $srv->{'pid'},
369
 
                     pidfile  => $srv->{'path_pid'},
370
 
                     sockfile => $srv->{'sockfile'},
371
 
                     port     => $srv->{'port'},
372
 
                    });
373
 
    $srv->{'pid'}= 0; # Assume we are done with it
374
 
  }
375
 
 
376
 
  # Wait for all the admin processes to complete
377
 
  dtr_wait_blocking(\%admin_pids);
378
 
 
379
 
  # If we trusted "drizzleadmin --shutdown_timeout= ..." we could just
380
 
  # terminate now, but we don't (FIXME should be debugged).
381
 
  # So we try again to ping and at least wait the same amount of time
382
 
  # drizzleadmin would for all to die.
383
 
 
384
 
  dtr_ping_with_timeout(\@kill_pids);
385
 
 
386
 
  # We now have tried to terminate nice. We have waited for the listen
387
 
  # port to be free, but can't really tell if the drizzled process died
388
 
  # or not. We now try to find the process PID from the PID file, and
389
 
  # send a kill to that process. Note that Perl let kill(0,@pids) be
390
 
  # a way to just return the numer of processes the kernel can send
391
 
  # signals to. So this can be used (except on Cygwin) to determine
392
 
  # if there are processes left running that we cound out might exists.
393
 
  #
394
 
  # But still after all this work, all we know is that we have
395
 
  # the ports free.
396
 
 
397
 
  # We scan the "var/run/" directory for other process id's to kill
398
 
 
399
 
  my $rundir= "$::opt_vardir/run";
400
 
 
401
 
  dtr_debug("Processing PID files in directory '$rundir'...");
402
 
 
403
 
  if ( -d $rundir )
404
 
  {
405
 
    opendir(RUNDIR, $rundir)
406
 
      or dtr_error("can't open directory \"$rundir\": $!");
407
 
 
408
 
    my @pids;
409
 
 
410
 
    while ( my $elem= readdir(RUNDIR) )
411
 
    {
412
 
      # Only read pid from files that end with .pid
413
 
      if ( $elem =~ /.*[.]pid$/)
414
 
      {
415
 
        my $pidfile= "$rundir/$elem";
416
 
 
417
 
        if ( -f $pidfile )
418
 
        {
419
 
          dtr_debug("Processing PID file: '$pidfile'...");
420
 
 
421
 
          my $pid= dtr_get_pid_from_file($pidfile);
422
 
 
423
 
          dtr_debug("Got pid: $pid from file '$pidfile'");
424
 
 
425
 
          if ( $::glob_cygwin_perl or kill(0, $pid) )
426
 
          {
427
 
            dtr_debug("There is process with pid $pid -- scheduling for kill.");
428
 
            push(@pids, $pid);            # We know (cygwin guess) it exists
429
 
          }
430
 
          else
431
 
          {
432
 
            dtr_debug("There is no process with pid $pid -- skipping.");
433
 
          }
434
 
        }
435
 
      }
436
 
      else
437
 
      {
438
 
        dtr_warning("Found non pid file $elem in $rundir")
439
 
          if -f "$rundir/$elem";
440
 
        next;
441
 
      }
442
 
    }
443
 
    closedir(RUNDIR);
444
 
 
445
 
    if ( @pids )
446
 
    {
447
 
      dtr_debug("Killing the following processes with PID files: " .
448
 
                join(' ', @pids) . "...");
449
 
 
450
 
      start_reap_all();
451
 
 
452
 
      if ( $::glob_cygwin_perl )
453
 
      {
454
 
        # We have no (easy) way of knowing the Cygwin controlling
455
 
        # process, in the PID file we only have the Windows process id.
456
 
        system("kill -f " . join(" ",@pids)); # Hope for the best....
457
 
        dtr_debug("Sleep 5 seconds waiting for processes to die");
458
 
        sleep(5);
459
 
      }
460
 
      else
461
 
      {
462
 
        my $retries= 10;                    # 10 seconds
463
 
        do
464
 
        {
465
 
          dtr_debug("Sending SIGKILL to pids: " . join(' ', @pids));
466
 
          kill(9, @pids);
467
 
          dtr_report("Sleep 1 second waiting for processes to die");
468
 
          sleep(1)                      # Wait one second
469
 
        } while ( $retries-- and  kill(0, @pids) );
470
 
 
471
 
        if ( kill(0, @pids) )           # Check if some left
472
 
        {
473
 
          dtr_warning("can't kill process(es) " . join(" ", @pids));
474
 
        }
475
 
      }
476
 
 
477
 
      stop_reap_all();
478
 
    }
479
 
  }
480
 
  else
481
 
  {
482
 
    dtr_debug("Directory for PID files ($rundir) does not exist.");
483
 
  }
484
 
 
485
 
  # We may have failed everything, but we now check again if we have
486
 
  # the listen ports free to use, and if they are free, just go for it.
487
 
 
488
 
  dtr_debug("Checking known drizzled servers...");
489
 
 
490
 
  foreach my $srv ( @kill_pids )
491
 
  {
492
 
    if ( defined $srv->{'port'} and dtr_ping_port($srv->{'port'}) )
493
 
    {
494
 
      dtr_warning("can't kill old process holding port $srv->{'port'}");
495
 
    }
496
 
  }
497
 
 
498
 
  dtr_debug("dtr_kill_leftovers(): finished.");
499
 
}
500
 
 
501
 
 
502
 
#
503
 
# Check that all processes in "spec" are shutdown gracefully
504
 
# else kill them off hard
505
 
#
506
 
sub dtr_check_stop_servers ($) {
507
 
  my $spec=  shift;
508
 
 
509
 
  # Return if no processes are defined
510
 
  return if ! @$spec;
511
 
 
512
 
  dtr_verbose("dtr_check_stop_servers");
513
 
 
514
 
  # ----------------------------------------------------------------------
515
 
  # Wait until servers in "spec" has stopped listening
516
 
  # to their ports or timeout occurs
517
 
  # ----------------------------------------------------------------------
518
 
  dtr_ping_with_timeout(\@$spec);
519
 
 
520
 
  # ----------------------------------------------------------------------
521
 
  # Use waitpid() nonblocking for a little while, to see how
522
 
  # many process's will exit sucessfully.
523
 
  # This is the normal case.
524
 
  # ----------------------------------------------------------------------
525
 
  my $wait_counter= 10; # Max number of times to redo the loop
526
 
  foreach my $srv ( @$spec )
527
 
  {
528
 
    my $pid= $srv->{'pid'};
529
 
    my $ret_pid;
530
 
    if ( $pid )
531
 
    {
532
 
      $ret_pid= waitpid($pid,&WNOHANG);
533
 
      if ($ret_pid == $pid)
534
 
      {
535
 
        dtr_verbose("Caught exit of process $ret_pid");
536
 
        $srv->{'pid'}= 0;
537
 
      }
538
 
      elsif ($ret_pid == 0)
539
 
      {
540
 
        dtr_verbose("Process $pid is still alive");
541
 
        if ($wait_counter-- > 0)
542
 
        {
543
 
          # Give the processes more time to exit
544
 
          select(undef, undef, undef, (1));
545
 
          redo;
546
 
        }
547
 
      }
548
 
      else
549
 
      {
550
 
        dtr_warning("caught exit of unknown child $ret_pid");
551
 
      }
552
 
    }
553
 
  }
554
 
 
555
 
  # ----------------------------------------------------------------------
556
 
  # The processes that haven't yet exited need to
557
 
  # be killed hard, put them in "kill_pids" hash
558
 
  # ----------------------------------------------------------------------
559
 
  my %kill_pids;
560
 
  foreach my $srv ( @$spec )
561
 
  {
562
 
    my $pid= $srv->{'pid'};
563
 
    if ( $pid )
564
 
    {
565
 
      # Server is still alive, put it in list to be hard killed
566
 
      if ($::glob_win32_perl)
567
 
      {
568
 
        # Kill the real process if it's known
569
 
        $pid= $srv->{'real_pid'} if ($srv->{'real_pid'});
570
 
      }
571
 
      $kill_pids{$pid}= 1;
572
 
 
573
 
      # Write a message to the process's error log (if it has one)
574
 
      # that it's being killed hard.
575
 
      if ( defined $srv->{'errfile'} )
576
 
      {
577
 
        dtr_tofile($srv->{'errfile'}, "Note: Forcing kill of process $pid\n");
578
 
      }
579
 
      dtr_warning("Forcing kill of process $pid");
580
 
 
581
 
    }
582
 
    else
583
 
    {
584
 
      # Server is dead, remove the pidfile if it exists
585
 
      #
586
 
      # Race, could have been removed between test with -f
587
 
      # and the unlink() below, so better check again with -f
588
 
      if ( -f $srv->{'pidfile'} and ! unlink($srv->{'pidfile'}) and
589
 
           -f $srv->{'pidfile'} )
590
 
      {
591
 
        dtr_error("can't remove $srv->{'pidfile'}");
592
 
      }
593
 
      if ( -f $srv->{'sockfile'} and ! unlink($srv->{'sockfile'}) and
594
 
           -f $srv->{'sockfile'} )
595
 
      {
596
 
        dtr_error("can't remove $srv->{'sockfile'}");
597
 
      }
598
 
    }
599
 
  }
600
 
 
601
 
  if ( ! keys %kill_pids )
602
 
  {
603
 
    # All processes has exited gracefully
604
 
    return;
605
 
  }
606
 
 
607
 
  dtr_kill_processes(\%kill_pids);
608
 
 
609
 
  # ----------------------------------------------------------------------
610
 
  # All processes are killed, cleanup leftover files
611
 
  # ----------------------------------------------------------------------
612
 
  {
613
 
    my $errors= 0;
614
 
    foreach my $srv ( @$spec )
615
 
    {
616
 
      if ( $srv->{'sockfile'} )
617
 
      {
618
 
        unlink($srv->{'sockfile'});
619
 
      }
620
 
      if ( $srv->{'pid'} )
621
 
      {
622
 
        # Server has been hard killed, clean it's resources
623
 
        foreach my $file ($srv->{'pidfile'}, $srv->{'sockfile'})
624
 
        {
625
 
          # Know it is dead so should be no race, careful anyway
626
 
          if ( defined $file and -f $file and ! unlink($file) and -f $file )
627
 
          {
628
 
            $errors++;
629
 
            dtr_warning("couldn't delete $file");
630
 
          }
631
 
        }
632
 
 
633
 
        if ($::glob_win32_perl and $srv->{'real_pid'})
634
 
        {
635
 
          # Wait for the pseudo pid - if the real_pid was known
636
 
          # the pseudo pid has not been waited for yet, wai blocking
637
 
          # since it's "such a simple program"
638
 
          dtr_verbose("Wait for pseudo process $srv->{'pid'}");
639
 
          my $ret_pid= waitpid($srv->{'pid'}, 0);
640
 
          dtr_verbose("Pseudo process $ret_pid died");
641
 
        }
642
 
 
643
 
        $srv->{'pid'}= 0;
644
 
      }
645
 
    }
646
 
    if ( $errors )
647
 
    {
648
 
      # There where errors killing processes
649
 
      # do one last attempt to ping the servers
650
 
      # and if they can't be pinged, assume they are dead
651
 
      if ( ! dtr_ping_with_timeout( \@$spec ) )
652
 
      {
653
 
        dtr_error("we could not kill or clean up all processes");
654
 
      }
655
 
      else
656
 
      {
657
 
        dtr_verbose("All ports were free, continuing");
658
 
      }
659
 
    }
660
 
  }
661
 
}
662
 
 
663
 
 
664
 
# Wait for all the process in the list to terminate
665
 
sub dtr_wait_blocking($) {
666
 
  my $admin_pids= shift;
667
 
 
668
 
 
669
 
  # Return if no processes defined
670
 
  return if ! %$admin_pids;
671
 
 
672
 
  dtr_verbose("dtr_wait_blocking");
673
 
 
674
 
  # Wait for all the started processes to exit
675
 
  # As drizzleadmin is such a simple program, we trust it to terminate itself.
676
 
  # I.e. we wait blocking, and wait for them all before we go on.
677
 
  foreach my $pid (keys %{$admin_pids})
678
 
  {
679
 
    my $ret_pid= waitpid($pid,0);
680
 
 
681
 
  }
682
 
}
683
 
 
684
 
sub dtr_server_shutdown($) {
685
 
  my $srv= shift;
686
 
  my $args;
687
 
 
688
 
  dtr_init_args(\$args);
689
 
  dtr_add_arg($args, "--shutdown");
690
 
  dtr_add_arg($args, "--user=%s", $::opt_user);
691
 
  dtr_add_arg($args, "--password=");
692
 
  dtr_add_arg($args, "--silent");
693
 
 
694
 
  if ( $srv->{'port'} )
695
 
  {
696
 
    dtr_add_arg($args, "--port=%s", $srv->{'port'});
697
 
  }
698
 
 
699
 
  dtr_add_arg($args, "--connect-timeout=5");
700
 
 
701
 
  my $pid= dtr_spawn($::exe_drizzle, $args,
702
 
                     "", "", "", "", { append_log_file => 1 });
703
 
  dtr_verbose("dtr_server_shutdown, pid: $pid");
704
 
  return $pid;
705
 
}
706
 
 
707
 
# Start "ndb_mgm shutdown" for a specific cluster, it will
708
 
# shutdown all data nodes and leave the ndb_mgmd running
709
 
sub dtr_ndbmgm_start($$) {
710
 
  my $cluster= shift;
711
 
  my $command= shift;
712
 
 
713
 
  my $args;
714
 
 
715
 
  dtr_init_args(\$args);
716
 
 
717
 
  dtr_add_arg($args, "--no-defaults");
718
 
  dtr_add_arg($args, "--core");
719
 
  dtr_add_arg($args, "--try-reconnect=1");
720
 
  dtr_add_arg($args, "--ndb_connectstring=%s", $cluster->{'connect_string'});
721
 
  dtr_add_arg($args, "-e");
722
 
  dtr_add_arg($args, "$command");
723
 
 
724
 
  my $pid= dtr_spawn($::exe_ndb_mgm, $args,
725
 
                     "", "/dev/null", "/dev/null", "",
726
 
                     {});
727
 
  dtr_verbose("dtr_ndbmgm_start, pid: $pid");
728
 
  return $pid;
729
 
 
730
 
}
731
 
 
732
 
 
733
 
# Ping all servers in list, exit when none of them answers
734
 
# or when timeout has passed
735
 
sub dtr_ping_with_timeout($) {
736
 
  my $spec= shift;
737
 
  my $timeout= 200;                     # 20 seconds max
738
 
  my $res= 1;                           # If we just fall through, we are done
739
 
                                        # in the sense that the servers don't
740
 
                                        # listen to their ports any longer
741
 
 
742
 
  dtr_debug("Waiting for drizzled servers to stop...");
743
 
 
744
 
 TIME:
745
 
  while ( $timeout-- )
746
 
  {
747
 
    foreach my $srv ( @$spec )
748
 
    {
749
 
      $res= 1;                          # We are optimistic
750
 
      if ( $srv->{'pid'} and defined $srv->{'port'} )
751
 
      {
752
 
        if ( dtr_ping_port($srv->{'port'}) )
753
 
        {
754
 
          dtr_verbose("waiting for process $srv->{'pid'} to stop ".
755
 
                      "using port $srv->{'port'}");
756
 
 
757
 
          # Millisceond sleep emulated with select
758
 
          select(undef, undef, undef, (0.1));
759
 
          $res= 0;
760
 
          next TIME;
761
 
        }
762
 
        else
763
 
        {
764
 
          # Process was not using port
765
 
        }
766
 
      }
767
 
    }
768
 
    last;                               # If we got here, we are done
769
 
  }
770
 
 
771
 
  if ($res)
772
 
  {
773
 
    dtr_debug("dtr_ping_with_timeout(): All drizzled instances are down.");
774
 
  }
775
 
  else
776
 
  {
777
 
    dtr_report("dtr_ping_with_timeout(): At least one server is alive.");
778
 
  }
779
 
 
780
 
  return $res;
781
 
}
782
 
 
783
 
 
784
 
#
785
 
# Loop through our list of processes and look for and entry
786
 
# with the provided pid
787
 
# Set the pid of that process to 0 if found
788
 
#
789
 
sub mark_process_dead($)
790
 
{
791
 
  my $ret_pid= shift;
792
 
 
793
 
  foreach my $drizzled (@{$::master}, @{$::slave})
794
 
  {
795
 
    if ( $drizzled->{'pid'} eq $ret_pid )
796
 
    {
797
 
      dtr_verbose("$drizzled->{'type'} $drizzled->{'idx'} exited, pid: $ret_pid");
798
 
      $drizzled->{'pid'}= 0;
799
 
      return;
800
 
    }
801
 
  }
802
 
 
803
 
  foreach my $cluster (@{$::clusters})
804
 
  {
805
 
    if ( $cluster->{'pid'} eq $ret_pid )
806
 
    {
807
 
      dtr_verbose("$cluster->{'name'} cluster ndb_mgmd exited, pid: $ret_pid");
808
 
      $cluster->{'pid'}= 0;
809
 
      return;
810
 
    }
811
 
 
812
 
    foreach my $ndbd (@{$cluster->{'ndbds'}})
813
 
    {
814
 
      if ( $ndbd->{'pid'} eq $ret_pid )
815
 
      {
816
 
        dtr_verbose("$cluster->{'name'} cluster ndbd exited, pid: $ret_pid");
817
 
        $ndbd->{'pid'}= 0;
818
 
        return;
819
 
      }
820
 
    }
821
 
  }
822
 
  dtr_warning("mark_process_dead couldn't find an entry for pid: $ret_pid");
823
 
 
824
 
}
825
 
 
826
 
#
827
 
# Loop through our list of processes and look for and entry
828
 
# with the provided pid, if found check for the file indicating
829
 
# expected crash and restart it.
830
 
#
831
 
sub check_expected_crash_and_restart($)
832
 
{
833
 
  my $ret_pid= shift;
834
 
 
835
 
  foreach my $drizzled (@{$::master}, @{$::slave})
836
 
  {
837
 
    if ( $drizzled->{'pid'} eq $ret_pid )
838
 
    {
839
 
      dtr_verbose("$drizzled->{'type'} $drizzled->{'idx'} exited, pid: $ret_pid");
840
 
      $drizzled->{'pid'}= 0;
841
 
 
842
 
      # Check if crash expected and restart if it was
843
 
      my $expect_file= "$::opt_vardir/tmp/" . "$drizzled->{'type'}" .
844
 
        "$drizzled->{'idx'}" . ".expect";
845
 
      if ( -f $expect_file )
846
 
      {
847
 
        dtr_verbose("Crash was expected, file $expect_file exists");
848
 
        drizzled_start($drizzled, $drizzled->{'start_opts'},
849
 
                     $drizzled->{'start_slave_master_info'});
850
 
        unlink($expect_file);
851
 
      }
852
 
 
853
 
      return;
854
 
    }
855
 
  }
856
 
 
857
 
  foreach my $cluster (@{$::clusters})
858
 
  {
859
 
    if ( $cluster->{'pid'} eq $ret_pid )
860
 
    {
861
 
      dtr_verbose("$cluster->{'name'} cluster ndb_mgmd exited, pid: $ret_pid");
862
 
      $cluster->{'pid'}= 0;
863
 
 
864
 
      # Check if crash expected and restart if it was
865
 
      my $expect_file= "$::opt_vardir/tmp/ndb_mgmd_" . "$cluster->{'type'}" .
866
 
        ".expect";
867
 
      if ( -f $expect_file )
868
 
      {
869
 
        dtr_verbose("Crash was expected, file $expect_file exists");
870
 
        ndbmgmd_start($cluster);
871
 
        unlink($expect_file);
872
 
      }
873
 
      return;
874
 
    }
875
 
 
876
 
    foreach my $ndbd (@{$cluster->{'ndbds'}})
877
 
    {
878
 
      if ( $ndbd->{'pid'} eq $ret_pid )
879
 
      {
880
 
        dtr_verbose("$cluster->{'name'} cluster ndbd exited, pid: $ret_pid");
881
 
        $ndbd->{'pid'}= 0;
882
 
 
883
 
        # Check if crash expected and restart if it was
884
 
        my $expect_file= "$::opt_vardir/tmp/ndbd_" . "$cluster->{'type'}" .
885
 
          "$ndbd->{'idx'}" . ".expect";
886
 
        if ( -f $expect_file )
887
 
        {
888
 
          dtr_verbose("Crash was expected, file $expect_file exists");
889
 
          ndbd_start($cluster, $ndbd->{'idx'},
890
 
                     $ndbd->{'start_extra_args'});
891
 
          unlink($expect_file);
892
 
        }
893
 
        return;
894
 
      }
895
 
    }
896
 
  }
897
 
 
898
 
  if ($::instance_manager->{'spawner_pid'} eq $ret_pid)
899
 
  {
900
 
    return;
901
 
  }
902
 
 
903
 
  dtr_warning("check_expected_crash_and_restart couldn't find an entry for pid: $ret_pid");
904
 
 
905
 
}
906
 
 
907
 
##############################################################################
908
 
#
909
 
#  The operating system will keep information about dead children, 
910
 
#  we read this information here, and if we have records the process
911
 
#  is alive, we mark it as dead.
912
 
#
913
 
##############################################################################
914
 
 
915
 
sub dtr_record_dead_children () {
916
 
 
917
 
  my $process_died= 0;
918
 
  my $ret_pid;
919
 
 
920
 
  # Wait without blockinng to see if any processes had died
921
 
  # -1 or 0 means there are no more procesess to wait for
922
 
  while ( ($ret_pid= waitpid(-1,&WNOHANG)) != 0 and $ret_pid != -1)
923
 
  {
924
 
    dtr_warning("dtr_record_dead_children: $ret_pid");
925
 
    mark_process_dead($ret_pid);
926
 
    $process_died= 1;
927
 
  }
928
 
  return $process_died;
929
 
}
930
 
 
931
 
sub start_reap_all {
932
 
  # This causes terminating processes to not become zombies, avoiding
933
 
  # the need for (or possibility of) explicit waitpid().
934
 
  $SIG{CHLD}= 'IGNORE';
935
 
 
936
 
  # On some platforms (Linux, QNX, OSX, ...) there is potential race
937
 
  # here. If a process terminated before setting $SIG{CHLD} (but after
938
 
  # any attempt to waitpid() it), it will still be a zombie. So we
939
 
  # have to handle any such process here.
940
 
  my $pid;
941
 
  while(($pid= waitpid(-1, &WNOHANG)) != 0 and $pid != -1)
942
 
  {
943
 
    dtr_warning("start_reap_all pid: $pid");
944
 
    mark_process_dead($pid);
945
 
  };
946
 
}
947
 
 
948
 
sub stop_reap_all {
949
 
  $SIG{CHLD}= 'DEFAULT';
950
 
}
951
 
 
952
 
 
953
 
sub dtr_ping_port ($) {
954
 
  my $port= shift;
955
 
 
956
 
  dtr_verbose("dtr_ping_port: $port");
957
 
 
958
 
  my $remote= "localhost";
959
 
  my $iaddr=  inet_aton($remote);
960
 
  if ( ! $iaddr )
961
 
  {
962
 
    dtr_error("can't find IP number for $remote");
963
 
  }
964
 
  my $paddr=  sockaddr_in($port, $iaddr);
965
 
  my $proto=  getprotobyname('tcp');
966
 
  if ( ! socket(SOCK, PF_INET, SOCK_STREAM, $proto) )
967
 
  {
968
 
    dtr_error("can't create socket: $!");
969
 
  }
970
 
 
971
 
  dtr_debug("Pinging server (port: $port)...");
972
 
 
973
 
  if ( connect(SOCK, $paddr) )
974
 
  {
975
 
    close(SOCK);                        # FIXME check error?
976
 
    dtr_verbose("USED");
977
 
    return 1;
978
 
  }
979
 
  else
980
 
  {
981
 
    dtr_verbose("FREE");
982
 
    return 0;
983
 
  }
984
 
}
985
 
 
986
 
##############################################################################
987
 
#
988
 
#  Wait for a file to be created
989
 
#
990
 
##############################################################################
991
 
 
992
 
# FIXME check that the pidfile contains the expected pid!
993
 
 
994
 
sub sleep_until_file_created ($$$) {
995
 
  my $pidfile= shift;
996
 
  my $timeout= shift;
997
 
  my $pid=     shift;
998
 
  my $sleeptime= 100; # Milliseconds
999
 
  my $loops= ($timeout * 1000) / $sleeptime;
1000
 
 
1001
 
  for ( my $loop= 1; $loop <= $loops; $loop++ )
1002
 
  {
1003
 
    if ( -r $pidfile )
1004
 
    {
1005
 
      return 1;
1006
 
    }
1007
 
 
1008
 
    # Check if it died after the fork() was successful
1009
 
    if ( $pid != 0 && waitpid($pid,&WNOHANG) == $pid )
1010
 
    {
1011
 
      dtr_warning("Process $pid died");
1012
 
      return 0;
1013
 
    }
1014
 
 
1015
 
    dtr_debug("Sleep $sleeptime milliseconds waiting for $pidfile");
1016
 
 
1017
 
    # Print extra message every 60 seconds
1018
 
    my $seconds= ($loop * $sleeptime) / 1000;
1019
 
    if ( $seconds > 1 and int($seconds * 10) % 600 == 0 )
1020
 
    {
1021
 
      my $left= $timeout - $seconds;
1022
 
      dtr_warning("Waited $seconds seconds for $pidfile to be created, " .
1023
 
                  "still waiting for $left seconds...");
1024
 
    }
1025
 
 
1026
 
    # Millisceond sleep emulated with select
1027
 
    select(undef, undef, undef, ($sleeptime/1000));
1028
 
  }
1029
 
 
1030
 
  return 0;
1031
 
}
1032
 
 
1033
 
 
1034
 
sub dtr_kill_processes ($) {
1035
 
  my $pids = shift;
1036
 
 
1037
 
  dtr_verbose("dtr_kill_processes (" . join(" ", keys %{$pids}) . ")");
1038
 
 
1039
 
  foreach my $pid (keys %{$pids})
1040
 
  {
1041
 
 
1042
 
    if ($pid <= 0)
1043
 
    {
1044
 
      dtr_warning("Trying to kill illegal pid: $pid");
1045
 
      next;
1046
 
    }
1047
 
 
1048
 
    my $signaled_procs= kill(9, $pid);
1049
 
    if ($signaled_procs == 0)
1050
 
    {
1051
 
      # No such process existed, assume it's killed
1052
 
      dtr_verbose("killed $pid(no such process)");
1053
 
    }
1054
 
    else
1055
 
    {
1056
 
      my $ret_pid= waitpid($pid,0);
1057
 
      if ($ret_pid == $pid)
1058
 
      {
1059
 
        dtr_verbose("killed $pid(got the pid)");
1060
 
      }
1061
 
      elsif ($ret_pid == -1)
1062
 
      {
1063
 
        dtr_verbose("killed $pid(got -1)");
1064
 
      }
1065
 
    }
1066
 
  }
1067
 
  dtr_verbose("done killing processes");
1068
 
}
1069
 
 
1070
 
 
1071
 
##############################################################################
1072
 
#
1073
 
#  When we exit, we kill off all children
1074
 
#
1075
 
##############################################################################
1076
 
 
1077
 
sub dtr_exit ($) {
1078
 
  my $code= shift;
1079
 
  dtr_timer_stop_all($::glob_timers);
1080
 
  local $SIG{HUP} = 'IGNORE';
1081
 
  # ToDo: Signalling -$$ will only work if we are the process group
1082
 
  # leader (in fact on QNX it will signal our session group leader,
1083
 
  # which might be Do-compile or Pushbuild, causing tests to be
1084
 
  # aborted). So we only do it if we are the group leader. We might
1085
 
  # set ourselves as the group leader at startup (with
1086
 
  # POSIX::setpgrp(0,0)), but then care must be needed to always do
1087
 
  # proper child process cleanup.
1088
 
  POSIX::kill(SIGHUP, -$$) if !$::glob_win32_perl and $$ == getpgrp();
1089
 
 
1090
 
  exit($code);
1091
 
}
1092
 
 
1093
 
###########################################################################
1094
 
 
1095
 
1;