TAO/orbsvcs/tests/ImplRepo/kill_server/run_test.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2     & eval 'exec perl -S $0 $argv:q'
   3     if 0;
   4
   5 # -*- perl -*-
   6
   7 ###############################################################################
   8 use lib "$ENV{ACE_ROOT}/bin";
   9 use PerlACE::TestTarget;
  10 use English;
  11
  12 my $status = 0;
  13 my $imr_debug = 0;
  14 my $orb_debug = 0;
  15
  16 my $servers_count = 2;
  17 my $servers_kill_count = 1;
  18 my $signalnum = 9;
  19 my $rm2523 = 0;
  20 my $act_delay = 800; #msec
  21 my $start_delay = 0; #sec
  22 my $rm_opts = "";
  23 my $force = 0;
  24
  25 if ($#ARGV >= 0) {
  26     my $sn_set = 0;
  27     for (my $i = 0; $i <= $#ARGV; $i++) {
  28         if ($ARGV[$i] eq '-debug') {
  29             $orb_debug = 4;
  30             $imr_debug = 6;
  31         }
  32         elsif ($ARGV[$i] eq "-servers") {
  33             $i++;
  34             $servers_count = $ARGV[$i];
  35         }
  36         elsif ($ARGV[$i] eq "-servers_to_kill") {
  37             $i++;
  38             $servers_kill_count = $ARGV[$i];
  39         }
  40         elsif ($ARGV[$i] eq "-signal") {
  41             $i++;
  42             $signalnum = $ARGV[$i];
  43             $sn_set = 1;
  44         }
  45         elsif ($ARGV[$i] eq "-rm2523") {
  46             $rm2523 = 1;
  47             $signalnum = 15;
  48             $servers_count = 3;
  49         }
  50         elsif ($ARGV[$1] eq "-rm2523ol") {
  51             $rm2523 = 2;
  52             $signalnum = 15;
  53             $servers_count = 3;
  54         }
  55         elsif ($ARGV[$i] eq "-force") {
  56             $rm_opts = "-f";
  57             $force = 1;
  58         }
  59         elsif ($ARGV[$i] eq "-start_delay") {
  60             $i++;
  61             $start_delay = $ARGV[$i];
  62         }
  63         else {
  64             usage();
  65             exit 1;
  66         }
  67     }
  68     $rm_opts .= " -s $signalnum" if ($force == 1 && $sn_set == 1);
  69 }
  70
  71 #$ENV{ACE_TEST_VERBOSE} = "1";
  72
  73 my $tgt_num = 0;
  74 my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  75 my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  76 my $ti  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  77 my $cli = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  78 my @srv;
  79 for(my $i = 0; $i < $servers_count; $i++) {
  80     push (@srv, PerlACE::TestTarget::create_target (++$tgt_num)) || die "Create target $tgt_num failed\n";
  81 }
  82
  83 my $refstyle = " -ORBobjrefstyle URL";
  84 my $obj_count = ($rm2523 > 0) ? 1 : 2;
  85 my $port = 9876;
  86
  87 my $objprefix = "TestObject";
  88 my $client_wait_time = 10;
  89
  90 $imriorfile = "imr_locator.ior";
  91 $actiorfile = "imr_activator.ior";
  92 $imrlogfile = "imr.log";
  93 $actlogfile = "act.log";
  94
  95 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
  96 my $act_imriorfile = $act->LocalFile ($imriorfile);
  97 my $ti_imriorfile = $ti->LocalFile ($imriorfile);
  98 my $srv_imriorfile = $srv[0]->LocalFile ($imriorfile);
  99 my $act_actiorfile = $act->LocalFile ($actiorfile);
 100 my $imr_imrlogfile = $imr->LocalFile ($imrlogfile);
 101 my $act_actlogfile = $act->LocalFile ($actlogfile);
 102
 103 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
 104 $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
 105 $TI = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
 106
 107 $CLI = $cli->CreateProcess ("client");
 108 @SRV;
 109 my @srv_server_cmd;
 110 for(my $i = 0; $i < $servers_count; $i++) {
 111     push (@SRV, $srv[$i]->CreateProcess ("server"));
 112     my $server_cmd = $SRV[$i]->Executable();
 113     push (@srv_server_cmd, $imr->LocalFile ($server_cmd));
 114 }
 115 # Make sure the files are gone, so we can wait on them.
 116 $imr->DeleteFile ($imriorfile);
 117 $act->DeleteFile ($imriorfile);
 118 $ti->DeleteFile ($imriorfile);
 119 $srv[0]->DeleteFile ($imriorfile);
 120 $act->DeleteFile ($actiorfile);
 121 $imr->DeleteFile ($imrlogfile);
 122 $act->DeleteFile ($actlogfile);
 123
 124 my $stdout_file      = "test.out";
 125 my $stderr_file      = "test.err";
 126 my $ti_stdout_file = $ti->LocalFile ($stdout_file);
 127 my $ti_stderr_file = $ti->LocalFile ($stderr_file);
 128
 129 # Clean up after exit call
 130 END
 131 {
 132     $imr->DeleteFile ($imriorfile);
 133     $act->DeleteFile ($imriorfile);
 134     $ti->DeleteFile ($imriorfile);
 135     $srv[0]->DeleteFile ($imriorfile);
 136     $act->DeleteFile ($actiorfile);
 137
 138     $ti->DeleteFile ($stdout_file);
 139     $ti->DeleteFile ($stderr_file);
 140
 141    # Remove any stray server status files caused by aborting services
 142     unlink <*.status>;
 143 }
 144
 145 sub redirect_output()
 146 {
 147     open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
 148     open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
 149     open STDERR, '>', $ti_stderr_file;
 150     open STDOUT, '>', $ti_stdout_file;
 151 }
 152
 153 sub restore_output()
 154 {
 155     open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
 156     open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
 157 }
 158
 159 sub servers_setup ()
 160 {
 161     my $imr_args = "-v 1000 -o $imr_imriorfile -orbendpoint iiop://localhost:$port";
 162     $imr_args .= " -d $imr_debug -orbdebuglevel $orb_debug -orbverboselogging 1 -orblogfile $imr_imrlogfile" if ($imr_debug > 0);
 163     print "$imr_args \n";
 164     $IMR->Arguments ($imr_args);
 165
 166     ##### Start ImplRepo #####
 167     $IMR_status = $IMR->Spawn ();
 168     if ($IMR_status != 0) {
 169         print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 170         return 1;
 171     }
 172     if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 173         print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 174         $IMR->Kill (); $IMR->TimedWait (1);
 175         return 1;
 176     }
 177     if ($imr->GetFile ($imriorfile) == -1) {
 178         print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 179         $IMR->Kill (); $IMR->TimedWait (1);
 180         return 1;
 181     }
 182     if ($act->PutFile ($imriorfile) == -1) {
 183         print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 184         $IMR->Kill (); $IMR->TimedWait (1);
 185         return 1;
 186     }
 187     if ($ti->PutFile ($imriorfile) == -1) {
 188         print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 189         $IMR->Kill (); $IMR->TimedWait (1);
 190         return 1;
 191     }
 192     if ($srv[0]->PutFile ($imriorfile) == -1) {
 193         print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
 194         $IMR->Kill (); $IMR->TimedWait (1);
 195         return 1;
 196     }
 197
 198     my $act_args = "-l -o $act_actiorfile -ORBInitRef ImplRepoService=file://$act_imriorfile  -orbendpoint iiop://localhost:";
 199     $act_args .= " -d $imr_debug -orbdebuglevel $orb_debug -orbverboselogging 1 -orblogfile $actlogfile" if ($imr_debug > 0);
 200     $act_args .= " -delay $act_delay" if ($rm2523 > 0 && $OSNAME ne "MSWin32");
 201     $ACT->Arguments ($act_args);
 202
 203     $ACT_status = $ACT->Spawn ();
 204     if ($ACT_status != 0) {
 205         print STDERR "ERROR: ImR Activator returned $ACT_status\n";
 206         return 1;
 207     }
 208     if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
 209         print STDERR "ERROR: cannot find file <$act_imriorfile>\n";
 210         $ACT->Kill (); $ACT->TimedWait (1);
 211         $IMR->Kill (); $IMR->TimedWait (1);
 212         return 1;
 213     }
 214
 215     ##### Add servers to activator #####
 216     for(my $i = 0; $i < $servers_count; $i++) {
 217         my $status_file_name = $objprefix . "_$i.status";
 218         $srv[$i]->DeleteFile ($status_file_name);
 219         $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 220                         "add $objprefix" . '_' . $i . "_a -c \"".
 221                         $srv_server_cmd[$i].
 222                         " -ORBUseIMR 1 -n $i -d $start_delay ".
 223                         "-orbendpoint iiop://localhost: " .
 224                         "-ORBInitRef ImplRepoService=file://$srv_imriorfile\"");
 225
 226         $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 227         if ($TI_status != 0) {
 228             print STDERR "ERROR: tao_imr returned $TI_status\n";
 229             $ACT->Kill (); $ACT->TimedWait (1);
 230             $IMR->Kill (); $IMR->TimedWait (1);
 231             return 1;
 232         }
 233         if ($rm2523 > 0) {
 234             $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 235                             "link $objprefix" . '_' . $i . "_a " .
 236                             " -p $objprefix" . '_' . $i . "_b ");
 237
 238             $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 239             if ($TI_status != 0) {
 240                 print STDERR "ERROR: tao_imr returned $TI_status\n";
 241                 $ACT->Kill (); $ACT->TimedWait (1);
 242                 $IMR->Kill (); $IMR->TimedWait (1);
 243                 return 1;
 244             }
 245         }
 246     }
 247
 248     for(my $i = 0; $i < $servers_count; $i++ ) {
 249         # For some reason the servers take forever to spawn when using the activator
 250         $client_wait_time *= $obj_count;
 251
 252         if ($status == 1) {
 253             last;
 254         }
 255     }
 256
 257 }
 258
 259 sub update_manual()
 260 {
 261     my $i = 1;
 262     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 263                     "update $objprefix" . '_' . $i . "_a -a MANUAL");
 264     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 265     if ($TI_status != 0) {
 266         print STDERR "tao_imr update returned $TI_status\n";
 267     }
 268 }
 269
 270 sub update_normal()
 271 {
 272     my $i = 1;
 273     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 274                     "add $objprefix" . '_' . $i . "_a -c \"".
 275                     $srv_server_cmd[$i].
 276                     " -ORBUseIMR 1 -n $i ".
 277                     "-orbendpoint iiop://localhost: " .
 278                     "-ORBInitRef ImplRepoService=file://$srv_imriorfile\"");
 279
 280     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 281     if ($TI_status != 0) {
 282         print STDERR "tao_imr update returned $TI_status\n";
 283     }
 284 }
 285
 286 sub kill_the_one()
 287 {
 288     my $i = 1;
 289     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 290                     "kill $objprefix" . '_' . $i . "_a -s $signalnum");
 291     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 292     if ($TI_status != 0) {
 293         print STDERR "tao_imr kill returned $TI_status\n";
 294     }
 295 }
 296
 297 sub start_the_one()
 298 {
 299     my $i = 1;
 300     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 301                     "start $objprefix" . '_' . $i . "_a");
 302     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 303     if ($TI_status != 0) {
 304         print STDERR "tao_imr start returned $TI_status\n";
 305     }
 306 }
 307
 308 sub remove_entry(@)
 309 {
 310     my $obj = shift;
 311     my $i = 1;
 312     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 313                     "remove $objprefix" . '_' . $i . "_$obj $rm_opts");
 314     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 315     if ($TI_status != 0) {
 316         print STDERR "tao_imr remove $rm_opts returned $TI_status\n";
 317     }
 318 }
 319
 320 sub make_server_requests()
 321 {
 322     print "Making requests to servers\n";
 323
 324     ##### Run client against servers to active them #####
 325     for(my $i = 0; $i < $servers_count; $i++ ) {
 326         $CLI->Arguments ("-ORBInitRef Test=corbaloc::localhost:$port/$objprefix" . '_' . $i . "_a" . $debug);
 327         $CLI_status = $CLI->SpawnWaitKill ($cli->ProcessStartWaitInterval());
 328         if ($CLI_status != 0) {
 329             print STDERR "ERROR: client returned $CLI_status\n";
 330             $status = 1;
 331         }
 332     }
 333 }
 334
 335 sub trigger_the_one ()
 336 {
 337     print "Starting slow server\n";
 338
 339     my $i = 1;
 340     my $opt_arg = " -e" if ($start_delay > 0);
 341     $CLI->Arguments ("-ORBInitRef Test=corbaloc::localhost:$port/$objprefix" . '_' . $i . "_a" .
 342         $opt_arg);
 343     $CLI_status = $CLI->Spawn ($cli->ProcessStartWaitInterval());
 344     if ($CLI_status != 0) {
 345         print STDERR "ERROR: client returned $CLI_status\n";
 346         $status = 1;
 347         last;
 348     }
 349 }
 350
 351 sub wait_for_client ()
 352 {
 353     print "Wait for client exit\n" ;
 354
 355     $CLI_status = $CLI->WaitKill (10);
 356     if ($CLI_status != 0) {
 357         print STDERR "ERROR: client returned $CLI_status\n";
 358         $status = 1;
 359     }
 360 }
 361
 362 sub shutdown_servers(@)
 363 {
 364     my $start_index = shift;
 365     my $end_index = shift;
 366     my $signum = shift;
 367     for(my $i = $start_index; $i < $end_index; $i++ ) {
 368         my $status_file_name = $objprefix . "_$i.status";
 369         # Shutting down any server object within the server will shutdown the whole server
 370         $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 371                         "kill $objprefix" . '_' . $i . "_a -s $signum");
 372         $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 373         if ($TI_status != 0 && $TI_status != 5) {
 374             print STDERR "ERROR: tao_imr kill returned $TI_status\n";
 375             $status = 1;
 376         }
 377         $srv[$i]->DeleteFile ($status_file_name);
 378     }
 379 }
 380
 381 sub list_servers($)
 382 {
 383     my $list_options = shift;
 384     print "list active\n" if ($list_options eq "-a");
 385     print "list registered\n" if ($list_options eq "");
 386     print "list verbose\n" if ($list_options eq "-v");
 387     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile list $list_options");
 388     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 389     if ($TI_status != 0) {
 390         print STDERR "tao_imr list returned $TI_status\n";
 391     }
 392 }
 393
 394 sub count_active_servers($)
 395 {
 396     my $list_options = shift;
 397     my $start_time = time();
 398     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile list $list_options");
 399     # Redirect output so we can count number of lines in output
 400     redirect_output();
 401     $result = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 402     my $list_time = time() - $start_time;
 403     restore_output();
 404     if ($result != 0) {
 405         print STDERR "ERROR: tao_imr returned $TI_status\n";
 406         $ACT->Kill (); $ACT->TimedWait (1);
 407         $IMR->Kill (); $IMR->TimedWait (1);
 408         return 1;
 409     }
 410     open (FILE, $stderr_file) or die "Can't open $stderr_file: $!";
 411     $active_servers = 0;
 412     while (<FILE>) {
 413         print STDERR $_;
 414         $active_servers++;
 415     }
 416     close FILE;
 417     print STDERR "List took $list_time seconds.\n";
 418     return $active_servers;
 419 }
 420
 421
 422 sub rm2523_update_test
 423 {
 424     print "Running slow activator kill test with $servers_count servers \n";
 425
 426     my $result = 0;
 427     my $start_time = time();
 428     servers_setup();
 429
 430     print "make server requests\n";
 431     make_server_requests();
 432     list_servers("-a");
 433
 434     print "kill then start the server twice\n";
 435     kill_the_one();
 436     trigger_the_one ();
 437     start_the_one ();
 438     print "pausing 2 seconds\n";
 439     sleep (2);
 440     wait_for_client ();
 441     shutdown_servers (0, $servers_count, 9);
 442
 443     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 444     if ($ACT_status != 0) {
 445         print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 446         $status = 1;
 447     }
 448
 449     my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 450     if ($IMR_status != 0) {
 451         print STDERR "ERROR: IMR returned $IMR_status\n";
 452         $status = 1;
 453     }
 454
 455 }
 456
 457
 458 sub rm2523_test
 459 {
 460     print "Running slow activator kill test with $servers_count servers \n";
 461
 462     my $result = 0;
 463     my $start_time = time();
 464     servers_setup();
 465
 466     if ($start_delay == 0) {
 467         make_server_requests();
 468         list_servers("-a");
 469
 470         if ($force == 0) {
 471             print "Update to manual\n";
 472             update_manual();
 473             list_servers("-v");
 474
 475             print "kill the one\n";
 476             kill_the_one();
 477             list_servers("");
 478
 479             print "remove primary\n";
 480         }
 481         else {
 482             print "force remove primary\n";
 483         }
 484         remove_entry("a");
 485         list_servers("");
 486
 487         sleep 1;
 488
 489         print "kill the one again\n";
 490         kill_the_one();
 491         list_servers("");
 492
 493         print "re-add entry\n";
 494         update_normal();
 495         list_servers("");
 496
 497         print "start the server\n";
 498         start_the_one ();
 499         list_servers("-a");
 500     }
 501     else {
 502         print "start_all - total delay " . ($servers_count * $start_delay) . " seconds\n";
 503         make_server_requests ();
 504         print "kill then list\n";
 505         kill_the_one ();
 506         list_servers("");
 507         sleep 2;
 508         print "triggering the one\n";
 509         trigger_the_one ();
 510         if ($force == 0) {
 511             kill_the_one ();
 512             list_servers("-a");
 513             sleep 1;
 514         }
 515         remove_entry ("a");
 516
 517         wait_for_client ();
 518     }
 519     shutdown_servers (0, $servers_count, 9);
 520
 521     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 522     if ($ACT_status != 0) {
 523         print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 524         $status = 1;
 525     }
 526
 527     my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 528     if ($IMR_status != 0) {
 529         print STDERR "ERROR: IMR returned $IMR_status\n";
 530         $status = 1;
 531     }
 532
 533 }
 534
 535 sub servers_kill_test
 536 {
 537     print "Running server kill test with $servers_count servers and $obj_count objects.\n";
 538
 539     my $result = 0;
 540     my $start_time = time();
 541     servers_setup();
 542
 543     # Make sure servers are active whether activator is used or not by making
 544     # CORBA requests.
 545     make_server_requests();
 546
 547     print "\nList of active servers before killing server(s)\n";
 548     $active_servers_before_kill = count_active_servers("-a");
 549
 550     # Kill servers and verify listing of active servers is correct.
 551     print "\nKilling $servers_kill_count servers\n";
 552
 553     shutdown_servers (0, $servers_kill_count, $signalnum);
 554     sleep (4);
 555
 556     print "\nList of active servers after killing a server\n";
 557     $active_servers_after_kill = count_active_servers ("-a");
 558     if ($active_servers_after_kill != $active_servers_before_kill - $servers_kill_count) {
 559         print STDERR
 560             "ERROR: Excepted list of active servers after killing ".
 561             "a server to be " . ($active_servers_before_kill -  $servers_kill_count) .
 562             " but was $active_servers_after_kill\n";
 563         $status = 1;
 564     }
 565
 566     print "\n";
 567     shutdown_servers ($servers_kill_count, $servers_count, 9);
 568
 569     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 570     if ($ACT_status != 0) {
 571         print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 572         $status = 1;
 573     }
 574
 575     my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 576     if ($IMR_status != 0) {
 577         print STDERR "ERROR: IMR returned $IMR_status\n";
 578         $status = 1;
 579     }
 580
 581     my $test_time = time() - $start_time;
 582
 583     print "\nFinished. The test took $test_time seconds.\n";
 584
 585     return $status;
 586 }
 587
 588 sub usage() {
 589     print "Usage: run_test.pl ".
 590         "[-servers <num=$servers_count>] ".
 591         "[-servers_to_kill <num=$servers_kill_count>]\n";
 592 }
 593
 594 ###############################################################################
 595 ###############################################################################
 596 my $ret = ($rm2523 > 0) ?
 597     ($rm2523 == 1) ? rm2523_test () : rm2523_update_test()
 598     : servers_kill_test();
 599 exit $ret;