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