TAO/orbsvcs/tests/ImplRepo/scale_clients/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 my $debug_level = '0';
  13 my $imr_debug_level = '1';
  14
  15 # Allow for manually launching ImplRepo for debugging purposes.
  16 my $no_imr = 0;
  17
  18 my $clients_count = 6;
  19 my $secs_between_clients = 1;
  20 my $server_init_delay = 1;
  21 my $server_reply_delay = 0;
  22 my $rt_timeout_msecs = 0;
  23 my $max_rt_tries = 1;
  24 my $asynch_loc = "";
  25 my $activationmode = "normal";
  26 my $shutdownserver = 0;
  27
  28 if ($#ARGV >= 0) {
  29     for (my $i = 0; $i <= $#ARGV; $i++) {
  30       if ($ARGV[$i] eq '-debug') {
  31         $debug_level = '10';
  32         $i++;
  33       }
  34       elsif ($ARGV[$i] eq "-imrdebug") {
  35         $i++;
  36         $imr_debug_level = $ARGV[$i];
  37       }
  38       elsif ($ARGV[$i] eq "-activationmode") {
  39         $i++;
  40         $activationmode = $ARGV[$i];
  41       }
  42       elsif ($ARGV[$i] eq "-clients") {
  43         $i++;
  44         $clients_count = $ARGV[$i];
  45       }
  46       elsif ($ARGV[$i] eq "-rt_timeout") {
  47         $i++;
  48         $rt_timeout_msecs = $ARGV[$i];
  49       }
  50       elsif ($ARGV[$i] eq "-secs_between_clients") {
  51         $i++;
  52         $secs_between_clients = $ARGV[$i];
  53       }
  54       elsif ($ARGV[$i] eq "-server_init_delay") {
  55         $i++;
  56         $server_init_delay = $ARGV[$i];
  57       }
  58       elsif ($ARGV[$i] eq "-server_reply_delay") {
  59         $i++;
  60         $server_reply_delay = $ARGV[$i];
  61       }
  62       elsif ($ARGV[$i] eq "-rt_timeout") {
  63         $i++;
  64         $rt_timeout_msecs = $ARGV[$i];
  65       }
  66       elsif ($ARGV[$i] eq "-max_rt_tries") {
  67         $i++;
  68         $max_rt_tries = $ARGV[$i];
  69       }
  70       elsif ($ARGV[$i] eq "-no_imr") {
  71         $no_imr = 1;
  72       }
  73       elsif ($ARGV[$i] eq "-asynch") {
  74         $asynch_loc = "--use_dsi";
  75       }
  76       else {
  77         usage();
  78         exit 1;
  79       }
  80     }
  81 }
  82
  83 my $tgt_num = 0;
  84 my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  85 my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  86 my $ti  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  87 my $srv = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  88 my @cli;
  89 for(my $i = 0; $i < $clients_count; $i++) {
  90     push (@cli, PerlACE::TestTarget::create_target (++$tgt_num)) || die "Create target $tgt_num failed\n";
  91 }
  92
  93 my $refstyle = " -ORBobjrefstyle URL";
  94 my $obj_count = 1;
  95 my $port = 9876;
  96
  97 my $objprefix = "TestObject";
  98 my $client_wait_time = 10;
  99
 100 $imriorfile = "imr_locator.ior";
 101 $actiorfile = "imr_activator.ior";
 102 $persistxml = "persist.xml";
 103 $persistdat = "persist.dat";
 104
 105 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
 106 my $act_imriorfile = $act->LocalFile ($imriorfile);
 107 my $ti_imriorfile = $ti->LocalFile ($imriorfile);
 108 my $srv_imriorfile = $srv->LocalFile ($imriorfile);
 109 my $act_actiorfile = $act->LocalFile ($actiorfile);
 110 my $imr_persistxml = $imr->LocalFile ($persistxml);
 111 my $imr_persistdat = $imr->LocalFile ($persistdat);
 112
 113 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
 114 $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
 115 $TI  = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
 116 $SRV = $srv->CreateProcess ("server");
 117 my $server_cmd = $SRV->Executable();
 118 my $srv_server_cmd = $imr->LocalFile ($server_cmd);
 119 @CLI;
 120 my @srv_server_cmd;
 121 for(my $i = 0; $i < $clients_count; $i++) {
 122     push (@CLI, $cli[$i]->CreateProcess ("client"));
 123 }
 124 # Make sure the files are gone, so we can wait on them.
 125 if (!no_imr) {
 126     $imr->DeleteFile ($imriorfile);
 127     $act->DeleteFile ($imriorfile);
 128     $ti->DeleteFile ($imriorfile);
 129     $srv->DeleteFile ($imriorfile);
 130 }
 131 $act->DeleteFile ($actiorfile);
 132 $imr->DeleteFile ($persistxml);
 133 $imr->DeleteFile ($persistdat);
 134
 135 sub scale_clients_test
 136 {
 137     print "Running scale_clients test with $clients_count clients.\n";
 138
 139     my $result = 0;
 140     my $start_time = time();
 141
 142     if ($activationmode eq "per_client") {
 143       $shutdownserver = 1;
 144     }
 145
 146     $IMR->Arguments ("-d $imr_debug_level -o $imr_imriorfile -orbendpoint iiop://:$port $asynch_loc -ORBDebugLevel $debug_level");
 147
 148     if ($no_imr) {
 149       print STDERR "IMR assumed to be manually launched in way that is ".
 150         "compatible with:\n";
 151       print STDERR $IMR->CommandLine () . "\n";
 152     } else {
 153       print ">>> " . $IMR->CommandLine () . "\n";
 154
 155       ##### Start ImplRepo #####
 156       $IMR_status = $IMR->Spawn ();
 157       if ($IMR_status != 0) {
 158         print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 159         return 1;
 160       }
 161       if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 162         print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 163         $IMR->Kill (); $IMR->TimedWait (1);
 164         return 1;
 165       }
 166
 167       if ($imr->GetFile ($imriorfile) == -1) {
 168         print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 169         $IMR->Kill (); $IMR->TimedWait (1);
 170         return 1;
 171       }
 172     }
 173
 174     if ($act->PutFile ($imriorfile) == -1) {
 175         print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 176         $IMR->Kill (); $IMR->TimedWait (1);
 177         return 1;
 178     }
 179     if ($ti->PutFile ($imriorfile) == -1) {
 180         print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 181         $IMR->Kill (); $IMR->TimedWait (1);
 182         return 1;
 183     }
 184     if ($srv->PutFile ($imriorfile) == -1) {
 185         print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
 186         $IMR->Kill (); $IMR->TimedWait (1);
 187         return 1;
 188     }
 189
 190     $ACT->Arguments ("-d $imr_debug_level -o $act_actiorfile -ORBInitRef ImplRepoService=file://$act_imriorfile");
 191     print ">>> " . $ACT->CommandLine () . "\n";
 192
 193     $ACT_status = $ACT->Spawn ();
 194     if ($ACT_status != 0) {
 195       print STDERR "ERROR: ImR Activator returned $ACT_status\n";
 196       return 1;
 197     }
 198     if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
 199       print STDERR "ERROR: cannot find file <$act_imriorfile>\n";
 200       $ACT->Kill (); $ACT->TimedWait (1);
 201       $IMR->Kill (); $IMR->TimedWait (1);
 202       return 1;
 203     }
 204
 205     # In a per client mode each server should get one request, in all other
 206     # modes the server gets a request for each client started
 207     $expected_requests = $clients_count;
 208     if ($activationmode eq "per_client") {
 209       $expected_requests = 1;
 210     }
 211
 212     ##### Add server to activator #####
 213     my $status_file_name = $objprefix . ".status";
 214     my $srv_status_file = $srv->LocalFile ($status_file_name);
 215     $srv->DeleteFile ($srv_status_file);
 216
 217     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 218         "add $objprefix" . " -a $activationmode -c \"".
 219         $srv_server_cmd . " ".
 220         "-ORBUseIMR 1 -d $server_init_delay -n $expected_requests ".
 221         "-ORBInitRef ImplRepoService=file://$imr_imriorfile\"");
 222
 223     print ">>> " . $TI->CommandLine () . "\n";
 224     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 225     if ($TI_status != 0) {
 226       print STDERR "ERROR: tao_imr returned $TI_status\n";
 227       $ACT->Kill (); $ACT->TimedWait (1);
 228       $IMR->Kill (); $IMR->TimedWait (1);
 229       return 1;
 230     }
 231
 232     # Why is this sleep needed?
 233     sleep(2);
 234
 235     ##### Run clients #####
 236     for(my $i = 0; $i < $clients_count; $i++ ) {
 237       # Make sure server has started by looking for its status file
 238
 239       $CLI[$i]->Arguments ("-ORBInitRef Test=corbaloc::localhost:$port/$objprefix" .
 240             " -d $server_reply_delay".
 241             " -x $shutdownserver " .
 242             " -r $rt_timeout_msecs".
 243             " -m $max_rt_tries");
 244       print ">>> " . $CLI[$i]->CommandLine () . "\n";
 245       $CLI_status = $CLI[$i]->Spawn ();
 246       if ($CLI_status != 0) {
 247         print STDERR "ERROR: client returned $CLI_status during spawn\n";
 248         $status = 1;
 249         last;
 250       }
 251       sleep($secs_between_clients);
 252     }
 253
 254     sleep (server_request_delay);
 255
 256     ##### Stop clients #####
 257     print STDERR "Waiting for clients to stop\n";
 258     for(my $i = 0; $i < $clients_count; $i++ ) {
 259         my $CLI_status = $CLI[$i]->WaitKill ($cli[$i]->ProcessStartWaitInterval() + $server_init_delay + $server_reply_delay);
 260         if ($CLI_status != 0) {
 261             print STDERR "ERROR: Client $i returned $CLI_status\n";
 262             return 1;
 263         }
 264     }
 265
 266     ##### Shutdown server #####
 267     my $status_file_name = $objprefix . ".status";
 268     $srv->DeleteFile ($status_file_name);
 269
 270     # Shutting down any server object within the server will shutdown the whole server
 271     # This can not be done with per client activation mode
 272     if ($activationmode ne "per_client") {
 273       $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile shutdown $objprefix");
 274       print ">>> " . $TI->CommandLine () . "\n";
 275       $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 276       if ($TI_status != 0) {
 277         print STDERR "ERROR: tao_imr shutdown returned $TI_status\n";
 278         $status = 1;
 279       }
 280     }
 281
 282     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 283     if ($ACT_status != 0) {
 284       print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 285       $status = 1;
 286     }
 287
 288     if (!$no_imr) {
 289       my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 290       if ($IMR_status != 0) {
 291         print STDERR "ERROR: IMR returned $IMR_status\n";
 292         $status = 1;
 293       }
 294     }
 295
 296     my $test_time = time() - $start_time;
 297
 298     print "\nFinished. The test took $test_time seconds.\n";
 299
 300     return $status;
 301 }
 302
 303 sub usage() {
 304     print "Usage: run_test.pl ".
 305       "[-clients <num=$clients_count>] ".
 306       "[-secs_between_clients <seconds=$secs_between_clients>] ".
 307       "[-server_init_delay <seconds=$server_init_delay>] ".
 308       "[-server_reply_delay <seconds=$server_reply_delay] ".
 309       "[-rt_timeout <round-trip-timeout-msecs=$rt_timeout_msecs>] ".
 310       "[-max_rt_tries <max-client-requests=$max_rt_tries>] ".
 311       "[-no_imr] ".
 312       "[-imrdebug <level=$imr_debug_level>]" .
 313       "[-activationmode <activationmode=$activationmode]" .
 314       "\n";
 315 }
 316
 317 ###############################################################################
 318 ###############################################################################
 319
 320 my $ret = scale_clients_test();
 321
 322 if (! $no_imr) {
 323     $imr->DeleteFile ($imriorfile);
 324     $act->DeleteFile ($imriorfile);
 325     $ti->DeleteFile ($imriorfile);
 326     $srv->DeleteFile ($imriorfile);
 327 }
 328 $act->DeleteFile ($actiorfile);
 329 $imr->DeleteFile ($persistxml);
 330 $imr->DeleteFile ($persistdat);
 331
 332 exit $ret;