TAO/orbsvcs/tests/FT_Naming/Load_Balancing/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 $status = 0;
  15 $debug_level = '0';
  16
  17 my $test = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  18 my $server2 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  19 my $client = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  20
  21
  22 # Variables for command-line arguments to naming service executables.
  23 $hostname = $test->HostName ();
  24
  25 $ns_orb_port1 = 10001 + $test->RandomPort ();
  26 $ns_orb_port2 = 10002 + $test->RandomPort ();
  27 $ns_endpoint1 = "iiop://$hostname:$ns_orb_port1";
  28 $ns_endpoint2 = "iiop://$hostname:$ns_orb_port2";
  29
  30 $naming_persistence_dir = "NameService";
  31 $groups_persistence_dir = "Groups";
  32
  33 $primary_iorfile = "$naming_persistence_dir/ns_replica_primary.ior";
  34 $combined_ns_iorfile = "combined_ns.ior";
  35 $combined_nm_iorfile = "combined_nm.ior";
  36
  37 my $test_combined_ns_iorfile = $test->LocalFile ($combined_ns_iorfile);
  38 my $test_combined_nm_iorfile = $test->LocalFile ($combined_nm_iorfile);
  39 my $test_primary_iorfile = $test->LocalFile ($primary_iorfile);
  40
  41 my $server_obj_group_iorfile = "obj.ior";
  42
  43 #Files used by the server2
  44 my $server2_nm_iorfile = $server2->LocalFile ($combined_nm_iorfile);
  45 $server2->DeleteFile($server2_nm_iorfile);
  46 my $server2_ns_iorfile = $server2->LocalFile ($combined_ns_iorfile);
  47 $server2->DeleteFile($server2_ns_iorfile);
  48 my $server2_obj_group_iorfile = $server2->LocalFile ($server_obj_group_iorfile);
  49 $server2->DeleteFile($server_obj_group_iorfile);
  50
  51 #Files which used by client
  52 my $client_ns_iorfile = $client->LocalFile ($combined_ns_iorfile);
  53 $client->DeleteFile($client_ns_iorfile);
  54
  55 $status = 0;
  56
  57 print "INFO: Running the test in ", getcwd(), "\n";
  58
  59 sub clean_persistence_dir($$)
  60 {
  61     my $target = shift;
  62     my $directory_name = shift;
  63
  64     chdir $directory_name;
  65     opendir(THISDIR, ".");
  66     @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
  67     closedir(THISDIR);
  68     foreach $tmp (@allfiles){
  69         $target->DeleteFile ($tmp);
  70     }
  71     chdir "..";
  72 }
  73
  74 # Make sure that the directory to use to hold the persistence data
  75 # exists and is cleaned out.
  76 sub init_persistence_directory($$)
  77 {
  78     my $target = shift;
  79     my $directory_name = shift;
  80
  81     if ( ! -d $directory_name ) {
  82         mkdir ($directory_name, 0777);
  83     } else {
  84         clean_persistence_dir ($target, $directory_name);
  85     }
  86 }
  87
  88
  89 my $args = "-ORBEndPoint $ns_endpoint1 " .
  90     "-m 0 " .
  91     "-r $naming_persistence_dir " .
  92     "-v $groups_persistence_dir " .
  93     "--primary";
  94 my $prog = "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming";
  95
  96 print STDERR "Starting Primary: $prog $args\n";
  97
  98 $NS1 = $test->CreateProcess ("$prog", "$args");
  99
 100 # Clean out the primary ior file to allow us to wait for it
 101 $test->DeleteFile ($primary_iorfile);
 102
 103 init_persistence_directory ($test, $naming_persistence_dir);
 104 init_persistence_directory ($test, $groups_persistence_dir);
 105
 106 $NS1->Spawn ();
 107
 108 if ($test->WaitForFileTimed ($primary_iorfile,
 109                              $test->ProcessStartWaitInterval()) == -1) {
 110     print STDERR "ERROR: cannot find file <$test_primary_iorfile>\n";
 111     $NS1->Kill (); $NS1->TimedWait (1);
 112     exit 1;
 113 }
 114
 115 $args = "-ORBEndPoint $ns_endpoint2 " .
 116         "-g $combined_nm_iorfile " .
 117         "-c $combined_ns_iorfile " .
 118         "-m 0 " .
 119         "-r $naming_persistence_dir " .
 120         "-v $groups_persistence_dir " .
 121         "--backup";
 122
 123 $prog = "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming";
 124
 125 print STDERR "Starting Backup: $prog $args\n";
 126
 127 $NS2 = $test->CreateProcess ("$prog", "$args");
 128
 129 # clean up the old generated ior files
 130 $test->DeleteFile ($combined_ns_iorfile);
 131 $test->DeleteFile ($combined_nm_iorfile);
 132
 133 $NS2->Spawn ();
 134
 135 if ($test->WaitForFileTimed ($combined_ns_iorfile,
 136                              $test->ProcessStartWaitInterval()) == -1) {
 137     print STDERR "ERROR: cannot find file <$test_combined_ns_iorfile>\n";
 138     $NS2->Kill (); $NS2->TimedWait (1);
 139     exit 1;
 140 }
 141
 142 $SV2 = $server2->CreateProcess ("server",
 143                               "-ORBdebuglevel $debug_level " .
 144                               "-ORBInitRef NameService=file://$server2_ns_iorfile " .
 145                               "-ORBInitRef NamingManager=file://$server2_nm_iorfile " .
 146                               "-o $server2_obj_group_iorfile");
 147
 148 $CL = $client->CreateProcess ("client",
 149                               "-ORBInitRef NameService=file://$client_ns_iorfile");
 150
 151 print STDERR "\n\n======== Running Application Controlled Membership Test================\n";
 152 print STDERR "\n";
 153
 154 print STDERR "This test uses the RoundRobin Load Balancing strategy \n";
 155
 156 print STDERR "6 servers are created and added into a Object Group\n";
 157
 158 print STDERR "When the client accesses an object group through the naming service, the";
 159 print STDERR "FT_Naming_Service will apply the RoundRobin load balancing strategy\n";
 160 print STDERR "selects one of the servers and then the client makes an invocations on\n";
 161 print STDERR "the server. This is done 15 times to ensure we support the wraparround\n";
 162 print STDERR "condition.  When done, the application has to delete the object from the\n";
 163 print STDERR "object group. This is called the application controlled membership of\n";
 164 print STDERR "object group.\n";
 165 print STDERR "\n";
 166
 167 $server_status = $SV2->Spawn ();
 168
 169 if ($server_status != 0) {
 170     print STDERR "ERROR: server returned $server_status\n";
 171     exit 1;
 172 }
 173
 174 sub KillServers{
 175     $SV1->Kill (); $SV1->TimedWait (1);
 176     $SV2->Kill (); $SV2->TimedWait (1);
 177 }
 178
 179 if ($server2->WaitForFileTimed ($server_obj_group_iorfile,
 180                                $server2->ProcessStartWaitInterval()) == -1) {
 181     print STDERR "ERROR: cannot find file <$server2_obj_group_iorfile>\n";
 182     KillServers ();
 183     exit 1;
 184 }
 185
 186 if ($server2->GetFile ($server_obj_group_iorfile) == -1) {
 187     print STDERR "ERROR: cannot retrieve file <$server2_obj_group_iorfile>\n";
 188     KillServers ();
 189     exit 1;
 190 }
 191
 192 if ($client->PutFile ($server_obj_group_iorfile) == -1) {
 193     print STDERR "ERROR: cannot set file <$client_ns_iorfile>\n";
 194     KillServers ();
 195     exit 1;
 196 }
 197
 198 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 85);
 199
 200 if ($client_status != 0) {
 201     print STDERR "ERROR: client returned $client_status\n";
 202     $status = 1;
 203 }
 204
 205 $server_status = $SV2->WaitKill ($server2->ProcessStopWaitInterval());
 206
 207 if ($server_status != 0) {
 208     print STDERR "ERROR: server returned $server_status\n";
 209     $status = 1;
 210 }
 211
 212 $server2->DeleteFile($nm_iorfile);
 213 $server2->DeleteFile($server_obj_group_iorfile);
 214 $client->DeleteFile($server_obj_group_iorfile);
 215
 216 $NS1->Kill ();
 217 $NS2->Kill ();
 218
 219 $test->DeleteFile ($primary_iorfile);
 220 $test->DeleteFile ($combined_ns_iorfile);
 221
 222 clean_persistence_dir ($test, $naming_persistence_dir);
 223 clean_persistence_dir ($test, $groups_persistence_dir);
 224 rmdir ($naming_persistence_dir);
 225 rmdir ($groups_persistence_dir);
 226
 227 exit $status;