TAO/orbsvcs/tests/ImplRepo/Bug_4152_Regression/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
  11 $status = 0;
  12 $debug_level = 0;
  13 $no_dns = 0;
  14 $imrhost = "127.0.0.1";
  15 $poa_delay = 3;
  16 $shutdown_delay = 0;
  17
  18 if ($#ARGV >= 0) {
  19     for (my $i = 0; $i <= $#ARGV; $i++) {
  20         if ($ARGV[$i] eq '-debug') {
  21           $debug_level = 10;
  22         }
  23         elsif ($ARGV[$i] eq '-no_dns') {
  24             $no_dns = 1;
  25         }
  26         elsif ($ARGV[$i] eq "-s") {
  27             $i++;
  28             $shutdown_delay = $ARGV[$i];
  29         }
  30         elsif ($ARGV[$i] eq "-c") {
  31             $i++;
  32             $shutdown_delay = $ARGV[$i];
  33         }
  34         else {
  35           usage();
  36           exit 1;
  37         }
  38     }
  39 }
  40
  41 $tgt_num = 0;
  42 $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  43 $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  44 $ti  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  45 $cli = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  46 $clinw = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  47 $srv = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  48
  49 $refstyle = " -ORBobjrefstyle URL";
  50 $imrport = 9876 + $imr->RandomPort ();
  51 $imrhost = $imr->HostName () if ($no_dns == 0);
  52
  53 $statusfile = "TestObject.status";
  54 $client_wait_time = 30;
  55
  56 $imriorfile = "imr_locator.ior";
  57 $actiorfile = "imr_activator.ior";
  58
  59 $actlogfile = "act.log";
  60 $cltlogfile = "client.log";
  61 $imrlogfile = "imr.log";
  62 $srvlogfile = "server.log";
  63 $tilogfile = "ti.log";
  64
  65 $imr_imriorfile = $imr->LocalFile ($imriorfile);
  66 $act_imriorfile = $act->LocalFile ($imriorfile);
  67 $ti_imriorfile = $ti->LocalFile ($imriorfile);
  68 $srv_imriorfile = $srv->LocalFile ($imriorfile);
  69 $act_actiorfile = $act->LocalFile ($actiorfile);
  70 $srv_statusfile = $srv->LocalFile ($statusfile);
  71
  72 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
  73 $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
  74 $TI = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
  75
  76 $CLI = $cli->CreateProcess ("client");
  77 $CLINW = $clinw->CreateProcess ("client");
  78 $SRV = $srv->CreateProcess ("server");
  79 $server_cmd = $SRV->Executable();
  80 $srv_server_cmd = $imr->LocalFile ($server_cmd);
  81
  82 $ti_cmd_base = "-ORBInitRef ImplRepoService=file://$ti_imriorfile ";
  83 $ti_cmd_base .= "-ORBVerboseLogging 1 -ORBDebugLevel $debug_level -ORBLogfile $tilogfile " if ($debug_level > 0);
  84
  85 $stdout_file      = "test.out";
  86 $stderr_file      = "test.err";
  87 $ti_stdout_file = $ti->LocalFile ($stdout_file);
  88 $ti_stderr_file = $ti->LocalFile ($stderr_file);
  89
  90 sub deletefiles
  91 {
  92     my $logs_too = shift;
  93
  94     $imr->DeleteFile ($imriorfile);
  95     $act->DeleteFile ($imriorfile);
  96     $ti->DeleteFile ($imriorfile);
  97     $srv->DeleteFile ($imriorfile);
  98     $act->DeleteFile ($actiorfile);
  99
 100     $ti->DeleteFile ($stdout_file);
 101     $ti->DeleteFile ($stderr_file);
 102
 103     $res = $srv->DeleteFile ($statusfile);
 104
 105     if ($logs_too == 1) {
 106         $imr->DeleteFile ($imrlogfile);
 107         $act->DeleteFile ($actlogfile);
 108         $cli->DeleteFile ($cltlogfile);
 109         $srv->DeleteFile ($srvlogfile);
 110         $ti->DeleteFile ($tilogfile);
 111     }
 112 }
 113
 114 # Clean up after exit call
 115 END
 116 {
 117     deletefiles (0);
 118 }
 119
 120 sub redirect_output
 121 {
 122     open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
 123     open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
 124     open STDERR, '>', $ti_stderr_file;
 125     open STDOUT, '>', $ti_stdout_file;
 126 }
 127
 128 sub restore_output
 129 {
 130     open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
 131     open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
 132 }
 133
 134 sub register_server
 135 {
 136     if ($debug_level > 0) {
 137         open (my $log, '>>', $tilogfile) or die "failed to append to $tilogfile\n";
 138         say $log "\nregister server\n";
 139         close $log;
 140     }
 141
 142     my $expected = shift;
 143     my $debugarg = "-ORBVerboseLogging 1 -ORBDebugLevel $debug_level -ORBLogfile $srvlogfile" if ($debug_level > 0);
 144     my $endpointarg = "-ORBDottedDecimalAddresses 1 -ORBListenEndpoints iiop://127.0.0.1:" if ($no_dns == 1);
 145
 146     $TI->Arguments ($ti_cmd_base.
 147                     "add TestObject_a -c \"".
 148                     $srv_server_cmd .
 149                     " -ORBUseIMR 1 -p $poa_delay -s $shutdown_delay -ORBLingerTimeout 0 " .
 150                     "$debugarg $endpointarg " .
 151                     "-ORBInitRef ImplRepoService=file://$imr_imriorfile\"");
 152
 153     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 154     if ($TI_status != $expected) {
 155         print STDERR "ERROR: tao_imr returned $TI_status\n";
 156         $ACT->Kill (); $ACT->TimedWait (1);
 157         $IMR->Kill (); $IMR->TimedWait (1);
 158         $status = 1;
 159     }
 160 }
 161
 162 sub act_setup
 163 {
 164     my $debugarg = "-d 2 -ORBVerboseLogging 1 -ORBDebugLevel $debug_level -ORBLogfile $actlogfile " if ($debug_level > 0);
 165     my $endpointarg = "-ORBDottedDecimalAddresses 1 -ORBListenEndpoints iiop://127.0.0.1: " if ($no_dns == 1);
 166
 167     $ACT->Arguments ("$debugarg $endpointarg -l -delay 1500 -o $act_actiorfile ".
 168                      "-ORBInitRef ImplRepoService=file://$act_imriorfile  ");
 169
 170     $ACT_status = $ACT->Spawn ();
 171     if ($ACT_status != 0) {
 172         print STDERR "ERROR: ImR Activator returned $ACT_status\n";
 173         return 1;
 174     }
 175     if ($act->WaitForFileTimed ($actiorfile, $act->ProcessStartWaitInterval())== -1) {
 176         print STDERR "ERROR: cannot find file <$act_imriorfile>\n";
 177         $ACT->Kill (); $ACT->TimedWait (1);
 178         $IMR->Kill (); $IMR->TimedWait (1);
 179         return 1;
 180     }
 181 }
 182
 183 sub run_client
 184 {
 185     my $killit = shift;
 186     my $debugarg = "-ORBVerboseLogging 1 -ORBDebugLevel $debug_level -ORBLogfile $cltlogfile " if ($debug_level > 0);
 187     my $endpointarg = "-orbdotteddecimaladdresses 1" if ($no_dns == 1);
 188
 189     $CLI->Arguments ("-ORBInitRef Test=corbaloc::$imrhost:$imrport/TestObject_a ".
 190                      "$debugarg $endpointarg $killit");
 191
 192     $CLI_status = $CLI->SpawnWaitKill ($client_wait_time);
 193     if ($CLI_status != 0) {
 194         print STDERR "ERROR: client returned $CLI_status\n";
 195         $status = 1;
 196     }
 197 }
 198
 199 sub start_client_no_wait
 200 {
 201     my $debugarg = "-ORBVerboseLogging 1 -ORBDebugLevel $debug_level -ORBLogfile $cltlogfile " if ($debug_level > 0);
 202     my $endpointarg = "-orbdotteddecimaladdresses 1" if ($no_dns == 1);
 203
 204     $CLINW->Arguments ("-ORBInitRef Test=corbaloc::$imrhost:$imrport/TestObject_a ".
 205                        "$debugarg $endpointarg");
 206
 207     $CLINW_status = $CLINW->Spawn ();
 208     if ($CLINW_status != 0) {
 209         print STDERR "ERROR: client nw returned $CLINW_status\n";
 210         $status = 1;
 211     }
 212 }
 213
 214 sub shutdown_server
 215 {
 216     if ($debug_level > 0) {
 217         open (my $log, '>>', $tilogfile) or die "failed to append to $tilogfile\n";
 218         say $log "\nshutdown server\n";
 219         close $log;
 220     }
 221     # Shutting down any server object within the server will shutdown the whole server
 222     $TI->Arguments ($ti_cmd_base .
 223                     "shutdown TestObject_a");
 224     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 225     if ($TI_status != 0  && $TI_status != 5) {
 226         print STDERR "ERROR: tao_imr shutdown returned $TI_status\n";
 227         $status = 1;
 228     }
 229 }
 230
 231 sub manual_start_server
 232 {
 233     if ($debug_level > 0) {
 234         open (my $log, '>>', $tilogfile) or die "failed to append to $tilogfile\n";
 235         say $log "\nmanual start server\n";
 236         close $log;
 237     }
 238     # Shutting down any server object within the server will shutdown the whole server
 239     $TI->Arguments ($ti_cmd_base .
 240                     "start TestObject_a");
 241     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 242     if ($TI_status != 0) {
 243         print STDERR "ERROR: tao_imr start returned $TI_status\n";
 244         $status = 1;
 245     }
 246 }
 247
 248 sub validate_servers
 249 {
 250     open FILE, "<$statusfile";
 251     @pids = <FILE>;
 252     $count = scalar @pids;
 253     print "$statusfile has $count lines\n";
 254
 255     if ($count != 2) {
 256         print STDERR "ERROR: expected 2 server pids, got $count\n";
 257         for ($i = 0; $i < $count; $i++) {
 258             kill $pids[$i];
 259         }
 260     }
 261     close FILE;
 262     return $count != 2;
 263 }
 264
 265
 266 sub double_server_test
 267 {
 268     print "Running slow servers errant duplicate test\n";
 269     my $debugarg = "-d 10 -ORBVerboseLogging 1 -ORBDebugLevel $debug_level -ORBLogfile $imrlogfile " if ($debug_level > 0);
 270     my $endpointarg = "-orbdotteddecimaladdresses 1" if ($no_dns == 1);
 271
 272     my $result = 0;
 273     my $start_time = time();
 274     $IMR->Arguments ("$debugarg -v 800 -o $imr_imriorfile $endpointarg -ORBListenEndpoints iiop://$imrhost:$imrport");
 275
 276     ##### Start ImplRepo #####
 277     $IMR_status = $IMR->Spawn ();
 278     if ($IMR_status != 0) {
 279         print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 280         return 1;
 281     }
 282     if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 283         print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 284         $IMR->Kill (); $IMR->TimedWait (1);
 285         return 1;
 286     }
 287     if ($imr->GetFile ($imriorfile) == -1) {
 288         print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 289         $IMR->Kill (); $IMR->TimedWait (1);
 290         return 1;
 291     }
 292     if ($act->PutFile ($imriorfile) == -1) {
 293         print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 294         $IMR->Kill (); $IMR->TimedWait (1);
 295         return 1;
 296     }
 297     if ($ti->PutFile ($imriorfile) == -1) {
 298         print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 299         $IMR->Kill (); $IMR->TimedWait (1);
 300         return 1;
 301     }
 302     if ($srv->PutFile ($imriorfile) == -1) {
 303         print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
 304         $IMR->Kill (); $IMR->TimedWait (1);
 305         return 1;
 306     }
 307
 308     print "Start activator\n";
 309     act_setup();
 310
 311     print "Register server\n";
 312     register_server(0);
 313
 314     if ($status != 0) {
 315         return 1;
 316     }
 317
 318     print "Manual start\n";
 319     manual_start_server();
 320
 321     if ($status == 0) {
 322         if ($shutdown_delay = 0) {
 323           print "Initial client request to kill server\n";
 324           run_client ("-k");
 325         } else {
 326           print "Initial client request to shutdown server\n";
 327           run_client ("-s");
 328         }
 329         sleep (1);
 330
 331         print "Second client request to reactivate server \n";
 332         start_client_no_wait ();
 333
 334         print "Second shutdown of server\n";
 335         shutdown_server ();
 336
 337         print "manual start\n";
 338         manual_start_server();
 339
 340         print "Third client request should just work \n";
 341         run_client ("");
 342
 343         print "delay before shutdown\n";
 344         sleep (5);
 345
 346         print "final shutdown\n";
 347         shutdown_server ();
 348
 349         my $CLINW_status = $CLINW->TerminateWaitKill ($clinw->ProcessStopWaitInterval());
 350         if ($CLINW_status != 0) {
 351             print STDERR "ERROR: no-wait client returned $CLINW_status\n";
 352             $status = 1;
 353         }
 354     }
 355
 356     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 357     if ($ACT_status != 0) {
 358         print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 359         $status = 1;
 360     }
 361
 362     my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 363     if ($IMR_status != 0) {
 364       print STDERR "ERROR: IMR returned $IMR_status\n";
 365       $status = 1;
 366     }
 367
 368     $status = validate_servers();
 369
 370     my $test_time = time() - $start_time;
 371
 372     print "\nFinished. The test took $test_time seconds.\n";
 373
 374     return $status;
 375 }
 376
 377 sub usage() {
 378     print "Usage: run_test.pl ".
 379           "[-debug]\n";
 380 }
 381
 382 ###############################################################################
 383 ###############################################################################
 384
 385 deletefiles (1);
 386
 387 my $ret = double_server_test();
 388
 389 exit $ret;