TAO/examples/ior_corbaloc/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 # This is a Perl Script that runs the corbaloc: style URL tests.
   8 # It starts the servers and client.
   9
  10 use lib "$ENV{ACE_ROOT}/bin";
  11 use PerlACE::TestTarget;
  12
  13 $status = 0;
  14 $debug_level = '0';
  15
  16 foreach $i (@ARGV) {
  17     if ($i eq '-debug') {
  18         $debug_level = '10';
  19     }
  20 }
  21
  22 my @servers = (
  23     (PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n"),
  24     (PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n"),
  25     (PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n"));
  26 my @iorbases = ("ns1.ior", "ns2.ior", "ns2.ior");
  27 my @SV_NAMES = ("STATUS", "STATUS1", "STATUS");
  28
  29 # We run two tao_cosnaming processes.  One on an arbitrary port,
  30 # and one on the corbaloc: default port of 2809
  31 my @nstargets = (
  32     (PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n"),
  33     (PerlACE::TestTarget::create_target (5) || die "Create target 5 failed\n"));
  34 my $def_port = 2809;
  35 my @ns_orb_ports = ($nstargets[0]->RandomPort (),
  36                     $def_port);
  37
  38 my @clients = (
  39     (PerlACE::TestTarget::create_target (6) || die "Create target 6 failed\n"),
  40     (PerlACE::TestTarget::create_target (7) || die "Create target 7 failed\n"));
  41
  42 my @NSes = ();
  43 my @ns_hostnames = ();
  44 for ($i = 0; $i <= $#nstargets; $i++) {
  45     my $TARGETHOSTNAME = $nstargets[$i]->HostName ();
  46     my $ns_iorfile = $nstargets[$i]->LocalFile ($iorbases[$i]);
  47     $nstargets[$i]->DeleteFile($iorbases[$i]);
  48     foreach $svtarget (@servers) {
  49         my $sv_iorfile = $svtarget->LocalFile ($iorbases[$i]);
  50         $svtarget->DeleteFile($iorbases[$i]);
  51     }
  52     foreach $cltarget (@clients) {
  53         my $cl_iorfile = $cltarget->LocalFile ($iorbases[$i]);
  54         $cltarget->DeleteFile($iorbases[$i]);
  55     }
  56
  57     my $NS = $nstargets[$i]->CreateProcess (
  58         "$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming",
  59         "-ORBListenEndpoints iiop://$TARGETHOSTNAME:$ns_orb_ports[$i] ".
  60         "-o $ns_iorfile -m 0");
  61
  62     print STDERR "Spawning Naming Service on port $ns_orb_ports[$i]......\n";
  63
  64     $ns_status = $NS->Spawn ();
  65
  66     if ($ns_status != 0) {
  67         print STDERR "ERROR: ns returned $ns_status\n";
  68         foreach $tmp (@NSes) {
  69             $tmp->Kill (); $tmp->TimedWait (1);
  70         }
  71         exit 1;
  72     }
  73
  74     if ($nstargets[$i]->WaitForFileTimed (
  75             $iorbases[$i],
  76             $nstargets[$i]->ProcessStartWaitInterval()) == -1) {
  77         print STDERR "ERROR: cannot find file <$ns_iorfile>\n";
  78         foreach $tmp (@NSes) {
  79             $tmp->Kill (); $tmp->TimedWait (1);
  80         }
  81         exit 1;
  82     }
  83
  84     if ($nstargets[$i]->GetFile ($iorbases[$i]) == -1) {
  85         print STDERR "ERROR: cannot retrieve file <$ns_iorfile>\n";
  86         $NS->Kill (); $NS->TimedWait (1);
  87         foreach $tmp (@NSes) {
  88             $tmp->Kill (); $tmp->TimedWait (1);
  89         }
  90         exit 1;
  91     }
  92
  93     foreach $svtarget (@servers) {
  94         my $sv_iorfile = $svtarget->LocalFile ($iorbases[$i]);
  95
  96         if ($svtarget->PutFile ($iorbases[$i]) == -1) {
  97             print STDERR "ERROR: cannot set file <$sv_iorfile>\n";
  98             $NS->Kill (); $NS->TimedWait (1);
  99             foreach $tmp (@NSes) {
 100                 $tmp->Kill (); $tmp->TimedWait (1);
 101             }
 102             exit 1;
 103         }
 104     }
 105
 106     foreach $cltarget (@clients) {
 107         my $cl_iorfile = $cltarget->LocalFile ($iorbases[$i]);
 108
 109         if ($cltarget->PutFile ($iorbases[$i]) == -1) {
 110             print STDERR "ERROR: cannot set file <$cl_iorfile>\n";
 111             $NS->Kill (); $NS->TimedWait (1);
 112             foreach $tmp (@NSes) {
 113                 $tmp->Kill (); $tmp->TimedWait (1);
 114             }
 115             exit 1;
 116         }
 117     }
 118
 119     push @NSes, $NS;
 120     push @ns_hostnames, $TARGETHOSTNAME;
 121 }
 122
 123 sleep (2);
 124
 125 my @SVs = ();
 126 for ($i = 0; $i <= $#servers; $i++) {
 127     my $sv_iorfile = $servers[$i]->LocalFile ($iorbases[$i]);
 128
 129     my $SV = $servers[$i]->CreateProcess (
 130         "server",
 131         "-ORBInitRef NameService=file://$sv_iorfile $SV_NAMES[$i]");
 132
 133     print STDERR "Spawning server with name $SV_NAMES[$i]\n";
 134
 135     $server_status = $SV->Spawn ();
 136
 137     if ($server_status != 0) {
 138         print STDERR "ERROR: server returned $server_status\n";
 139         foreach $tmp (@NSes) {
 140             $tmp->Kill (); $tmp->TimedWait (1);
 141         }
 142         foreach $tmp (@SVs) {
 143             $tmp->Kill (); $tmp->TimedWait (1);
 144         }
 145         exit 1;
 146     }
 147
 148     push @SVs, $SV;
 149 }
 150
 151 sleep (10);
 152
 153 # List of tests to test corbaloc URL syntax.
 154 my @corbaloc_tests = (
 155     "corbaloc:rir:/NameService",
 156     "corbaloc:rir:/",
 157     "corbaloc:iiop:$ns_hostnames[0]:$ns_orb_port[0]/NameService",
 158     "corbaloc::$ns_hostnames[0]:$ns_orb_port[0]/NameService",
 159     "corbaloc::1.0\@$ns_hostnames[0]:$ns_orb_port[0]/NameService",
 160     "corbaloc::$ns_hostnames[0]/NameService",
 161     "corbaloc::1.1\@$ns_hostnames[0]:$ns_orb_port[0]/NameService",
 162     "corbaloc::1.2\@$ns_hostnames[0]:$ns_orb_port[0]/NameService");
 163
 164 my @comments = (
 165     "Using RIR protocol with the object key specified:\n",
 166     "Using RIR protocol without specifying the object key\n".
 167     "    (empty object key defaults to \"NameService\"):\n",
 168     "Using IIOP protocol with the hostname, port specified:\n",
 169     "Using IIOP protocol, with protocol unspecified, hostname\n".
 170     "    specified, port specified:\n",
 171     "Using the default protocol (iiop) with the hostname, port specified:\n",
 172     "Using IIOP protocol with protocol unspecified, hostname\n".
 173     "    specified, port unspecified (should default to $def_port):\n",
 174     "Using version 1.1 of protocol:\n",
 175     "Using version 1.2 of protocol:\n");
 176
 177 $test_number = 0;
 178
 179 my @CLs = ($clients[0]->CreateProcess ("client"),
 180            $clients[1]->CreateProcess ("corbaname_client"));
 181
 182 my @client_iorfiles = ($clients[0]->LocalFile ($iorbases[0]),
 183                        $clients[1]->LocalFile ($iorbases[1]));
 184
 185 print STDERR "\n======= Running corbaloc: tests\n";
 186 foreach $o (@corbaloc_tests) {
 187     print STDERR "\n".$test_number.".  ".$comments[$test_number];
 188     print STDERR "             $o\n";
 189
 190     $CLs[0]->Arguments ("$o -ORBInitRef NameService=file://$client_iorfiles[0]");
 191
 192     $client_status =
 193         $CLs[0]->SpawnWaitKill ($clients[0]->ProcessStartWaitInterval() + 45);
 194
 195     if ($client_status != 0) {
 196         print STDERR "ERROR: client returned $client_status\n";
 197         foreach $tmp (@NSes) {
 198             $tmp->Kill (); $tmp->TimedWait (1);
 199         }
 200         foreach $tmp (@SVs) {
 201             $tmp->Kill (); $tmp->TimedWait (1);
 202         }
 203         exit 1;
 204     }
 205
 206     $test_number++;
 207 }
 208
 209 @corbaname_tests = (
 210     "corbaname:iiop:$ns_hostnames[0]:$ns_orb_ports[0]#$SV_NAMES[0]",
 211     "corbaname::$ns_hostnames[0]:$ns_orb_ports[0]#$SV_NAMES[0]",
 212     "corbaname::$ns_hostnames[1]#$SV_NAMES[1]",
 213     "corbaname::$ns_hostnames[1]:$ns_orb_ports[1]#$SV_NAMES[1]",
 214     "corbaname:rir:#$SV_NAMES[1]".
 215     " -ORBInitRef NameService=file://$client_iorfiles[1]");
 216
 217 print STDERR "\n======= Running corbaname: tests\n";
 218 foreach $o ( @corbaname_tests) {
 219     print STDERR "\n$test_number:  $o\n";
 220
 221     $CLs[1]->Arguments ("$o $corbaname_tests[$i] -ORBdebuglevel $debug_level ");
 222
 223     $client_status =
 224         $CLs[1]->SpawnWaitKill ($clients[1]->ProcessStartWaitInterval() + 45);
 225
 226     if ($client_status != 0) {
 227         print STDERR "ERROR: client returned $client_status\n";
 228         foreach $tmp (@NSes) {
 229             $tmp->Kill (); $tmp->TimedWait (1);
 230         }
 231         foreach $tmp (@SVs) {
 232             $tmp->Kill (); $tmp->TimedWait (1);
 233         }
 234         exit 1;
 235     }
 236
 237     $test_number++;
 238 }
 239
 240 print STDERR "\nFinalize\n";
 241
 242 $i = 0;
 243 foreach $ns (@NSes) {
 244     $ns_status =
 245         $ns->TerminateWaitKill ($nstargets[$i]->ProcessStopWaitInterval());
 246
 247     if ($ns_status != 0) {
 248         print STDERR "ERROR: ns returned $ns_status\n";
 249         foreach $tmp (@NSes) {
 250             $tmp->Kill (); $tmp->TimedWait (1);
 251         }
 252         foreach $tmp (@SVs) {
 253             $tmp->Kill (); $tmp->TimedWait (1);
 254         }
 255         exit 1;
 256     }
 257
 258     $nstargets[$i]->DeleteFile($iorbases[$i]);
 259     $i++;
 260 }
 261
 262 $i = 0;
 263 foreach $sv (@SVs) {
 264     $server_status =
 265         $sv->TerminateWaitKill ($servers[$i]->ProcessStopWaitInterval());
 266
 267     if ($server_status != 0) {
 268         print STDERR "ERROR: server returned $server_status\n";
 269         foreach $tmp (@SVs) {
 270             $tmp->Kill (); $tmp->TimedWait (1);
 271         }
 272         exit 1;
 273     }
 274
 275     $servers[$i]->DeleteFile($iorbases[$i]);
 276     $i++;
 277 }
 278
 279 $clients[0]->DeleteFile($iorbases[0]);
 280 $clients[0]->DeleteFile($iorbases[1]);
 281 $clients[1]->DeleteFile($iorbases[0]);
 282 $clients[1]->DeleteFile($iorbases[1]);
 283
 284 exit $status;