TAO/orbsvcs/tests/FT_Naming/Federation/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 # This is a Perl script that runs a Naming Service test.  It starts
   6 # all the servers and clients as necessary.
   7 # -*- perl -*-
   8
   9 use lib "$ENV{ACE_ROOT}/bin";
  10 use PerlACE::TestTarget;
  11 use Cwd;
  12
  13 #$ENV{ACE_TEST_VERBOSE} = "1";
  14
  15 $status = 0;
  16 $debug_level = '0';
  17 $quiet = 0;
  18
  19 if ($ARGV[0] eq '-q') {
  20     $quiet = 1;
  21 }
  22
  23 foreach $i (@ARGV) {
  24     if ($i eq '-debug') {
  25         $debug_level = '10';
  26     }
  27 }
  28
  29 sub clean_persistence_dir($$)
  30 {
  31     my $target = shift;
  32     my $directory_name = shift;
  33
  34     chdir $directory_name;
  35     opendir(THISDIR, ".");
  36     @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
  37     closedir(THISDIR);
  38     foreach $tmp (@allfiles){
  39         $target->DeleteFile ($tmp);
  40     }
  41     chdir "..";
  42 }
  43
  44 # Make sure that the directory to use to hold the naming contexts exists
  45 # and is cleaned out
  46 sub init_naming_context_directory($$)
  47 {
  48     my $target = shift;
  49     my $directory_name = shift;
  50
  51     if ( ! -d $directory_name ) {
  52         mkdir ($directory_name, 0777);
  53     } else {
  54         clean_persistence_dir ($target, $directory_name);
  55     }
  56 }
  57
  58 # Variables for command-line arguments to client and server
  59 # executables.
  60 my $ns_orb_primary_port1 = 9931;
  61 my $ns_orb_primary_port2 = 9932;
  62 my $ns_orb_backup_port1  = 9933;
  63 my $ns_orb_backup_port2  = 9934;
  64
  65 my $ns_primary_endpoint1 = "iiop://localhost:$ns_orb_primary_port1";
  66 my $ns_backup_endpoint1  = "iiop://localhost:$ns_orb_backup_port1";
  67 my $ns_primary_endpoint2 = "iiop://localhost:$ns_orb_primary_port2";
  68 my $ns_backup_endpoint2  = "iiop://localhost:$ns_orb_backup_port2";
  69
  70 my $ns1_ior = "ns1.ior";
  71 my $ns2_ior = "ns2.ior";
  72 my $nm1_ior = "nm1.ior";
  73 my $nm2_ior = "nm2.ior";
  74 my $iorbase = "test.ior";
  75
  76 my $ns1    = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  77 my $ns2    = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  78 my $server = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  79 my $client = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  80
  81 my $server_iorfile = $server->LocalFile ($iorbase);
  82 my $ns1_iorfile    = $ns1->LocalFile ($ns1_ior);
  83 my $ns2_iorfile    = $ns2->LocalFile ($ns2_ior);
  84 my $nm1_iorfile    = $ns1->LocalFile ($nm1_ior);
  85 my $nm2_iorfile    = $ns2->LocalFile ($nm2_ior);
  86
  87 $server->DeleteFile ($iorbase);
  88 $ns1->DeleteFile ($ns1_ior);
  89 $ns2->DeleteFile ($ns2_ior);
  90
  91 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level -o $server_iorfile");
  92 $CL = $client->CreateProcess ("client", "-ORBdebuglevel $debug_level");
  93
  94 my $tao_ft_naming = "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming";
  95
  96 my $name_dir1 = "NameService1";
  97 my $name_dir2 = "NameService2";
  98
  99 init_naming_context_directory ($ns1, $name_dir1);
 100 init_naming_context_directory ($ns2, $name_dir2);
 101
 102 my $ns1_primary_args = "--primary -ORBListenEndPoints $ns_primary_endpoint1 ".
 103                        "-r $name_dir1";
 104
 105 my $ns1_backup_args = "--backup -ORBListenEndPoints $ns_backup_endpoint1 ".
 106                       "-c $ns1_iorfile -g $nm1_iorfile ".
 107                       "-r $name_dir1";
 108
 109 my $ns2_primary_args = "--primary -ORBListenEndPoints $ns_primary_endpoint2 ".
 110                        "-r $name_dir2";
 111
 112 my $ns2_backup_args = "--backup -ORBListenEndPoints $ns_backup_endpoint2 ".
 113                       "-c $ns2_iorfile -g $nm2_iorfile ".
 114                       "-r $name_dir2";
 115
 116 $NS1_PRIMARY = $ns1->CreateProcess($tao_ft_naming, $ns1_primary_args);
 117 $NS1_BACKUP  = $ns1->CreateProcess($tao_ft_naming, $ns1_backup_args);
 118
 119 $NS2_PRIMARY = $ns2->CreateProcess($tao_ft_naming, $ns2_primary_args);
 120 $NS2_BACKUP  = $ns2->CreateProcess($tao_ft_naming, $ns2_backup_args);
 121
 122 my $replica_primary_ior     = "ns_replica_primary.ior";
 123 my $ns1_replica_primary_ior = "$name_dir1/$replica_primary_ior";
 124 my $ns2_replica_primary_ior = "$name_dir2/$replica_primary_ior";
 125
 126 ################################################################################
 127 # setup END block to cleanup after exit call
 128 ################################################################################
 129 END
 130 {
 131     $server->DeleteFile ($iorbase);
 132
 133     $ns1->DeleteFile ($ns1_ior);
 134     $ns1->DeleteFile ($nm1_ior);
 135
 136     $ns2->DeleteFile ($ns2_ior);
 137     $ns2->DeleteFile ($nm2_ior);
 138
 139     if ( -d $name_dir1 ) {
 140         print STDERR "INFO: removing <$name_dir1>\n";
 141         clean_persistence_dir ($ns1, $name_dir1);
 142         rmdir $name_dir1;
 143     }
 144
 145     if ( -d $name_dir2 ) {
 146         print STDERR "INFO: removing <$name_dir2>\n";
 147         clean_persistence_dir ($ns2, $name_dir2);
 148         rmdir $name_dir2;
 149     }
 150 }
 151
 152 # Run two Naming Servers
 153 $process_status = $NS1_PRIMARY->Spawn ();
 154
 155 if ($process_status != 0) {
 156     print STDERR "ERROR: ns1 returned $process_status\n";
 157     exit 1;
 158 }
 159
 160 if ($ns1->WaitForFileTimed ($ns1_replica_primary_ior,
 161                             $ns1->ProcessStartWaitInterval()) == -1) {
 162     print STDERR "ERROR: cannot find file <$name_dir1/ns_replica_primary.ior>\n";
 163     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 164     exit 1;
 165 }
 166
 167 $process_status = $NS1_BACKUP->Spawn ();
 168
 169 if ($process_status != 0) {
 170     print STDERR "ERROR: ns1 returned $process_status\n";
 171     exit 1;
 172 }
 173
 174 if ($ns1->WaitForFileTimed ($ns1_ior,
 175                             $ns1->ProcessStartWaitInterval()) == -1) {
 176     print STDERR "ERROR: cannot find file <$ns1_ior>\n";
 177     $NS1_BACKUP->Kill (); $NS1_BACKUP->TimedWait (1);
 178     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 179     exit 1;
 180 }
 181
 182 $process_status = $NS2_PRIMARY->Spawn ();
 183
 184 if ($process_status != 0) {
 185     print STDERR "ERROR: ns2 returned $process_status\n";
 186     $NS1_BACKUP->Kill ();  $NS1_BACKUP->TimedWait (1);
 187     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 188     exit 1;
 189 }
 190
 191 if ($ns2->WaitForFileTimed ($ns2_replica_primary_ior,
 192                             $ns2->ProcessStartWaitInterval()) == -1) {
 193     print STDERR "ERROR: cannot find file <$name_dir2/ns_replica_primary.ior>\n";
 194     $NS1_BACKUP->Kill ();  $NS1_BACKUP->TimedWait (1);
 195     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 196     exit 1;
 197 }
 198
 199 $process_status = $NS2_BACKUP->Spawn ();
 200 if ($process_status != 0) {
 201     print STDERR "ERROR: ns2 returned $process_status\n";
 202     $NS2_PRIMARY->Kill (); $NS2_PRIMARY->TimedWait (1);
 203     $NS1_BACKUP->Kill ();  $NS1_BACKUP->TimedWait (1);
 204     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 205     exit 1;
 206 }
 207
 208 if ($ns2->WaitForFileTimed ($ns2_ior,
 209                             $ns2->ProcessStartWaitInterval()) == -1) {
 210     print STDERR "ERROR: cannot find file <$ns2_iorfile>\n";
 211     $NS2_BACKUP->Kill ();  $NS2_BACKUP->TimedWait (1);
 212     $NS2_PRIMARY->Kill (); $NS2_PRIMARY->TimedWait (1);
 213     $NS1_BACKUP->Kill ();  $NS1_BACKUP->TimedWait (1);
 214     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 215     exit 1;
 216 }
 217
 218 $process_status = $SV->Spawn ();
 219
 220 if ($process_status != 0) {
 221     print STDERR "ERROR: server returned $process_status\n";
 222     $NS2_BACKUP->Kill ();  $NS2_BACKUP->TimedWait (1);
 223     $NS2_PRIMARY->Kill (); $NS2_PRIMARY->TimedWait (1);
 224     $NS1_BACKUP->Kill ();  $NS1_BACKUP->TimedWait (1);
 225     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 226     exit 1;
 227 }
 228
 229 if ($server->WaitForFileTimed ($iorbase,
 230                                $server->ProcessStartWaitInterval()) == -1) {
 231     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 232     $NS2_BACKUP->Kill ();  $NS2_BACKUP->TimedWait (1);
 233     $NS2_PRIMARY->Kill (); $NS2_PRIMARY->TimedWait (1);
 234     $NS1_BACKUP->Kill ();  $NS1_BACKUP->TimedWait (1);
 235     $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 236     $SV->Kill (); $SV->TimedWait (1);
 237     exit 1;
 238 }
 239
 240 print STDERR "Starting client\n";
 241 $process_status = $CL->SpawnWaitKill (15);
 242
 243 if ($process_status != 0) {
 244     print STDERR "ERROR: client returned $process_status\n";
 245     $status = 1;
 246 }
 247
 248 $process_status = $SV->TerminateWaitKill ($server->ProcessStopWaitInterval());
 249 if ($process_status != 0) {
 250     print STDERR "ERROR: server returned $process_status\n";
 251     $status = 1;
 252 }
 253
 254 $process_status = $CL->TerminateWaitKill ($client->ProcessStopWaitInterval());
 255
 256 if ($process_status != 0) {
 257     print STDERR "ERROR: client returned $process_status\n";
 258     $status = 1;
 259 }
 260
 261 $NS2_BACKUP->Kill ();  $NS2_BACKUP->TimedWait (1);
 262 $NS2_PRIMARY->Kill (); $NS2_PRIMARY->TimedWait (1);
 263 $NS1_BACKUP->Kill ();  $NS1_BACKUP->TimedWait (1);
 264 $NS1_PRIMARY->Kill (); $NS1_PRIMARY->TimedWait (1);
 265
 266 exit $status;