TAO/orbsvcs/tests/ImplRepo/link_poas/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
  14 $client_count = 3;
  15 $unlinked_test = 0;
  16
  17 if ($#ARGV >= 0) {
  18     for (my $i = 0; $i <= $#ARGV; $i++) {
  19         if ($ARGV[$i] eq '-debug') {
  20             $debug_level = 10;
  21         }
  22         elsif ($ARGV[$i] eq '-nolink') {
  23             $unlinked_test = 1;
  24         }
  25         else {
  26             usage();
  27             exit 1;
  28         }
  29     }
  30 }
  31
  32 my $objprefix = "TestObject";
  33 $statusfile = "TestObject.status";
  34
  35 my $tgt_num = 0;
  36 my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  37 my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  38 my $srv = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  39 my $ti  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  40
  41 my @cli;
  42 my @CLI;
  43 my @srviorfile;
  44 my $poa_id = 'a';
  45 for(my $i = 0; $i < $client_count; $i++) {
  46     push (@cli, PerlACE::TestTarget::create_target (++$tgt_num)) || die "Create target $tgt_num failed\n";
  47     my $fname = $objprefix . "_" . $poa_id . ".ior";
  48     push (@srviorfile, $srv->LocalFile ($fname));
  49     push (@CLI, $cli[$i]->CreateProcess ("client"));
  50     $CLI[$i]->Arguments ("-" . $poa_id);
  51     $poa_id++;
  52 }
  53
  54 my $refstyle = " -ORBobjrefstyle URL";
  55
  56 my $client_wait_time = 10;
  57
  58 $imriorfile = "imr_locator.ior";
  59 $actiorfile = "imr_activator.ior";
  60
  61 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
  62 my $act_imriorfile = $act->LocalFile ($imriorfile);
  63 my $act_actiorfile = $act->LocalFile ($actiorfile);
  64 my $ti_imriorfile = $ti->LocalFile ($imriorfile);
  65 $SRV = $srv->CreateProcess ("server");
  66 $server_cmd = $SRV->Executable();
  67 $srv_server_cmd = $imr->LocalFile ($server_cmd);
  68
  69 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
  70 $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
  71 $TI = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
  72
  73 $initref = "-ORBInitRef ImplRepoService=file://$ti_imriorfile";
  74
  75 my $stdout_file      = "test.out";
  76 my $stderr_file      = "test.err";
  77 my $ti_stdout_file = $ti->LocalFile ($stdout_file);
  78 my $ti_stderr_file = $ti->LocalFile ($stderr_file);
  79
  80 sub delete_files
  81 {
  82     $imr->DeleteFile ($imriorfile);
  83     $act->DeleteFile ($imriorfile);
  84     $act->DeleteFile ($actiorfile);
  85     $ti->DeleteFile ($imriorfile);
  86     $srv->DeleteFile ($imriorfile);
  87     $srv->DeleteFile ($statusfile);
  88
  89     for ($i = 0; $i < $client_count; $i++) {
  90         $cli[$i]->DeleteFile ($imriorfile);
  91         $srv->DeleteFile ($srviorfile[$i]);
  92     }
  93 }
  94
  95 # Clean up after exit call
  96 END
  97 {
  98     delete_files ();
  99
 100     $ti->DeleteFile ($stdout_file);
 101     $ti->DeleteFile ($stderr_file);
 102 }
 103
 104 sub redirect_output
 105 {
 106     open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
 107     open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
 108     open STDERR, '>', $ti_stderr_file;
 109     open STDOUT, '>', $ti_stdout_file;
 110 }
 111
 112 sub restore_output
 113 {
 114     open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
 115     open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
 116 }
 117
 118 sub validate_and_kill
 119 {
 120     open FILE, "<$statusfile";
 121     @pids = <FILE>;
 122     $count = scalar @pids;
 123     print "$statusfile has $count lines\n";
 124
 125     if ($unlinked_test == 1) {
 126         print STDERR "ERROR: expected > 1 server pids, got 1\n" if ($count == 1);
 127         $result = 1 if ($count == 1);
 128     }
 129     else {
 130         print STDERR "ERROR: expected 1 server pid, got $count\n" if ($count != 1);
 131         $result = 1 if ($count != 1);
 132     }
 133     for ($i = 0; $i < $count; $i++) {
 134         $ks = kill $pids[$i];
 135     }
 136 }
 137
 138 sub server_setup
 139 {
 140     print "Adding base server\n";
 141
 142     $TI->Arguments ("$initref add $objprefix" . "_a -c \"".
 143                     $srv_server_cmd . " -ORBUseIMR 1 -w $initref\"");
 144
 145
 146     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 147     if ($TI_status != 0) {
 148         print STDERR "ERROR: tao_imr returned $TI_status\n";
 149         $ACT->Kill (); $ACT->TimedWait (1);
 150         $IMR->Kill (); $IMR->TimedWait (1);
 151         return 1;
 152     }
 153     return 0;
 154 }
 155
 156 sub list_servers
 157 {
 158     print "calling list -v\n";
 159     $TI->Arguments ("$initref list -v");
 160
 161     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 162     if ($TI_status != 0) {
 163         print STDERR "ERROR: tao_imr returned $TI_status\n";
 164         $ACT->Kill (); $ACT->TimedWait (1);
 165         $IMR->Kill (); $IMR->TimedWait (1);
 166         return 1;
 167     }
 168     return 0;
 169 }
 170
 171 sub link_poas
 172 {
 173     print "linking POAs\n";
 174     $TI->Arguments ("$initref update $objprefix" . "_a -c \"".
 175                     $srv_server_cmd . " -ORBUseIMR 1 -d 2 $initref\"");
 176
 177
 178     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 179     if ($TI_status != 0) {
 180         print STDERR "ERROR: tao_imr returned $TI_status\n";
 181         $ACT->Kill (); $ACT->TimedWait (1);
 182         $IMR->Kill (); $IMR->TimedWait (1);
 183         return 1;
 184     }
 185
 186     $TI->Arguments ("$initref link $objprefix" . "_a -p ".
 187                     $objprefix . "_b," . $objprefix . "_c");
 188
 189     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 190     if ($TI_status != 0) {
 191         print STDERR "ERROR: tao_imr returned $TI_status\n";
 192         $ACT->Kill (); $ACT->TimedWait (1);
 193         $IMR->Kill (); $IMR->TimedWait (1);
 194         return 1;
 195     }
 196     return 0;
 197 }
 198
 199 sub add_unlinked_poas
 200 {
 201     print "adding unlinked POAs\n";
 202
 203     $TI->Arguments ("$initref update $objprefix" . "_a -c \"".
 204                     $srv_server_cmd . " -ORBUseIMR 1 -d 2 $initref\"");
 205     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 206     if ($TI_status != 0) {
 207         print STDERR "ERROR: tao_imr returned $TI_status\n";
 208         $ACT->Kill (); $ACT->TimedWait (1);
 209         $IMR->Kill (); $IMR->TimedWait (1);
 210         return 1;
 211     }
 212
 213     my $id = 'b';
 214     for (my $i = 1; $i < $client_count; $i++) {
 215         $TI->Arguments ("$initref add $objprefix" . "_$id -c \"".
 216                         $srv_server_cmd . " -ORBUseIMR 1 -d 2 $initref\"");
 217         $id++;
 218         $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 219         if ($TI_status != 0) {
 220             print STDERR "ERROR: tao_imr returned $TI_status adding unlinked POA $id\n";
 221             $ACT->Kill (); $ACT->TimedWait (1);
 222             $IMR->Kill (); $IMR->TimedWait (1);
 223             return 1;
 224         }
 225     }
 226     return 0;
 227 }
 228
 229 sub shutdown_server
 230 {
 231     $TI->Arguments ("$initref shutdown $objprefix" . "_a");
 232
 233     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 234     if ($TI_status != 0) {
 235         print STDERR "ERROR: tao_imr returned $TI_status\n";
 236         $ACT->Kill (); $ACT->TimedWait (1);
 237         $IMR->Kill (); $IMR->TimedWait (1);
 238         return 1;
 239     }
 240 }
 241
 242 sub init_ior_files
 243 {
 244     print "init ior files, starting server\n";
 245     $TI->Arguments ("$initref ".
 246                     "start $objprefix" . "_a");
 247
 248     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 249     if ($TI_status != 0) {
 250         print STDERR "ERROR: tao_imr returned $TI_status\n";
 251         $ACT->Kill (); $ACT->TimedWait (1);
 252         $IMR->Kill (); $IMR->TimedWait (1);
 253         return 1;
 254     }
 255
 256     print "init ior files, shutdown server\n";
 257     shutdown_server ();
 258
 259     my $id = 'b';
 260     for (my $i = 1; $i < $client_count; $i++) {
 261         print "init ior files, remove $id\n";
 262         $TI->Arguments ("$initref remove $objprefix" . "_$id");
 263         $id++;
 264         $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 265         if ($TI_status != 0) {
 266             print STDERR "ERROR: tao_imr returned $TI_status\n";
 267             $ACT->Kill (); $ACT->TimedWait (1);
 268             $IMR->Kill (); $IMR->TimedWait (1);
 269             return 1;
 270         }
 271     }
 272
 273     return 0;
 274 }
 275
 276 sub run_clients
 277 {
 278     print "running concurrent clients\n";
 279     for (my $i = 0; $i < $client_count; $i++)
 280     {
 281         my $cli_status = $CLI[$i]->Spawn ();
 282         if ($cli_status != 0) {
 283             print STDERR "ERROR: client $i returned $cli_status\n";
 284             $status = 1;
 285         }
 286     }
 287     for (my $i = 0; $i < $client_count; $i++)
 288     {
 289         print "waiting for $i\n";
 290         $status += $CLI[$i]->WaitKill ($cli[$i]->ProcessStopWaitInterval());
 291     }
 292     return 0;
 293 }
 294
 295
 296 sub servers_link_test
 297 {
 298 #tao_imr_locator -o imr.ior -x persist.xml
 299 #tao_imr_activator -l -ORBInitRef ImplRepoService=file://imr.ior&
 300 #tao_imr add TestObject_a -c "./server -ORBUseIMR 1 -d 1 -ORBInitRef ImplRepoService=file://$ti_imriorfileimr.ior"
 301 #tao_imr link TestObject_a -p TestObject_b,TestObject_c
 302 #tao_imr start TestObject_a
 303 #tao_imr list -v
 304 #tao_imr shutdown TestObject_a
 305 #client -a & client -b & client -c
 306 # verify return values match
 307 #tao_imr shutdown TestObject_a
 308 #kill activator
 309 #kill locator
 310 #cleanup files
 311
 312     print "Running server kill test with $servers_count servers and $obj_count objects.\n";
 313
 314     my $result = 0;
 315
 316     $IMR->Arguments ("-d $debug_level -ORBDebugLevel $debug_level -v 1000 -o $imr_imriorfile -orbendpoint iiop://:$port");
 317
 318     ##### Start ImplRepo #####
 319     $IMR_status = $IMR->Spawn ();
 320     if ($IMR_status != 0) {
 321         print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 322         return 1;
 323     }
 324     if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 325         print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 326         $IMR->Kill (); $IMR->TimedWait (1);
 327         return 1;
 328     }
 329     if ($imr->GetFile ($imriorfile) == -1) {
 330         print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 331         $IMR->Kill (); $IMR->TimedWait (1);
 332         return 1;
 333     }
 334     if ($act->PutFile ($imriorfile) == -1) {
 335         print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 336         $IMR->Kill (); $IMR->TimedWait (1);
 337         return 1;
 338     }
 339     if ($ti->PutFile ($imriorfile) == -1) {
 340         print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 341         $IMR->Kill (); $IMR->TimedWait (1);
 342         return 1;
 343     }
 344     if ($srv->PutFile ($imriorfile) == -1) {
 345         print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
 346         $IMR->Kill (); $IMR->TimedWait (1);
 347         return 1;
 348     }
 349
 350     $ACT->Arguments ("-d 2 -o $act_actiorfile -ORBInitRef ImplRepoService=file://$act_imriorfile");
 351
 352     $ACT_status = $ACT->Spawn ();
 353     if ($ACT_status != 0) {
 354         print STDERR "ERROR: ImR Activator returned $ACT_status\n";
 355         return 1;
 356     }
 357     if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
 358         print STDERR "ERROR: cannot find file <$act_imriorfile>\n";
 359         $ACT->Kill (); $ACT->TimedWait (1);
 360         $IMR->Kill (); $IMR->TimedWait (1);
 361         return 1;
 362     }
 363
 364
 365     return 1 if (server_setup () != 0);
 366     return 1 if (init_ior_files () != 0);
 367
 368     list_servers();
 369
 370     if ($unlinked_test == 0) {
 371         return 1 if (link_poas () != 0);
 372     }
 373     else {
 374         return 1 if (add_unlinked_poas () != 0);
 375     }
 376
 377     list_servers();
 378
 379     return 1 if (run_clients () != 0);
 380
 381     print "shutdown server\n";
 382     shutdown_server ();
 383
 384     $status += validate_and_kill ();
 385 }
 386
 387 sub imr_shutdown
 388 {
 389     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 390     if ($ACT_status != 0) {
 391         print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 392         $status = 1;
 393     }
 394
 395     my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 396     if ($IMR_status != 0) {
 397         print STDERR "ERROR: IMR returned $IMR_status\n";
 398         $status = 1;
 399     }
 400
 401     return $status;
 402 }
 403
 404 sub usage() {
 405     print "Usage: run_test.pl\n";
 406 }
 407
 408 ###############################################################################
 409 ###############################################################################
 410
 411 # Make sure the files are gone, so we can wait on them.
 412 delete_files();
 413
 414 my $start_time = time();
 415 my $ret = servers_link_test();
 416 imr_shutdown ();
 417 my $test_time = time() - $start_time;
 418 print "\nFinished. The test took $test_time seconds.\n";
 419
 420
 421 exit $ret;