TAO/orbsvcs/tests/ImplRepo/ReconnectServer/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
   9 use lib "$ENV{ACE_ROOT}/bin";
  10 use PerlACE::TestTarget;
  11
  12 $status = 0;
  13 $debug_level = '0';
  14 my $imr_debug_level = 0;
  15
  16 my $imr = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  17 my $srva = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  18 my $srvb = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  19 my $cli = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  20 my $ti =  PerlACE::TestTarget::create_target (5) || die "Create target 4 failed\n";
  21
  22 my $forward_opt = "-ORBForwardOnceOnObjectNotExist 1";
  23 my $delay = 0;
  24 my $got_object_not_exist_exception = 0;
  25 my $protocol = "iiop";
  26 my $port = $imr->RandomPort ();
  27 my $srv_port_base = $srva->RandomPort ();
  28 my $srv_a_id = "-ORBServerId AAA ";
  29 my $srv_b_id = "-ORBServerId BBB ";
  30 my $client_duration = 30;
  31 my $do_link = 0;
  32 my $ping_ext = "-v 0 ";
  33 my $use_java = 0;
  34
  35 my $imr_debug = "";
  36 my $srva_debug = "";
  37 my $srvb_debug = "";
  38 my $clt_debug = "";
  39
  40
  41 foreach my $i (@ARGV) {
  42     if ($i eq '-debug') {
  43         $imr_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile imr.log -d 10 ";
  44         $srva_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile srva.log ";
  45         $srvb_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile srvb.log ";
  46         $clt_debug = "-ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile clt.log ";
  47     }
  48     elsif ($i eq '-java') {
  49         $use_java = 1;
  50         $delay = 5;
  51     }
  52     elsif ($i eq '-link') {
  53         $do_link = 1;
  54     }
  55     elsif ($i eq '-noid') {
  56         $srv_a_id = "";
  57         $srv_b_id = "";
  58     }
  59     elsif ($i eq '-forwardalways') {
  60         $delay = 5;
  61         $forward_opt = "-ORBForwardInvocationOnObjectNotExist 1";
  62     }
  63     elsif ($i eq '-forwardonce') {
  64         $delay = 5;
  65         $forward_opt = "-ORBForwardOnceOnObjectNotExist 1";
  66         $got_object_not_exist_exception = 1;
  67     }
  68     elsif ($i eq '-pingexternal') {
  69         $delay = 5;
  70         $forward_opt = "-ORBForwardOnceOnObjectNotExist 1";
  71         $ping_ext = "-i ";
  72     }
  73     else {
  74         print STDERR "unrecognized argument $i\n";
  75         exit 1;
  76     }
  77 }
  78
  79 my $imriorfile = "imr_locator.ior";
  80 my $imrdbfile = "imr.db";
  81 my $srvaiorfile = "A.ior";
  82 my $srvbiorfile = "B.ior";
  83
  84 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
  85 my $srva_imriorfile = $srva->LocalFile ($imriorfile);
  86 my $srvb_imriorfile = $srvb->LocalFile ($imriorfile);
  87 my $imr_imrdbfile = $imr->LocalFile ($imrdbfile);
  88 my $srva_srvaiorfile = $srva->LocalFile ($srvaiorfile);
  89 my $srvb_srvbiorfile = $srvb->LocalFile ($srvbiorfile);
  90 my $cli_srvaiorfile = $cli->LocalFile ($srvaiorfile);
  91 my $ti_imriorfile = $ti->LocalFile ($imriorfile);
  92
  93 $imr->DeleteFile ($imriorfile);
  94 $srva->DeleteFile ($imriorfile);
  95 $srvb->DeleteFile ($imriorfile);
  96 $imr->DeleteFile ($imrdbfile);
  97 $srva->DeleteFile ($srvaiorfile);
  98 $srvb->DeleteFile ($srvbiorfile);
  99 $cli->DeleteFile ($srvaiorfile);
 100 $ti->DeleteFile ($imriorfile);
 101
 102 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator",
 103                             "-ORBEndpoint "."$protocol"."://:".$port." ".
 104                             "-UnregisterIfAddressReused $imr_debug".
 105                             $ping_ext .
 106                             "-o $imr_imriorfile ");
 107
 108 $SRV_A = $srva->CreateProcess ("serverA",
 109                                "-ORBEndpoint " . $protocol . "://:" ."$srv_port_base/portspan=20 ".
 110                                "-ORBInitRef ImplRepoService=file://$srva_imriorfile ".
 111                                $srv_a_id .
 112                                $srva_debug .
 113                                "-ORBUseIMR 1 ".
 114                                "-o $srva_srvaiorfile");
 115 $SRV_B = $srvb->CreateProcess ("serverB",
 116                                "-ORBEndpoint " . $protocol . "://:" . "$srv_port_base/portspan=20 ".
 117                                "-ORBInitRef ImplRepoService=file://$srvb_imriorfile ".
 118                                $srv_b_id .
 119                                $srvb_debug .
 120                                "-ORBUseIMR 1 ".
 121                                "-o $srvb_srvbiorfile");
 122 if ($use_java == 1) {
 123     $CLI = $cli->CreateProcess ($ENV{'JACORB_HOME'} . "/bin/jaco",
 124                                 "-cp build/classes taoimrtest.reconnectserver.Client");
 125 }
 126 else {
 127     $CLI = $cli->CreateProcess ("client",
 128                                 "$forward_opt -i file://$cli_srvaiorfile ".
 129                                 "-t $client_duration $clt_debug".
 130                                 "-e $got_object_not_exist_exception ");
 131 }
 132
 133 print STDERR $IMR->CommandLine () . "\n";
 134 $IMR_status = $IMR->Spawn ();
 135 print STDERR "command " .$IMR->CommandLine () . "\n";
 136 if ($IMR_status != 0) {
 137     print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 138     exit 1;
 139 }
 140 if ($imr->WaitForFileTimed ($imriorfile,$imr->ProcessStartWaitInterval()) == -1) {
 141     print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 142     $IMR->Kill (); $IMR->TimedWait (1);
 143     exit 1;
 144 }
 145
 146 if ($do_link == 1) {
 147     my $poaA = "AAA:" if ($srv_a_id =~ /AAA/);
 148     $poaA .= "poaA";
 149     my $poaC = "AAA:" if ($srv_a_id =~ /AAA/);
 150     $poaC .= "poaC";
 151
 152     $TI = $ti->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr",
 153                               "-ORBInitRef ImplRepoService=file://$srva_imriorfile ".
 154                               "add $poaA -c serverA");
 155     if ($ti->PutFile ($imriorfile) == -1) {
 156         print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 157         $IMR->Kill (); $IMR->TimedWait (1);
 158         exit 1;
 159     }
 160     print STDERR "=== linking POAs for serverA\n";
 161     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 162     if ($TI_status != 0) {
 163         print STDERR "tao_imr register poaA returned $TI_status\n";
 164     }
 165     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 166                     "link $poaA -p poaC");
 167     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 168     if ($TI_status != 0) {
 169         print STDERR "tao_imr link poaC to poaA returned $TI_status\n";
 170     }
 171     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 172                     "list -v");
 173     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 174     if ($TI_status != 0) {
 175         print STDERR "tao_imr link poaC to poaA returned $TI_status\n";
 176     }
 177
 178
 179 }
 180
 181 if ($imr->GetFile ($imriorfile) == -1) {
 182     print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 183     $IMR->Kill (); $IMR->TimedWait (1);
 184     exit 1;
 185 }
 186 if ($srva->PutFile ($imriorfile) == -1) {
 187     print STDERR "ERROR: cannot set file <$srva_imriorfile>\n";
 188     $IMR->Kill (); $IMR->TimedWait (1);
 189     exit 1;
 190 }
 191 if ($srvb->PutFile ($imriorfile) == -1) {
 192     print STDERR "ERROR: cannot set file <$srvb_imriorfile>\n";
 193     $IMR->Kill (); $IMR->TimedWait (1);
 194     exit 1;
 195 }
 196
 197 #sleep (2);
 198 print STDERR "=== start server A: " . $SRV_A->CommandLine () . "\n";
 199 $SRVA_status = $SRV_A->Spawn ();
 200 print STDERR "command " . $SRV_A->CommandLine () . "\n";
 201 if ($SRVA_status != 0) {
 202     print STDERR "ERROR: Server A returned $SRVA_status\n";
 203     exit 1;
 204 }
 205 if ($srva->WaitForFileTimed ($srvaiorfile,$srva->ProcessStartWaitInterval()) == -1) {
 206     print STDERR "ERROR: cannot find file <$srva_srvaiorfile>\n";
 207     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 208     $IMR->Kill (); $IMR->TimedWait (1);
 209     exit 1;
 210 }
 211 if ($srva->GetFile ($srvaiorfile) == -1) {
 212     print STDERR "ERROR: cannot retrieve file <$srva_srvaiorfile>\n";
 213     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 214     $IMR->Kill (); $IMR->TimedWait (1);
 215     exit 1;
 216 }
 217 if ($cli->PutFile ($srvaiorfile) == -1) {
 218     print STDERR "ERROR: cannot set file <$cli_srvaiorfile>\n";
 219     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 220     $IMR->Kill (); $IMR->TimedWait (1);
 221     exit 1;
 222 }
 223
 224 print STDERR "=== start server B: " . $SRV_B->CommandLine () . "\n";
 225 $SRVB_status = $SRV_B->Spawn ();
 226 print STDERR "command " .$SRV_B->CommandLine () . "\n";
 227 if ($SRVB_status != 0) {
 228     print STDERR "ERROR: Server B returned $SRVB_status\n";
 229     exit 1;
 230 }
 231 if ($srvb->WaitForFileTimed ($srvbiorfile,$srvb->ProcessStartWaitInterval()) == -1) {
 232     print STDERR "ERROR: cannot find file <$srvb_srvbiorfile>\n";
 233     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 234     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 235     $IMR->Kill (); $IMR->TimedWait (1);
 236     exit 1;
 237 }
 238
 239 print STDERR "=== start client: " . $CLI->CommandLine () . "\n";
 240 $CLI_status = $CLI->Spawn ();
 241 if ($CLI_status != 0) {
 242     print STDERR "ERROR: Client returned $CLI_status\n";
 243     $CLI->Kill (); $CLI->TimedWait (1);
 244     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 245     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 246     $IMR->Kill (); $IMR->TimedWait (1);
 247     exit 1;
 248 }
 249
 250 sleep (5);
 251
 252 print STDERR "=== kill server A\n";
 253 $SRVA_status = $SRV_A->TerminateWaitKill ($srva->ProcessStopWaitInterval());
 254 if ($SRVA_status != 0) {
 255     print STDERR "ERROR: Server A returned $SRVA_status\n";
 256     $CLI->Kill (); $CLI->TimedWait (1);
 257     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 258     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 259     $IMR->Kill (); $IMR->TimedWait (1);
 260     exit 1;
 261 }
 262
 263 print STDERR "=== kill server B\n";
 264 $SRVB_status = $SRV_B->TerminateWaitKill ($srvb->ProcessStopWaitInterval());
 265 if ($SRVB_status != 0) {
 266     print STDERR "ERROR: Server B returned $SRVB_status\n";
 267     $CLI->Kill (); $CLI->TimedWait (1);
 268     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 269     $IMR->Kill (); $IMR->TimedWait (1);
 270     exit 1;
 271 }
 272
 273 sleep (5);
 274 $srva->DeleteFile ($srvaiorfile);
 275 $srvb->DeleteFile ($srvbiorfile);
 276 $cli->DeleteFile ($srvaiorfile);
 277
 278 print STDERR "=== restart server B\n";
 279 # Run -ORBDebugLevel 10 to see server raise OBJECT_NOT_EXIST exception.
 280 $SRV_B = $srvb->CreateProcess ("serverB",
 281                                "_ORBDebugLevel = $debug_level ".
 282                                "-ORBEndpoint " . "$protocol" . "://:" . "$srv_port_base/portspan=20 ".
 283                                "-ORBInitRef ImplRepoService=file://$srvb_imriorfile ".
 284                                $srv_b_id .
 285                                $srvb_debug .
 286                                "-ORBUseIMR 1 ".
 287                                "-o $srvb_srvbiorfile ".
 288                                "-l $delay");
 289 print STDERR $SRV_B->CommandLine () . "\n";
 290 $SRVB_status = $SRV_B->Spawn ();
 291 if ($SRVB_status != 0) {
 292     print STDERR "ERROR: Server B returned $SRVB_status\n";
 293     exit 1;
 294 }
 295 if ($srvb->WaitForFileTimed ($srvbiorfile,$srvb->ProcessStartWaitInterval()) == -1) {
 296     print STDERR "ERROR: cannot find file <$srvb_srvbiorfile>\n";
 297     $CLI->Kill (); $CLI->TimedWait (1);
 298     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 299     $IMR->Kill (); $IMR->TimedWait (1);
 300     exit 1;
 301 }
 302
 303 sleep ($delay * 2);
 304
 305 print STDERR "=== restart server A\n";
 306 print STDERR $SRV_A->CommandLine () . "\n";
 307 $SRVA_status = $SRV_A->Spawn ();
 308 if ($SRVA_status != 0) {
 309     print STDERR "ERROR: Server A returned $SRVA_status\n";
 310     exit 1;
 311 }
 312 if ($srva->WaitForFileTimed ($srvaiorfile,$srva->ProcessStartWaitInterval()) == -1) {
 313     print STDERR "ERROR: cannot find file <$srva_srvaiorfile>\n";
 314     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 315     $CLI->Kill (); $CLI->TimedWait (1);
 316     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 317     $IMR->Kill (); $IMR->TimedWait (1);
 318     exit 1;
 319 }
 320 if ($srva->GetFile ($srvaiorfile) == -1) {
 321     print STDERR "ERROR: cannot retrieve file <$srva_srvaiorfile>\n";
 322     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 323     $CLI->Kill (); $CLI->TimedWait (1);
 324     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 325     $IMR->Kill (); $IMR->TimedWait (1);
 326     exit 1;
 327 }
 328 if ($cli->PutFile ($srvaiorfile) == -1) {
 329     print STDERR "ERROR: cannot set file <$cli_srvaiorfile>\n";
 330     $SRV_A->Kill (); $SRV_A->TimedWait (1);
 331     $CLI->Kill (); $CLI->TimedWait (1);
 332     $SRV_B->Kill (); $SRV_B->TimedWait (1);
 333     $IMR->Kill (); $IMR->TimedWait (1);
 334     exit 1;
 335 }
 336
 337 $CLI_status = $CLI->WaitKill ($cli->ProcessStartWaitInterval()+$client_duration);
 338 if ($CLI_status != 0) {
 339     print STDERR "ERROR: Client returned $CLI_status\n";
 340     $status = 1;
 341 }
 342
 343 $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 344 if ($IMR_status != 0) {
 345     print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 346     $status = 1;
 347 }
 348 $SRVA_status = $SRV_A->TerminateWaitKill ($srva->ProcessStopWaitInterval());
 349 if ($SRVA_status != 0) {
 350     print STDERR "Error : Server A returned $SRVA_status.";
 351     $status = 1;
 352 }
 353 $SRVB_status = $SRV_B->TerminateWaitKill ($srvb->ProcessStopWaitInterval());
 354 if ($SRVB_status != 0) {
 355     print STDERR "Error : Server B returned $SRVB_status.";
 356     $status = 1;
 357 }
 358
 359 # Make sure the files are gone, so we can wait on them.
 360 $imr->DeleteFile ($imriorfile);
 361 $srva->DeleteFile ($imriorfile);
 362 $srvb->DeleteFile ($imriorfile);
 363 $imr->DeleteFile ($imrdbfile);
 364 $srva->DeleteFile ($srvaiorfile);
 365 $srvb->DeleteFile ($srvbiorfile);
 366 $cli->DeleteFile ($srvaiorfile);
 367
 368 exit $status;