TAO/orbsvcs/tests/Redundant_Naming/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 a Naming Service test.  It starts
   8 # all the servers and clients as necessary.
   9
  10 use lib "$ENV{ACE_ROOT}/bin";
  11 use PerlACE::TestTarget;
  12 use Cwd;
  13
  14 $quiet = 0;
  15
  16 # check for -q flag
  17 if ($ARGV[0] eq '-q') {
  18     $quiet = 1;
  19 }
  20
  21 my $test = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  22
  23 $hostname = $test->HostName ();
  24 # Variables for command-line arguments to client and server
  25 # executables.
  26 $ns_orb_port1 = 10001 + $test->RandomPort ();
  27 $ns_orb_port2 = 10002 + $test->RandomPort ();
  28 $ns_endpoint1 = "iiop://$hostname:$ns_orb_port1";
  29 $ns_endpoint2 = "iiop://$hostname:$ns_orb_port2";
  30
  31
  32 $iorfile1 = "ns1.ior";
  33 $iorfile2 = "ns2.ior";
  34
  35 ## Allow the user to determine where the persistent file will be located
  36 ## just in case the current directory is not suitable for locking.
  37 ## We can't change the name of the persistent file because that is not
  38 ## sufficient to work around locking problems for Tru64 when the current
  39 ## directory is NFS mounted from a system that does not properly support
  40 ## locking.
  41 foreach my $possible ($ENV{TMPDIR}, $ENV{TEMP}, $ENV{TMP}) {
  42     if (defined $possible && -d $possible) {
  43       if (chdir($possible)) {
  44         last;
  45       }
  46     }
  47 }
  48
  49 my $test_iorfile1 = $test->LocalFile ($iorfile1);
  50 my $test_iorfile2 = $test->LocalFile ($iorfile2);
  51
  52 $status = 0;
  53
  54
  55
  56 print "INFO: Running the test in ", getcwd(), "\n";
  57
  58 # Make sure that the directory to use to hold the naming contexts exists
  59 # and is cleaned out
  60 if ( ! -d "NameService" ) {
  61     mkdir (NameService, 0777);
  62     }
  63 else {
  64     chdir "NameService";
  65     opendir(THISDIR, ".");
  66     @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
  67     closedir(THISDIR);
  68     foreach $tmp (@allfiles){
  69         $test->DeleteFile ($tmp);
  70     }
  71     chdir "..";
  72 }
  73
  74 # Run two Naming Servers in redundant mode and one client.  Client uses iors
  75 # in files to find the individual copies of the Naming Servers.
  76
  77 my $args = "-ORBEndPoint $ns_endpoint1 -o $iorfile1 -m 0 -r NameService";
  78 my $prog = "$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming";
  79
  80 $NS1 = $test->CreateProcess ("$prog", "$args");
  81
  82 $test->DeleteFile ($iorfile1);
  83
  84 $NS1->Spawn ();
  85
  86 if ($test->WaitForFileTimed ($iorfile1,
  87                                $test->ProcessStartWaitInterval()) == -1) {
  88     print STDERR "ERROR: cannot find file <$test_iorfile1>\n";
  89     $NS1->Kill (); $NS1->TimedWait (1);
  90     exit 1;
  91 }
  92
  93 $args = "-ORBEndPoint $ns_endpoint2 -o $test_iorfile2 -m 0 -r NameService";
  94 $prog = "$ENV{TAO_ROOT}/orbsvcs/Naming_Service/tao_cosnaming";
  95
  96 $NS2 = $test->CreateProcess ("$prog", "$args");
  97
  98 $test->DeleteFile ($iorfile2);
  99
 100 $NS2->Spawn ();
 101
 102 if ($test->WaitForFileTimed ($iorfile2,
 103                                $test->ProcessStartWaitInterval()) == -1) {
 104     print STDERR "ERROR: cannot find file <$test_iorfile2>\n";
 105     $NS2->Kill (); $NS2->TimedWait (1);
 106     exit 1;
 107 }
 108
 109 ## Even though the ior file is present, the redundant naming service
 110 ## isn't really ready to go (most of the time).  Sleeping 1 second
 111 ## allows the redundant naming service to get to a usable state.
 112 sleep(1);
 113
 114 $args = "-p file://$test_iorfile1 -q file://$test_iorfile2";
 115 $prog = "client";
 116
 117 $CL = $test->CreateProcess ("$prog", "$args");
 118
 119 $client = $CL->SpawnWaitKill ($test->ProcessStartWaitInterval());
 120
 121 if ($client != 0) {
 122     print STDERR "ERROR: client returned $client\n";
 123     $status = 1;
 124 }
 125
 126 $NS1->Kill ();
 127 $NS2->Kill ();
 128
 129 $test->DeleteFile ($iorfile1);
 130 $test->DeleteFile ($iorfile2);
 131
 132 exit $status;