TAO/orbsvcs/tests/FT_Naming/FaultTolerant/run_equivalence_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 use lib "$ENV{ACE_ROOT}/bin";
   8 use PerlACE::TestTarget;
   9 use Cwd;
  10
  11 #$ENV{ACE_TEST_VERBOSE} = "1";
  12
  13 my $debug_level = '0';
  14 my $redirection_enabled = 0;
  15
  16 foreach $i (@ARGV) {
  17     if ($i eq '-debug') {
  18         $debug_level = '10';
  19         $redirection_enabled = 0;
  20     }
  21 }
  22
  23 my $server  = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  24 my $client  = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  25
  26
  27 # Variables for command-line arguments to client and server
  28 # executables.
  29 my $hostname = $server->HostName ();
  30
  31 my $ns_orb_port1 = 10001 + $server->RandomPort ();
  32 my $ns_orb_port2 = 10002 + $server->RandomPort ();
  33
  34 my $ns_endpoint1 = "iiop://$hostname:$ns_orb_port1";
  35 my $ns_endpoint2 = "iiop://$hostname:$ns_orb_port2";
  36
  37 # References to primary naming service only
  38 my $primary_default_init_ref = "-ORBDefaultInitRef corbaloc:iiop:$hostname:$ns_orb_port1";
  39
  40 # References to backup naming service only
  41 my $backup_default_init_ref = "-ORBDefaultInitRef corbaloc:iiop:$hostname:$ns_orb_port2";
  42
  43 ## Allow the user to determine where the persistence file will be located
  44 ## just in case the current directory is not suitable for locking.
  45 ## We can't change the name of the persistence file because that is not
  46 ## sufficient to work around locking problems for Tru64 when the current
  47 ## directory is NFS mounted from a system that does not properly support
  48 ## locking.
  49 foreach my $possible ($ENV{TMPDIR}, $ENV{TEMP}, $ENV{TMP}) {
  50     if (defined $possible && -d $possible) {
  51       if (chdir($possible)) {
  52         last;
  53       }
  54     }
  55 }
  56
  57 my $status = 0;
  58 my $POSITIVE_TEST_RESULT = 0;
  59 my $NEGATIVE_TEST_RESULT = 1;
  60
  61 my $NSGROUP = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsgroup");
  62 my $NSLIST  = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nslist");
  63 my $NSADD   = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsadd");
  64 my $NSDEL   = $client->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_nsdel");
  65
  66 sub cat_file($)
  67 {
  68     my $file_name = shift;
  69     if (-s $file_name ) # size of file is greater than zero
  70     {
  71         open TESTFILE, $file_name or die "Couldn't open file: $!";
  72         my @teststring = <TESTFILE>; # read in all of the file
  73         print STDERR "\n@teststring\n";
  74         close TESTFILE;
  75     }
  76 }
  77
  78 sub redirect_output()
  79 {
  80     open (OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
  81     open (OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
  82     open STDERR, '>', $client_stderr_file;
  83     open STDOUT, '>', $client_stdout_file;
  84 }
  85
  86 sub restore_output()
  87 {
  88     open (STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
  89     open (STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
  90 }
  91
  92 sub run_nsgroup ($$)
  93 {
  94     my $args = shift;
  95     my $expected_test_result = shift;
  96
  97     my $arglist = "$args";
  98
  99     $NSGROUP->Arguments ($arglist);
 100
 101     if ($redirection_enabled) {
 102         redirect_output();
 103     }
 104
 105     my $nsgroup_status = $NSGROUP->SpawnWaitKill ($client->ProcessStartWaitInterval());
 106
 107     if ($redirection_enabled) {
 108         restore_output();
 109     }
 110
 111     if ($nsgroup_status != $expected_test_result) {
 112         my $time = localtime;
 113         print STDERR "ERROR: nsgroup returned $nsgroup_status at $time\n";
 114         if ($redirection_enabled) {
 115             cat_file($client_stderr_file);
 116             cat_file($client_stdout_file);
 117         }
 118         $status = 1;
 119     }
 120 }
 121
 122 sub run_nslist($$)
 123 {
 124     my $args = shift;
 125     my $expected_test_result = shift;
 126
 127     $NSLIST->Arguments ($args);
 128
 129     if ($redirection_enabled) {
 130         redirect_output();
 131     }
 132
 133     #tao_nslist --ns file://ns.ior
 134     my $nslist_status = $NSLIST->SpawnWaitKill ($client->ProcessStartWaitInterval());
 135
 136     if ($redirection_enabled) {
 137         restore_output();
 138     }
 139
 140     if ($nslist_status != $expected_test_result) {
 141         my $time = localtime;
 142         print STDERR "ERROR: nslist returned $nslist_status at $time\n";
 143         if ($redirection_enabled) {
 144             cat_file($client_stderr_file);
 145             cat_file($client_stdout_file);
 146         }
 147         $status = 1;
 148     }
 149 }
 150
 151 sub run_nsadd($$)
 152 {
 153     my $args = shift;
 154     my $expected_test_result = shift;
 155
 156     $NSADD->Arguments ($args);
 157
 158     if ($redirection_enabled) {
 159         redirect_output();
 160     }
 161
 162     #tao_nsadd --ns file://ns.ior --name iso --ctx
 163     my $nsadd_status = $NSADD->SpawnWaitKill ($client->ProcessStartWaitInterval());
 164
 165     if ($redirection_enabled) {
 166         restore_output();
 167     }
 168
 169     if ($nsadd_status != $expected_test_result) {
 170         my $time = localtime;
 171         print STDERR "ERROR: nsadd returned $nsadd_status at $time\n";
 172         if ($redirection_enabled) {
 173             cat_file($client_stderr_file);
 174             cat_file($client_stdout_file);
 175         }
 176         $status = 1;
 177     }
 178 }
 179
 180 sub run_nsdel($$)
 181 {
 182     my $args = shift;
 183     my $expected_test_result = shift;
 184
 185     $NSDEL->Arguments ($args);
 186
 187     if ($redirection_enabled) {
 188         redirect_output();
 189     }
 190
 191     #tao_nsdel --ns file://ns.ior --name iso --destroy
 192     my $nsdel_status = $NSDEL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 193
 194     if ($redirection_enabled) {
 195         restore_output();
 196     }
 197
 198     if ($nsdel_status != $expected_test_result) {
 199         my $time = localtime;
 200         print STDERR "ERROR: nsdel returned $nsdel_status at $time\n";
 201         if ($redirection_enabled) {
 202             cat_file($client_stderr_file);
 203             cat_file($client_stdout_file);
 204         }
 205         $status = 1;
 206     }
 207 }
 208
 209 sub clean_persistence_dir($$)
 210 {
 211     my $target = shift;
 212     my $directory_name = shift;
 213
 214     chdir $directory_name;
 215     opendir(THISDIR, ".");
 216     @allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
 217     closedir(THISDIR);
 218     foreach $tmp (@allfiles){
 219         $target->DeleteFile ($tmp);
 220     }
 221     chdir "..";
 222 }
 223
 224 # Make sure that the directory to use to hold the naming contexts exists
 225 # and is cleaned out
 226 sub init_naming_context_directory($$)
 227 {
 228     my $target = shift;
 229     my $directory_name = shift;
 230
 231     if ( ! -d $directory_name ) {
 232         mkdir ($directory_name, 0777);
 233     } else {
 234         clean_persistence_dir ($target, $directory_name);
 235     }
 236 }
 237
 238 my $name_dir                   = "NameService";
 239 my $group_dir                  = "GroupService";
 240 my $ns_replica_primary_iorfile = "$name_dir/ns_replica_primary.ior";
 241 my $ns_multi_iorfile           = "ns_multi.ior";
 242 my $nm_multi_iorfile           = "nm_multi.ior";
 243 my $ns_primary_iorfile         = "ns_primary.ior";
 244 my $nm_primary_iorfile         = "nm_primary.ior";
 245 my $ns_backup_iorfile          = "ns_backup.ior";
 246 my $nm_backup_iorfile          = "nm_backup.ior";
 247 my $stderr_file                = "test.err";
 248 my $stdout_file                = "test.out";
 249
 250 ################################################################################
 251 # setup END block to cleanup after exit call
 252 ################################################################################
 253 END
 254 {
 255     $server->DeleteFile ($ns_replica_primary_iorfile);
 256
 257     $server->DeleteFile ($ns_multi_iorfile);
 258     $server->DeleteFile ($nm_multi_iorfile);
 259     $server->DeleteFile ($ns_primary_iorfile);
 260     $server->DeleteFile ($nm_primary_iorfile);
 261     $server->DeleteFile ($ns_backup_iorfile);
 262     $server->DeleteFile ($nm_backup_iorfile);
 263
 264     $client->DeleteFile ($ns_primary_iorfile);
 265     $client->DeleteFile ($nm_primary_iorfile);
 266     $client->DeleteFile ($ns_backup_iorfile);
 267     $client->DeleteFile ($nm_backup_iorfile);
 268     $client->DeleteFile ($stdout_file);
 269     $client->DeleteFile ($stderr_file);
 270
 271     if ( -d $name_dir ) {
 272         print STDERR "INFO: removing <$name_dir>\n";
 273         clean_persistence_dir ($server, $name_dir);
 274         rmdir ($name_dir);
 275     }
 276
 277     if ( -d $group_dir ) {
 278         print STDERR "INFO: removing <$group_dir>\n";
 279         clean_persistence_dir ($server, $group_dir);
 280         rmdir ($group_dir);
 281     }
 282 }
 283
 284 ################################################################################
 285 # Validate that a client can seamlessly invoke naming operations on either
 286 # server instance.
 287 ################################################################################
 288 sub redundant_equivalency_test()
 289 {
 290     my $previous_status = $status;
 291     $status = 0;
 292
 293     print_msg("Redundant Equivalency Test");
 294
 295     init_naming_context_directory ($server, $name_dir);
 296     init_naming_context_directory ($server, $group_dir);
 297
 298     # The file that is written by the primary when ready to start backup
 299     my $server_primary_iorfile    = $server->LocalFile ($ns_replica_primary_iorfile);
 300     my $server_ns_multi_iorfile   = $server->LocalFile ($ns_multi_iorfile);
 301     my $server_nm_multi_iorfile   = $server->LocalFile ($nm_multi_iorfile);
 302
 303     my $server_ns_primary_iorfile = $server->LocalFile ($ns_primary_iorfile);
 304     my $server_nm_primary_iorfile = $server->LocalFile ($nm_primary_iorfile);
 305     my $server_ns_backup_iorfile  = $server->LocalFile ($ns_backup_iorfile);
 306     my $server_nm_backup_iorfile  = $server->LocalFile ($nm_backup_iorfile);
 307
 308     my $client_ns_primary_iorfile = $client->LocalFile ($ns_primary_iorfile);
 309     my $client_nm_primary_iorfile = $client->LocalFile ($nm_primary_iorfile);
 310     my $client_ns_backup_iorfile  = $client->LocalFile ($ns_backup_iorfile);
 311     my $client_nm_backup_iorfile  = $client->LocalFile ($nm_backup_iorfile);
 312
 313     my $client_stdout_file        = $client->LocalFile ($stdout_file);
 314     my $client_stderr_file        = $client->LocalFile ($stderr_file);
 315
 316     my $tao_ft_naming = "$ENV{TAO_ROOT}/orbsvcs/FT_Naming_Service/tao_ft_naming";
 317
 318     # Run two Naming Servers
 319     my $ns1_args = "--primary ".
 320                    "-ORBDebugLevel $debug_level " .
 321                    "-ORBListenEndPoints $ns_endpoint1 ".
 322                    "-o $server_ns_primary_iorfile ".
 323                    "-h $server_nm_primary_iorfile ".
 324                    "-r $name_dir ".
 325                    "-v $group_dir ";
 326
 327     my $ns2_args = "--backup ".
 328                    "-ORBDebugLevel $debug_level " .
 329                    "-ORBListenEndPoints $ns_endpoint2 ".
 330                    "-o $server_ns_backup_iorfile ".
 331                    "-h $server_nm_backup_iorfile ".
 332                    "-c $server_ns_multi_iorfile ".
 333                    "-g $server_nm_multi_iorfile ".
 334                    "-r $name_dir ".
 335                    "-v $group_dir ";
 336
 337     my $client_args = "--equivalence " .
 338                       "-ORBDebugLevel $debug_level " .
 339                       "-p file://$client_ns_primary_iorfile " .
 340                       "-q file://$client_ns_backup_iorfile " .
 341                       "-r file://$client_nm_primary_iorfile " .
 342                       "-s file://$client_nm_backup_iorfile " .
 343                       "-b 4 " .
 344                       "-d 4 ";
 345
 346     my $client_prog = "client";
 347
 348     $NS1 = $server->CreateProcess ($tao_ft_naming, $ns1_args);
 349     $NS2 = $server->CreateProcess ($tao_ft_naming, $ns2_args);
 350     $CL  = $client->CreateProcess ($client_prog, $client_args);
 351
 352     $server->DeleteFile ($ns_primary_iorfile);
 353     $NS1->Spawn ();
 354     if ($server->WaitForFileTimed ($ns_primary_iorfile,
 355                                    $server->ProcessStartWaitInterval()) == -1) {
 356         print STDERR "ERROR: cannot find file <$server_primary_iorfile>\n";
 357         $NS1->Kill (); $NS1->TimedWait (1);
 358         exit 1;
 359     }
 360
 361     $server->DeleteFile ($ns_multi_iorfile);
 362     $NS2->Spawn ();
 363     if ($server->WaitForFileTimed ($ns_multi_iorfile,
 364                                    $server->ProcessStartWaitInterval()) == -1) {
 365         print STDERR "ERROR: cannot find file <$server_ns_multi_iorfile>\n";
 366         $NS2->Kill (); $NS2->TimedWait (1);
 367         $NS1->Kill (); $NS1->TimedWait (1);
 368         exit 1;
 369     }
 370
 371     print_msg("INFO: Starting the client");
 372     $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval()+5);
 373     if ($client_status != 0) {
 374         print STDERR "ERROR: client returned $client_status\n";
 375         $status = 1;
 376     }
 377
 378
 379     $server_status = $NS2->TerminateWaitKill ($server->ProcessStopWaitInterval());
 380     if ($server_status != 0) {
 381         print STDERR "ERROR: server 2 returned $server_status\n";
 382         $status = 1;
 383     }
 384
 385     $server_status = $NS1->TerminateWaitKill ($server->ProcessStopWaitInterval());
 386     if ($server_status != 0) {
 387         print STDERR "ERROR: server 1 returned $server_status\n";
 388         $status = 1;
 389     }
 390
 391     if ( $status == 0 ) {
 392         $status = $previous_status;
 393     }
 394
 395     return $status;
 396 }
 397
 398 sub print_msg($)
 399 {
 400     my $msg = shift;
 401     my $bar = "===============================================================================";
 402     print STDERR "\n\n$bar\n$msg\n$bar\n";
 403 }
 404
 405 sub show_result($$)
 406 {
 407     my $test_result = shift;
 408     my $test_name = shift;
 409
 410     if ( 0 == $test_result ) {
 411         print_msg("$test_name: SUCCESS");
 412     } else {
 413         print_msg("$test_name: ERROR");
 414     }
 415 }
 416
 417 my $result = redundant_equivalency_test ();
 418 show_result($result, "Redundant Equivalency Test");
 419
 420 exit $result;