TAO/orbsvcs/tests/ImplRepo/MT_stress/run_test_ft.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 my $status = 0;
  12 my $debuglevel = 0;
  13 my $srv_count = 48;
  14 my $thr_count = 1;
  15 my $no_imr = 0;
  16 my $cl_only = 0;
  17 my $port;
  18 my $rport;
  19 my $nsport;
  20
  21 for ($i = 0; $i <= $#ARGV; $i++) {
  22     if ($ARGV[$i] eq "-debug") {
  23         print "debug mode\n";
  24         $debuglevel = 4;
  25     }
  26     elsif ($ARGV[$i] eq "--servers" || $ARGV[$i] eq "-s") {
  27         $srv_count = $ARGV[++$i];
  28     }
  29     elsif ($ARGV[$i] eq "--threads" || $ARGV[$i] eq "-t") {
  30         $thr_count = $ARGV[++$i];
  31     }
  32     elsif ($ARGV[$i] eq "--clonly" || $ARGV[$i] eq "-c") {
  33         $cl_only = $ARGV[++$i];
  34     }
  35     elsif ($ARGV[$i] eq "--noimr" || $ARGV[$i] eq "-n") {
  36         $no_imr = 1;
  37         @ports = split (',', $ARGV[++$i]);
  38         $port = $ports[0];
  39         $rport = $ports[1];
  40         $nsport = $ports[2];
  41     }
  42     else {
  43         print "$ARGV[$i] is invalid\n";
  44         usage();
  45         exit 1;
  46     }
  47 }
  48
  49 my $clt_count = $srv_count/3;
  50 my $objprefix = "TestObject_";
  51
  52 my @srvdeps;
  53 for ($i = 0; $i < $srv_count; $i++) {
  54     my $ofs = $i + $clt_count;
  55     $srvdeps[$i] = "";
  56     $srvdeps[$i] = $objprefix . $ofs if ($i < $clt_count * 2);
  57 }
  58
  59 my $tgt_num = 0;
  60 my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  61 my $replica_imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  62 my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  63 my $nam = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  64 my $srv = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  65 my $nsl = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  66
  67 my @ti;
  68 for ($i = 0; $i <= $srv_count; $i++) {
  69     $ti[$i]  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  70 }
  71
  72 my @clt;
  73 my @CLT;
  74 for ($i = 0; $i < $clt_count; $i++) {
  75     $clt[$i] = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  76     $CLT[$i] = $clt[$i]->CreateProcess ("client");
  77 }
  78
  79 if (!$no_imr) {
  80     $port = 10001 + $imr->RandomPort ();
  81     $rport = $port + 1;
  82     $nsport = $rport + 1;
  83 }
  84
  85 my $imriorfile = "imr_locator.ior";
  86 my $actiorfile = "imr_activator.ior";
  87 my $primaryiorfile = "ImR_ReplicaPrimary.ior";
  88 my $backupiorfile = "ImR_ReplicaBackup.ior";
  89
  90 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
  91 my $act_imriorfile = $act->LocalFile ($imriorfile);
  92 my $ti_imriorfile = $ti[0]->LocalFile ($imriorfile);
  93 my $act_actiorfile = $act->LocalFile ($actiorfile);
  94
  95 my $ti_initref = "-ORBInitRef ImplRepoService=file://$ti_imriorfile";
  96 my $act_initref = "-ORBInitRef ImplRepoService=file://$act_imriorfile";
  97 my $nam_initref = "-ORBInitRef NameService=corbaloc::localhost:$nsport/";
  98 my $imr_root = "$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service";
  99 my $nam_root = "$ENV{TAO_ROOT}/orbsvcs/Naming_Service";
 100 my $util_root = "$ENV{TAO_ROOT}/utils";
 101
 102 my $server_cmd = $act->LocalFile ("server");
 103
 104 my $IMR = $imr->CreateProcess ($imr_root . "/tao_imr_locator");
 105 my $RIMR = $replica_imr->CreateProcess ($imr_root . "/tao_imr_locator");
 106 my $ACT = $act->CreateProcess ($imr_root . "/tao_imr_activator");
 107 my $NAM = $nam->CreateProcess ($nam_root . "/tao_cosnaming");
 108 my $NSL = $nsl->CreateProcess ($util_root . "/nslist/tao_nslist");
 109
 110 my @TI;
 111 for ($i = 0; $i <= $srv_count; $i++) {
 112     $TI[$i] = $ti[$i]->CreateProcess ($imr_root . "/tao_imr");
 113 }
 114
 115 my $imrlogfile = "imr.log";
 116 my $rimrlogfile = "replica_imr.log";
 117 my $actlogfile = "act.log";
 118 my $imr_imrlogfile = $imr->LocalFile ($imrlogfile);
 119 my $act_actlogfile = $act->LocalFile ($actlogfile);
 120
 121 my $stdout_file      = "test.out";
 122 my $stderr_file      = "test.err";
 123 my $ti_stdout_file = $ti[0]->LocalFile ($stdout_file);
 124 my $ti_stderr_file = $ti[0]->LocalFile ($stderr_file);
 125
 126 sub delete_files
 127 {
 128     my $logs_too = shift;
 129     if ($logs_too == 1) {
 130    #     $imr->DeleteFile ($imrlogfile);
 131    #     $replica_imr->DeleteFile ($rimrlogfile);
 132         #     $act->DeleteFile ($actlogfile);
 133         unlink <*.log>;
 134     }
 135     $imr->DeleteFile ($imriorfile);
 136     $replica_imr->DeleteFile ($replica_imriorfile);
 137     $act->DeleteFile ($imriorfile);
 138     $ti[0]->DeleteFile ($imriorfile);
 139     $act->DeleteFile ($actiorfile);
 140
 141     $ti[0]->DeleteFile ($stdout_file);
 142     $ti[0]->DeleteFile ($stderr_file);
 143
 144     cleanup_replication (".");
 145
 146     # Remove any stray server status files caused by aborting services
 147     unlink <*.status>;
 148 }
 149
 150 # Clean up after exit call
 151 END
 152 {
 153     delete_files (0) if (!$no_imr);
 154 }
 155
 156
 157 sub cleanup_replication
 158 {
 159     my $dir = shift;
 160     if (!defined($dir)) {
 161         $dir = ".";
 162     }
 163
 164     my $listings = "$dir/imr_listing.xml";
 165     my $fnd = 0;
 166     if (open FILE, "<$listings") {
 167         while (<FILE>) {
 168             if ($_ =~ /fname="([^"]+)"?/) {
 169                 $fnd = 1;
 170                 my $file = "$dir/$1";
 171                 $imr->DeleteFile ($file);
 172                 $imr->DeleteFile ($file . ".bak");
 173             }
 174         }
 175          close FILE;
 176     }
 177
 178 #   If the primary listings file has been corrupt then perform the
 179 #   deletions from the backup file.
 180
 181     if (!$fnd) {
 182        if (open FILE, "<$listings" . ".bak") {
 183            while (<FILE>) {
 184                if ($_ =~ /fname="([^"]+)"?/) {
 185                    my $file = "$dir/$1";
 186                    print "deleting $file\n" if ($debuglevel > 0);
 187                    $imr->DeleteFile ($file);
 188                    $imr->DeleteFile ($file . ".bak");
 189                }
 190            }
 191             close FILE;
 192        }
 193     }
 194     print "deleting $listings\n" if ($debuglevel > 0);
 195     $imr->DeleteFile ("$listings");
 196     $imr->DeleteFile ("$listings" . ".bak");
 197     $imr->DeleteFile ("$dir/$primaryiorfile");
 198     $imr->DeleteFile ("$dir/$backupiorfile");
 199 }
 200
 201 sub redirect_output
 202 {
 203     open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
 204     open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
 205     open STDERR, '>', $ti_stderr_file;
 206     open STDOUT, '>', $ti_stdout_file;
 207 }
 208
 209 sub restore_output
 210 {
 211     open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
 212     open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
 213 }
 214
 215 my $level = 0;
 216
 217 sub kill_imr
 218 {
 219     my $msg = shift;
 220     print STDERR "ERROR: $msg\n" if (length ($msg) > 0);
 221     if ($no_imr || $level == 0) {
 222         return 1;
 223     }
 224     if ($level > 0) {
 225         $NAM->TerminateWaitKill (5);
 226     }
 227     if ($level > 1) {
 228         $IMR->TerminateWaitKill (5);
 229     }
 230     if ($level > 2) {
 231         $RIMR->TerminateWaitKill (5);
 232     }
 233     if ($level > 3) {
 234         $ACT->TerminateWaitKill (5);
 235     }
 236     return 1;
 237 }
 238
 239 sub start_imr
 240 {
 241     delete_files (1) if (!$no_imr);
 242     my $debugbase = " -ORBDebugLevel $debuglevel " .
 243                     "-ORBVerboseLogging 1 -ORBLogFile ";
 244     my $actargs = "-l -o $act_actiorfile $act_initref " .
 245         "-ORBListenEndpoints iiop://localhost:";
 246
 247     my $imrargs = " -i -v 1000 -d 10 --threads $thr_count " .
 248         "--directory . --primary " .
 249         "-ORBListenEndpoints iiop://localhost:$port";
 250
 251     my $rimrargs = " -i -v 1000 -d 10 --threads $thr_count -o $imr_imriorfile " .
 252         "--directory . --backup " .
 253         "-ORBListenEndpoints iiop://localhost:$rport";
 254
 255     my $namargs = "-ORBListenEndpoints iiop://localhost:$nsport";
 256
 257     $imrargs .= " $debugbase $imrlogfile";
 258     $rimrargs .= " $debugbase $rimrlogfile";
 259     if ($debuglevel > 0) {
 260         $actargs .= " $debugbase $actlogfile";
 261     }
 262
 263     if ($debuglevel > 0 || $cl_only != 0) {
 264         print "naming args = \"$namargs\"\n";
 265         print "imr args = \"$imrargs\"\n";
 266         print "replica imr args = \"$rimrargs\"\n";
 267         print "act args = \"$actargs\"\n";
 268         if ($cl_only != 0) {
 269             exit (0);
 270         }
 271     }
 272     $IMR->Arguments ($imrargs);
 273     $RIMR->Arguments ($rimrargs);
 274     $ACT->Arguments ($actargs);
 275     $NAM->Arguments ($namargs);
 276
 277     if ($no_imr) {
 278         return 0;
 279     }
 280
 281     ##### Start Name service #####
 282     my $IMR_status = $NAM->Spawn ();
 283     if ($IMR_status != 0) {
 284         return kill_imr ("NameService returned $IMR_status");
 285     }
 286     $level++;
 287
 288     ##### Start ImplRepo #####
 289     $IMR_status = $IMR->Spawn ();
 290     if ($IMR_status != 0) {
 291         return kill_imr ("ImplRepo Service returned $IMR_status");
 292     }
 293     $level++;
 294
 295     if ($imr->WaitForFileTimed ($primaryiorfile, $imr->ProcessStartWaitInterval()) == -1) {
 296         return kill_imr ("cannot find file <$primaryiorfile>");
 297     }
 298
 299     $IMR_status = $RIMR->Spawn ();
 300     if ($IMR_status != 0) {
 301         return kill_imr ("replica ImplRepo Service returned $IMR_status");
 302     }
 303     $level++;
 304
 305     if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 306         return kill_imr ("cannot find file <$imr_imriorfile>");
 307     }
 308
 309     if ($imr->GetFile ($imriorfile) == -1) {
 310         return kill_imr ("cannot retrieve file <$imr_imriorfile>");
 311     }
 312     if ($act->PutFile ($imriorfile) == -1) {
 313         return kill_imr ("cannot set file <$act_imriorfile>");
 314     }
 315     if ($ti[0]->PutFile ($imriorfile) == -1) {
 316         return kill_imr ("cannot set file <$ti_imriorfile>");
 317     }
 318
 319     $ACT_status = $ACT->Spawn ();
 320     if ($ACT_status != 0) {
 321         return kill_imr ("ImR Activator returned $ACT_status");
 322     }
 323     $level++;
 324
 325     if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
 326         return kill_imr ("cannot find file <$act_imriorfile>");
 327     }
 328     return 0;
 329 }
 330
 331 sub do_ti_command
 332 {
 333     my $start = shift;
 334     my $end = shift;
 335     my $delstat = shift;
 336     my $cmd = shift;
 337     my $cmdargs1 = shift;
 338     my $cmdargs2 = shift;
 339     my $cmdargs3 = shift;
 340
 341     for(my $i = $start; $i < $end; $i++) {
 342         my $obj_name = $objprefix . "$i";
 343         if ($delstat != 0) {
 344             my $status_file_name = $obj_name . ".status";
 345             $srv->DeleteFile ($status_file_name);
 346         }
 347         my $cmdargs = $cmdargs1;
 348         if (length ($cmdargs2) > 0) {
 349             $cmdargs .= $i;
 350             $cmdargs .= "$cmdargs2 $srvdeps[$i]" if (length ($srvdeps[$i]) > 0);
 351             $cmdargs .= $cmdargs3;
 352         }
 353         print "invoking ti cmd $cmd $obj_name $cmdargs\n" if ($debuglevel > 0);
 354         $TI[$i]->Arguments ("$ti_initref $cmd $obj_name $cmdargs");
 355         $TI_status = $TI[$i]->Spawn ();
 356         if ($TI_status != 0) {
 357             return kill_imr ("tao_imr $cmd $obj_name returned $TI_status");
 358         }
 359     }
 360     for ($i = $start; $i < $end; $i++) {
 361         $TI[$i]->WaitKill (15);
 362     }
 363
 364 }
 365
 366 sub list_active_servers
 367 {
 368     $ti[0]->DeleteFile ($stdout_file);
 369     $ti[0]->DeleteFile ($stderr_file);
 370
 371     my $list_options = shift;
 372     my $start_time = time();
 373     $TI[$srv_count]->Arguments ("$ti_initref list $list_options");
 374     # Redirect output so we can count number of lines in output
 375     redirect_output();
 376     $TI_status = $TI[$srv_count]->SpawnWaitKill ($ti[$srv_count]->ProcessStartWaitInterval());
 377     my $list_time = time() - $start_time;
 378     restore_output();
 379     if ($TI_status != 0) {
 380         kill_imr ("tao_imr list returned $TI_status");
 381         return -1;
 382     }
 383     open (FILE, $stderr_file) or die "Can't open $stderr_file: $!";
 384     $active_servers = 0;
 385     while (<FILE>) {
 386         print STDERR $_;
 387         $active_servers++;
 388     }
 389     close FILE;
 390     print STDERR "List took $list_time seconds.\n";
 391     return $active_servers;
 392 }
 393
 394 sub kill_active_servers
 395 {
 396     $ti[0]->DeleteFile ($stdout_file);
 397     $ti[0]->DeleteFile ($stderr_file);
 398
 399     $TI[$srv_count]->Arguments ("$ti_initref list -a -t");
 400     # Redirect output so we can count number of lines in output
 401     redirect_output();
 402     $TI_status = $TI[$srv_count]->SpawnWaitKill ($ti[$srv_count]->ProcessStartWaitInterval());
 403     restore_output();
 404     if ($TI_status != 0) {
 405         kill_imr ("tao_imr list returned $TI_status");
 406     }
 407     open (FILE, $stderr_file) or die "Can't open $stderr_file: $!";
 408     $active_servers = 0;
 409     while (<FILE>) {
 410         print STDERR "force killing $_";
 411         $TI[$srv_count]->Arguments ("$ti_initref kill $_");
 412         $TI_status = $TI[$srv_count]->SpawnWaitKill ($ti[$srv_count]->ProcessStartWaitInterval());
 413         if ($TI_status != 0) {
 414             kill_imr ("tao_imr kill returned $TI_status");
 415         }
 416     }
 417     close FILE;
 418 }
 419
 420 sub wait_for_servers
 421 {
 422     print "waiting for servers to exit\n";
 423     my $running = 1;
 424     my $retries = 5;
 425     while ($running > 0 && $retries > 0) {
 426         sleep 2;
 427         $running = list_active_servers ("-a");
 428         $retries--;
 429     }
 430     if ($running > 0) {
 431         kill_active_servers ();
 432     }
 433 }
 434
 435 sub scale_test
 436 {
 437     print "Running scale test with $srv_count servers and $clt_count clients.\n";
 438
 439     my $result = 0;
 440     my $start_time = time();
 441
 442     if (start_imr () != 0)
 443     {
 444         exit;
 445     }
 446
 447     print "Adding servers\n";
 448     do_ti_command (0, $srv_count, 1, "add",
 449                    " -q -c \"$server_cmd -ORBUseIMR 1 -ORBVerboseLogging 1 -s $objprefix",
 450                    " -d ",
 451                    " -ORBListenEndpoints iiop://localhost: $act_initref $nam_initref\"");
 452     print "Initializing name service\n";
 453     do_ti_command (0, $srv_count, 1, "start", "-q", "", "");
 454     wait_for_servers ();
 455
 456     $NSL->Arguments (" $nam_initref");
 457     $NSL->SpawnWaitKill (150);
 458
 459     print "Running clients\n";
 460     for (my $i = 0; $i < $clt_count; $i++) {
 461         $CLT[$i]->Arguments ($nam_initref . " -s $objprefix$i  -ORBVerboseLogging 1 ");
 462         $CLT_status = $CLT[$i]->Spawn ();
 463         if ($CLT_status != 0) {
 464             print STDERR "ERROR: client $i spawn returned $CLT_status\n";
 465             $status = 1;
 466             last;
 467         }
 468     }
 469
 470     print "Waiting on clients\n";
 471     for (my $i = 0; $i < $clt_count; $i++) {
 472         $CLT_status = $CLT[$i]->WaitKill (30);
 473         if ($CLT_status != 0) {
 474             print STDERR "ERROR: client $i waitkill returned $CLI_status\n";
 475             $status = 1;
 476         }
 477     }
 478
 479     print "Stopping servers\n";
 480     do_ti_command (0, $srv_count, 1, "shutdown", "-q");
 481     wait_for_servers ();
 482
 483     my $test_time = time() - $start_time;
 484     my $total_objs = $srv_count;
 485
 486     print "\nFinished. The test took $test_time seconds for $total_objs imr-ified objects.\n";
 487 #    sleep (300);
 488     kill_imr ();
 489     return $status;
 490 }
 491
 492 sub usage() {
 493     print "Usage: run_test.pl [-servers <num=1>] [-clients <num=1>]\n";
 494 }
 495
 496 ###############################################################################
 497 ###############################################################################
 498
 499 my $ret = scale_test();
 500
 501 exit $ret;