TAO/orbsvcs/tests/FT_Naming/Replication/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 # Variables for command-line arguments to client and server
  24 # executables.
  25 $hostname = $test->HostName ();
  26
  27 $ns_orb_port1 = 10001 + $test->RandomPort ();
  28 $ns_orb_port2 = 10002 + $test->RandomPort ();
  29 $ft_orb_port1 = 12001 + $test->RandomPort ();
  30 $ft_orb_port2 = 12002 + $test->RandomPort ();
  31 $ns_endpoint1 = "iiop://$hostname:$ns_orb_port1";
  32 $ns_endpoint2 = "iiop://$hostname:$ns_orb_port2";
  33 $ft_endpoint1 = "iiop://$hostname:$ft_orb_port1";
  34 $ft_endpoint2 = "iiop://$hostname:$ft_orb_port2";
  35
  36 $naming_persistence_dir = "NameService";
  37 $groups_persistence_dir = "Groups";
  38
  39 $primary_iorfile = "$naming_persistence_dir/ns_replica_primary.ior";
  40 $combined_ns_iorfile = "combined_ns.ior";
  41 $nm_iorfile = "nm.ior";
  42
  43 print STDERR "$primary_iorfile\n";
  44
  45 ## Allow the user to determine where the persistent file will be located
  46 ## just in case the current directory is not suitable for locking.
  47 ## We can't change the name of the persistent file because that is not
  48 ## sufficient to work around locking problems for Tru64 when the current
  49 ## directory is NFS mounted from a system that does not properly support
  50 ## locking.
  51 foreach my $possible ($ENV{TMPDIR}, $ENV{TEMP}, $ENV{TMP}) {
  52     if (defined $possible && -d $possible) {
  53       if (chdir($possible)) {
  54         last;
  55       }
  56     }
  57 }
  58
  59 my $test_combined_ns_iorfile = $test->LocalFile ($combined_ns_iorfile);
  60 my $test_nm_iorfile = $test->LocalFile ($nm_iorfile);
  61 my $test_primary_iorfile = $test->LocalFile ($primary_iorfile);
  62
  63 $status = 0;
  64
  65 print "INFO: Running the test in ", getcwd(), "\n";
  66
  67 sub clean_persistence_dir($$)
  68 {
  69     my $target = shift;
  70     my $directory_name = shift;
  71
  72     chdir $directory_name;
  73     opendir(THISDIR, ".");
  74     @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
  75     closedir(THISDIR);
  76     foreach $tmp (@allfiles){
  77         $target->DeleteFile ($tmp);
  78     }
  79     chdir "..";
  80 }
  81
  82 # Make sure that the directory to use to hold the persistence data
  83 # exists and is cleaned out.
  84 sub init_persistence_directory($$)
  85 {
  86     my $target = shift;
  87     my $directory_name = shift;
  88
  89     if ( ! -d $directory_name ) {
  90         mkdir ($directory_name, 0777);
  91     } else {
  92         clean_persistence_dir ($target, $directory_name);
  93     }
  94 }
  95
  96
  97 # Run two Naming Servers and one client.  Client uses iors
  98 # in files to find the individual copies of the Naming Servers.
  99
 100 my $args = "-orbdebuglevel 1 -orbverboselogging 1 -ORBLogFile primary.log -ORBEndPoint $ns_endpoint1 " .
 101            "-ftendpoint $ft_endpoint1 " .
 102            "-m 0 " .
 103            "-r $naming_persistence_dir " .
 104            "-v $groups_persistence_dir " .
 105            "-n 100 " .
 106            "--primary";
 107 my $prog = "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming";
 108
 109 print STDERR "Starting Primary: $prog $args\n";
 110
 111 $NS1 = $test->CreateProcess ("$prog", "$args");
 112
 113 $test->DeleteFile ($primary_iorfile);
 114
 115 init_persistence_directory ($test, $naming_persistence_dir);
 116 init_persistence_directory ($test, $groups_persistence_dir);
 117
 118 $NS1->Spawn ();
 119
 120 if ($test->WaitForFileTimed ($primary_iorfile,
 121                              $test->ProcessStartWaitInterval()) == -1) {
 122     print STDERR "ERROR: cannot find file <$test_primary_iorfile>\n";
 123     $NS1->Kill (); $NS1->TimedWait (1);
 124     exit 1;
 125 }
 126
 127 $args = "-ORBEndPoint $ns_endpoint2 " .
 128         "-ftendpoint $ft_endpoint2 " .
 129         "-g $nm_iorfile " .
 130         "-c $combined_ns_iorfile " .
 131         "-m 0 " .
 132         "-n 100 " .
 133         "-r $naming_persistence_dir " .
 134         "-v $groups_persistence_dir " .
 135         "-orbdebuglevel 1 -orbverboselogging 1  -ORBLogFile backup.log " .
 136         "--backup";
 137
 138 $prog = "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming";
 139
 140 print STDERR "Starting Backup: $prog $args\n\n";
 141
 142 $NS2 = $test->CreateProcess ("$prog", "$args");
 143
 144 $test->DeleteFile ($combined_ns_iorfile);
 145 $test->DeleteFile ($nm_iorfile);
 146
 147 $NS2->Spawn ();
 148
 149 if ($test->WaitForFileTimed ($combined_ns_iorfile,
 150                              $test->ProcessStartWaitInterval()) == -1) {
 151     print STDERR "ERROR: cannot find file <$test_combined_ns_iorfile>\n";
 152     $NS2->Kill (); $NS2->TimedWait (1);
 153     exit 1;
 154 }
 155
 156 # Use corbaloc to access each individual name service without
 157 # using the combined IOR.
 158 $args = "-p corbaloc:iiop:$hostname:$ns_orb_port1/NameService " .
 159         "-q corbaloc:iiop:$hostname:$ns_orb_port2/NameService " .
 160         "-b 4 " .
 161         "-d 4 " .
 162         "-t 100";
 163 $prog = "client";
 164
 165 print STDERR "Starting Client: $prog $args\n";
 166
 167 $CL = $test->CreateProcess ("$prog", "$args");
 168
 169 # Some systems may take a very long time to process 100 objects.
 170 $client = $CL->SpawnWaitKill ($test->ProcessStartWaitInterval() + 105);
 171
 172 if ($client != 0) {
 173     print STDERR "ERROR: client returned $client\n";
 174     $status = 1;
 175 }
 176
 177 # Kill the first server and make sure the tree can be accessed
 178 # by the nslist
 179 print STDERR "Killing the primary naming service\n";
 180 $NS1->Kill ();
 181
 182 print STDERR "Printing Naming Tree from combined Name Service pair.\n";
 183
 184 $prog = "$ENV{TAO_ROOT}/utils/nslist/tao_nslist";
 185 $args = "--ns file://$combined_ns_iorfile";
 186
 187 $NSL = $test->CreateProcess("$prog", "$args");
 188
 189
 190 $out = $NSL->SpawnWaitKill (60);
 191
 192 # Now kill off the backup
 193 $NS2->Kill ();
 194
 195 $test->DeleteFile ($primary_iorfile);
 196 $test->DeleteFile ($combined_ns_iorfile);
 197
 198 # Clean out the persistence dir after the test completes
 199 clean_persistence_dir ($test, $naming_persistence_dir);
 200 clean_persistence_dir ($test, $groups_persistence_dir);
 201
 202 rmdir ($naming_persistence_dir);
 203 rmdir ($groups_persistence_dir);
 204
 205 exit $status;