TAO/orbsvcs/tests/ImplRepo/manual_start/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 # 1. Register server as MANUAL start
   8 # 2. Start server via tao_imr, it writes IOR and exits
   9 # 3. Run client using IOR which should fail
  10 # 4. Update server as NORMAL start
  11 # 5. Start server via tao_imr which should succeed
  12 #
  13 ###############################################################################
  14 use lib "$ENV{ACE_ROOT}/bin";
  15 use PerlACE::TestTarget;
  16
  17 $status = 0;
  18 $debuglevel = 0;
  19 $cltdbg = 1;
  20 $cltpause = 5;
  21 $kill = 0;
  22 $server_pid = 0;
  23
  24 if ($#ARGV >= 0) {
  25   for (my $i = 0; $i <= $#ARGV; $i++) {
  26     if ($ARGV[$i] eq '-debug') {
  27       $debuglevel = 10;
  28     }
  29     elsif ($ARGV[$i] eq '-cd') {
  30       $i++;
  31       $cltdbg = $ARGV[$i];
  32     }
  33     elsif ($ARGV[$i] eq '-kill') {
  34       $kill = 1;
  35       $cltpause = 5;
  36     }
  37     else {
  38       usage();
  39       exit 1;
  40     }
  41   }
  42 }
  43
  44 my $tgt_num = 0;
  45 my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  46 my $replica_imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  47 my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  48 my $ti  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  49 my $srv = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  50 my $clt = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  51
  52 my $port = 10001 + $imr->RandomPort ();
  53 my $rport = $port + 1;
  54
  55 my $imriorfile = "imr_locator.ior";
  56 my $actiorfile = "imr_activator.ior";
  57 my $primaryiorfile = "ImR_ReplicaPrimary.ior";
  58 my $backupiorfile = "ImR_ReplicaBackup.ior";
  59 my $srviorfile = "test.ior";
  60 my $persistfile = "persist.xml";
  61
  62 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
  63 my $imr_persistfile = $imr->LocalFile ($persistfile);
  64 my $act_imriorfile = $act->LocalFile ($imriorfile);
  65 my $ti_imriorfile = $ti->LocalFile ($imriorfile);
  66 my $srv_imriorfile = $srv->LocalFile ($imriorfile);
  67 my $act_actiorfile = $act->LocalFile ($actiorfile);
  68 my $srv_srviorfile = $srv->LocalFile ($srviorfile);
  69 my $clt_srviorfile = $clt->LocalFile ($srviorfile);
  70
  71 my $ti_initref = "-ORBInitRef ImplRepoService=file://$ti_imriorfile";
  72 my $act_initref = "-ORBInitRef ImplRepoService=file://$act_imriorfile";
  73
  74 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
  75 $RIMR = $replica_imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
  76 $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
  77 $TI = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
  78 $SRV = $srv->CreateProcess ("server");
  79 $CLT = $clt->CreateProcess ("client");
  80
  81 my $server_cmd = $act->LocalFile ($SRV->Executable());
  82
  83 my $imrlogfile = "imr.log";
  84 my $rimrlogfile = "replica_imr.log";
  85 my $actlogfile = "act.log";
  86 my $cltlogfile = "client.log";
  87 my $srvlogfile = "server.log";
  88
  89 my $imr_imrlogfile = $imr->LocalFile ($imrlogfile);
  90 my $act_actlogfile = $act->LocalFile ($actlogfile);
  91
  92 my $stdout_file      = "test.out";
  93 my $stderr_file      = "test.err";
  94 my $ti_stdout_file = $ti->LocalFile ($stdout_file);
  95 my $ti_stderr_file = $ti->LocalFile ($stderr_file);
  96
  97 sub delete_files
  98 {
  99     my $logs_too = shift;
 100     if ($logs_too == 1) {
 101         $imr->DeleteFile ($imrlogfile);
 102         $replica_imr->DeleteFile ($rimrlogfile);
 103         $act->DeleteFile ($actlogfile);
 104         $clt->DeleteFile ($cltlogfile);
 105         $srv->DeleteFile ($srvlogfile);
 106     }
 107     $imr->DeleteFile ($imriorfile);
 108     $imr->DeleteFile ($persistfile);
 109     $replica_imr->DeleteFile ($replica_imrlogfile);
 110     $act->DeleteFile ($imriorfile);
 111     $ti->DeleteFile ($imriorfile);
 112     $ti->DeleteFile ($replica_imriorfile);
 113     $srv->DeleteFile ($imriorfile);
 114     $act->DeleteFile ($actiorfile);
 115
 116     $ti->DeleteFile ($stdout_file);
 117     $ti->DeleteFile ($stderr_file);
 118
 119     cleanup_replication ('.');
 120 }
 121
 122 # Clean up after exit call
 123 END
 124 {
 125     delete_files (0);
 126 }
 127
 128 sub cleanup_replication
 129 {
 130     my $dir = shift;
 131     if (!defined($dir)) {
 132         $dir = ".";
 133     }
 134
 135     my $listings = "$dir/imr_listing.xml";
 136     my $fnd = 0;
 137     if (open FILE, "<$listings") {
 138         while (<FILE>) {
 139             if ($_ =~ /fname="([^"]+)"?/) {
 140                 $fnd = 1;
 141                 my $file = "$dir/$1";
 142                 print "deleting $file\n" if ($debuglevel > 0);
 143                 $imr->DeleteFile ($file);
 144                 $imr->DeleteFile ($file . ".bak");
 145             }
 146         }
 147          close FILE;
 148     }
 149
 150 #   If the primary listings file has been corrupt then perform the
 151 #   deletions from the backup file.
 152
 153     if (!$fnd) {
 154        if (open FILE, "<$listings" . ".bak") {
 155            while (<FILE>) {
 156                if ($_ =~ /fname="([^"]+)"?/) {
 157                    my $file = "$dir/$1";
 158                    print "deleting $file\n" if ($debuglevel > 0);
 159                    $imr->DeleteFile ($file);
 160                    $imr->DeleteFile ($file . ".bak");
 161                }
 162            }
 163             close FILE;
 164        }
 165     }
 166     print "deleting $listings\n" if ($debuglevel > 0);
 167     $imr->DeleteFile ("$listings");
 168     $imr->DeleteFile ("$listings" . ".bak");
 169     $imr->DeleteFile ("$dir/$primaryiorfile");
 170     $imr->DeleteFile ("$dir/$backupiorfile");
 171 }
 172
 173 sub redirect_output
 174 {
 175     open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
 176     open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
 177     open STDERR, '>', $ti_stderr_file;
 178     open STDOUT, '>', $ti_stdout_file;
 179 }
 180
 181 sub restore_output
 182 {
 183     open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
 184     open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
 185 }
 186
 187 sub kill_imr
 188 {
 189     my $msg = shift;
 190     print STDERR "ERROR: $msg\n" if (length ($msg) > 0);
 191     $ACT->Kill (); $ACT->TimedWait (1);
 192     $IMR->Kill (); $IMR->TimedWait (1);
 193     $RIMR->Kill (); $RIMR->TimedWait (1);
 194     return 1;
 195 }
 196
 197 sub kill_primary
 198 {
 199     print "Killing primary ImR\n";
 200     $IMR->Kill (); $IMR->TimedWait (1);
 201 }
 202
 203 sub get_server_pid
 204 {
 205     my $pid = 0;
 206     open (FILE, "server.pid") or die "Can't open server.pid: $!";
 207     while (<FILE>) {
 208         chomp;
 209         $pid = $_;
 210         $server_pid = $pid if ($server_pid == 0);
 211     }
 212     close FILE;
 213     return $pid;
 214 }
 215
 216 sub signal_server
 217 {
 218     my $sig = shift;
 219     print "signal $sig to server $server_pid\n";
 220     kill ($sig, $server_pid);
 221 }
 222
 223 sub start_imr
 224 {
 225     my $all = shift;
 226     my $debugbase = "-ORBDebugLevel $debuglevel " .
 227                     "-ORBVerboseLogging 1 -ORBLogFile ";
 228     my $actargs = "-d $debuglevel -l -o $act_actiorfile $act_initref -ORBListenEndpoints iiop://127.0.0.1:";
 229
 230     my $imrargs = " -d $debuglevel -i -v 1000 " .
 231         "--directory . --primary " .
 232         "-ORBListenEndpoints iiop://127.0.0.1:$port";
 233
 234     my $rimrargs = " -d $debuglevel -i -v 1000 -o $imr_imriorfile " .
 235         "--directory . --backup " .
 236         "-ORBListenEndpoints iiop://127.0.0.1:$rport";
 237
 238     if ($debuglevel > 0) {
 239         $imrargs .= " $debugbase $imrlogfile";
 240         $rimrargs .= " $debugbase $rimrlogfile";
 241         $actargs .= " $debugbase $actlogfile";
 242     }
 243
 244     print "imr args = \"$imrargs\"\n" if ($debuglevel > 0);
 245     print "replica imr args = \"$rimrargs\"\n" if ($debuglevel > 0);
 246     print "act args = \"$actargs\"\n" if ($debuglevel > 0);
 247
 248     $IMR->Arguments ($imrargs);
 249     $RIMR->Arguments ($rimrargs);
 250     $ACT->Arguments ($actargs);
 251
 252     ##### Start ImplRepo #####
 253     $IMR_status = $IMR->Spawn ();
 254     if ($IMR_status != 0) {
 255         print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 256         return 1;
 257     }
 258     if ($imr->WaitForFileTimed ($primaryiorfile, $imr->ProcessStartWaitInterval()) == -1) {
 259         print STDERR "ERROR: cannot find file <$primaryiorfile>\n";
 260         $IMR->Kill (); $IMR->TimedWait (1);
 261         return 1;
 262     }
 263
 264     if ($all == 1) {
 265         $IMR_status = $RIMR->Spawn ();
 266         if ($IMR_status != 0) {
 267             print STDERR "ERROR: replica ImplRepo Service returned $IMR_status\n";
 268             $IMR->Kill (); $IMR->TimedWait (1);
 269             return 1;
 270         }
 271         if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 272             print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 273             $IMR->Kill (); $IMR->TimedWait (1);
 274             $RIMR->Kill (); $RIMR->TimedWait (1);
 275             return 1;
 276         }
 277
 278         if ($imr->GetFile ($imriorfile) == -1) {
 279             print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 280             $IMR->Kill (); $IMR->TimedWait (1);
 281             return 1;
 282         }
 283         if ($act->PutFile ($imriorfile) == -1) {
 284             print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 285             $IMR->Kill (); $IMR->TimedWait (1);
 286             return 1;
 287         }
 288         if ($ti->PutFile ($imriorfile) == -1) {
 289             print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 290             $IMR->Kill (); $IMR->TimedWait (1);
 291             return 1;
 292         }
 293         if ($srv->PutFile ($imriorfile) == -1) {
 294             print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
 295             $IMR->Kill (); $IMR->TimedWait (1);
 296             return 1;
 297         }
 298
 299         $ACT_status = $ACT->Spawn ();
 300         if ($ACT_status != 0) {
 301             print STDERR "ERROR: ImR Activator returned $ACT_status\n";
 302             return 1;
 303         }
 304         if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
 305             return kill_imr ("cannot find file <$act_imriorfile>");
 306         }
 307     }
 308 }
 309
 310 sub launch_client
 311 {
 312     if ($srv->GetFile ($srviorfile) == -1) {
 313         print STDERR "ERROR: cannot retrieve file <$srv_srviorfile>\n";
 314         return 1;
 315     }
 316     if ($clt->PutFile ($srviorfile) == -1) {
 317         print STDERR "ERROR: cannot set file <$clt_srviorfile>\n";
 318         return 1;
 319     }
 320
 321     my $args = "-k file://$srviorfile";
 322     $args .= " -ORBDebuglevel $cltdbg -ORBVerboseLogging 1 -ORBLogFile $cltlogfile" if ($debuglevel > 0);
 323
 324     print "running client $args\n";
 325
 326     $CLT->Arguments ($args);
 327     if ($CLT->Spawn () == -1) {
 328         print STDERR "ERROR: client failed\n";
 329         return 1;
 330     }
 331     return 0;
 332 }
 333
 334 sub run_client
 335 {
 336     if (launch_client () == 0) {
 337         if ($CLT->WaitKill ($clt->ProcessStartWaitInterval() + 120) == -1) {
 338             print STDERR "ERROR: client failed\n";
 339             return 1;
 340         }
 341     }
 342 }
 343
 344 sub do_ti_command
 345 {
 346     my $cmd = shift;
 347     my $cmdargs = shift;
 348
 349     my $obj_name = "manual_test";
 350     print "invoking ti cmd $cmd $obj_name $cmdargs\n" if ($debuglevel > 0);
 351     $TI->Arguments ("$ti_initref $cmd $obj_name $cmdargs");
 352     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 353     if ($TI_status != 0 && $TI_status != 4) {
 354         return kill_imr ("tao_imr $cmd $obj_name returned $TI_status");
 355     }
 356 }
 357
 358 sub list_active_servers
 359 {
 360     my $list_options = shift;
 361     my $start_time = time();
 362     $TI->Arguments ("$ti_initref list $list_options");
 363     # Redirect output so we can count number of lines in output
 364     redirect_output();
 365     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 366     my $list_time = time() - $start_time;
 367     restore_output();
 368     if ($TI_status != 0) {
 369         kill_imr ("tao_imr list returned $TI_status");
 370         return -1;
 371     }
 372     open (FILE, $stderr_file) or die "Can't open $stderr_file: $!";
 373     $active_servers = 0;
 374     while (<FILE>) {
 375       print STDERR $_;
 376       $active_servers++;
 377     }
 378     close FILE;
 379     print STDERR "List took $list_time seconds.\n";
 380     return $active_servers;
 381 }
 382
 383 sub manual_test
 384 {
 385     print "Running manual start test.\n";
 386     my $result = 0;
 387     my $start_time = time();
 388
 389     if (start_imr (1) != 0) {
 390         return 1;
 391     }
 392
 393     my $cmdline = $server_cmd . " -o $srviorfile -ORBUseIMR 1 $act_initref "
 394 #        . "-ORBDebuglevel 10 -ORBVerboseLogging 1 -ORBLogFile srv.log "
 395         . "-ORBListenEndpoints iiop://127.0.0.1:";
 396
 397     if (do_ti_command ("add", "-a MANUAL -c \"$cmdline\"") != 0) {
 398         return 1;
 399     }
 400
 401     if (do_ti_command ("start") != 0) {
 402         return 1;
 403     }
 404
 405 #    print STDERR "=== kill ImR Locator\n";
 406 #    $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 407 #    $imr->DeleteFile ($imriorfile);
 408
 409     sleep 2;
 410
 411 #    print STDERR "=== restart ImR Locator\n";
 412 #    $IMR_status = $IMR->Spawn ();
 413 #    if ($IMR_status != 0) {
 414 #        print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 415 #        exit 1;
 416 #    }
 417 #    if ($imr->WaitForFileTimed ($imriorfile,$imr->ProcessStartWaitInterval()) == -1) {
 418 #        print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 419 #        $IMR->Kill (); $IMR->TimedWait (1);
 420 #        exit 1;
 421 #    }
 422
 423
 424     print "starting client\n";
 425
 426     if (launch_client () != 0) {
 427         return 1;
 428     }
 429     print "******waiting for client exit\n";
 430     if ($CLT->WaitKill ($clt->ProcessStartWaitInterval() + 120) == -1) {
 431         print STDERR "ERROR: client failed\n";
 432         return 1;
 433     }
 434     print "******client done\n";
 435
 436     if (do_ti_command ("update", "-a NORMAL -c \"$cmdline\"") != 0) {
 437         return 1;
 438     }
 439
 440     if (do_ti_command ("start") != 0) {
 441         return 1;
 442     }
 443
 444     sleep 2;
 445     kill_imr ("");
 446
 447     my $test_time = time() - $start_time;
 448
 449     print "\nFinished. The test took $test_time seconds.\n";
 450
 451     return $status;
 452 }
 453
 454
 455 sub usage() {
 456     print "Usage: run_test.pl [-debug] [-cd n]\n";
 457     print "       -debug enables ImR debugging\n";
 458     print "       -cd n sets client debug level to n (default 1)\n";
 459 }
 460
 461 ###############################################################################
 462 ###############################################################################
 463
 464 delete_files (1);
 465
 466 $ret = manual_test ();
 467
 468 exit $ret;