TAO/orbsvcs/tests/ImplRepo/ping_interrupt/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 ###############################################################################
   8 use lib "$ENV{ACE_ROOT}/bin";
   9 use PerlACE::TestTarget;
  10
  11 $status = 0;
  12 $imr_debug = "";
  13 $act_debug = "";
  14
  15 if ($#ARGV >= 0) {
  16     for (my $i = 0; $i <= $#ARGV; $i++) {
  17         if ($ARGV[$i] eq '-debug') {
  18             $imr_debug = "-d 10 -ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile imr_loc.log";
  19             $act_debug = "-d 10 -ORBDebugLevel 10 -ORBVerboseLogging 1 -ORBLogFile imr_act.log";
  20             $i++;
  21         }
  22         else {
  23             usage();
  24             exit 1;
  25         }
  26     }
  27 }
  28
  29 #$ENV{ACE_TEST_VERBOSE} = "1";
  30
  31 my $tgt_num = 0;
  32 my $imr = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  33 my $act = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  34 my $ti  = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  35 my $srv = PerlACE::TestTarget::create_target (++$tgt_num) || die "Create target $tgt_num failed\n";
  36
  37 my $refstyle = " -ORBobjrefstyle URL";
  38 my $obj_count = 1;
  39 my $port = 9876;
  40
  41 my $objprefix = "TestObject_0";
  42 my $client_wait_time = 10;
  43
  44 $imriorfile = "imr_locator.ior";
  45 $actiorfile = "imr_activator.ior";
  46 $persistxml = "persist.xml";
  47 $persistdat = "persist.dat";
  48
  49 my $imr_imriorfile = $imr->LocalFile ($imriorfile);
  50 my $act_imriorfile = $act->LocalFile ($imriorfile);
  51 my $ti_imriorfile = $ti->LocalFile ($imriorfile);
  52 my $act_actiorfile = $act->LocalFile ($actiorfile);
  53 my $imr_persistxml = $imr->LocalFile ($persistxml);
  54 my $imr_persistdat = $imr->LocalFile ($persistdat);
  55
  56 $IMR = $imr->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_locator");
  57 $ACT = $act->CreateProcess ("$ENV{TAO_ROOT}/orbsvcs/ImplRepo_Service/tao_imr_activator");
  58 $TI = $ti->CreateProcess ("$ENV{ACE_ROOT}/bin/tao_imr");
  59
  60 # Make sure the files are gone, so we can wait on them.
  61 $imr->DeleteFile ($imriorfile);
  62 $act->DeleteFile ($imriorfile);
  63 $ti->DeleteFile ($imriorfile);
  64 $act->DeleteFile ($actiorfile);
  65 $imr->DeleteFile ($persistxml);
  66 $imr->DeleteFile ($persistdat);
  67
  68 my $stdout_file      = "test.out";
  69 my $stderr_file      = "test.err";
  70 my $ti_stdout_file = $ti->LocalFile ($stdout_file);
  71 my $ti_stderr_file = $ti->LocalFile ($stderr_file);
  72
  73 # Clean up after exit call
  74 END
  75 {
  76     $imr->DeleteFile ($imriorfile);
  77     $act->DeleteFile ($imriorfile);
  78     $ti->DeleteFile ($imriorfile);
  79     $act->DeleteFile ($actiorfile);
  80     $imr->DeleteFile ($persistxml);
  81     $imr->DeleteFile ($persistdat);
  82
  83     $ti->DeleteFile ($stdout_file);
  84     $ti->DeleteFile ($stderr_file);
  85
  86     # Remove any stray server status files caused by aborting services
  87     unlink <*.status>;
  88 }
  89
  90 sub redirect_output()
  91 {
  92     open(OLDOUT, ">&", \*STDOUT) or die "Can't dup STDOUT: $!";
  93     open(OLDERR, ">&", \*STDERR) or die "Can't dup STDERR: $!";
  94     open STDERR, '>', $ti_stderr_file;
  95     open STDOUT, '>', $ti_stdout_file;
  96 }
  97
  98 sub restore_output()
  99 {
 100     open(STDERR, ">&OLDERR") or die "Can't dup OLDERR: $!";
 101     open(STDOUT, ">&OLDOUT") or die "Can't dup OLDOUT: $!";
 102 }
 103
 104 sub server_setup ()
 105 {
 106     print "initializing activator\n";
 107
 108     $ACT->Arguments ("-l -o $act_actiorfile -ORBInitRef ImplRepoService=file://$act_imriorfile $act_debug");
 109
 110     $ACT_status = $ACT->Spawn ();
 111     if ($ACT_status != 0) {
 112         print STDERR "ERROR: ImR Activator returned $ACT_status\n";
 113         return 1;
 114     }
 115     if ($act->WaitForFileTimed ($actiorfile,$act->ProcessStartWaitInterval()) == -1) {
 116         print STDERR "ERROR: cannot find file <$act_imriorfile>\n";
 117         $ACT->Kill (); $ACT->TimedWait (1);
 118         $IMR->Kill (); $IMR->TimedWait (1);
 119         return 1;
 120     }
 121
 122     my $SRV = $srv->CreateProcess ("server");
 123     my $server_cmd = $SRV->Executable();
 124     my $srv_server_cmd = $imr->LocalFile ($server_cmd);
 125
 126     ##### Add servers to activator #####
 127     print "adding server\n";
 128     my $status_file_name = $objprefix . ".status";
 129
 130     $act->DeleteFile ($status_file_name);
 131     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 132                     "add $objprefix -c \"$srv_server_cmd -ORBUseIMR 1 ".
 133                     "-ORBInitRef ImplRepoService=file://$imr_imriorfile\"");
 134
 135     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 136     if ($TI_status != 0) {
 137         print STDERR "ERROR: tao_imr returned $TI_status\n";
 138         $ACT->Kill (); $ACT->TimedWait (1);
 139         $IMR->Kill (); $IMR->TimedWait (1);
 140         return 1;
 141     }
 142
 143     $TI->Arguments ("-ORBInitRef ImplRepoService=file://$ti_imriorfile ".
 144                     "start $objprefix");
 145
 146     $TI_status = $TI->SpawnWaitKill ($ti->ProcessStartWaitInterval());
 147     if ($TI_status != 0 && $TI_status != 4) {
 148         print STDERR "ERROR: tao_imr returned $TI_status\n";
 149         $ACT->Kill (); $ACT->TimedWait (1);
 150         $IMR->Kill (); $IMR->TimedWait (1);
 151         return 1;
 152     }
 153     $TI_status = 0;
 154 }
 155
 156 sub interrupt_ping_test
 157 {
 158     print "Running interrupt ping test.\n";
 159
 160     my $result = 0;
 161     my $start_time = time();
 162
 163     $IMR->Arguments ("-i $imr_debug -o $imr_imriorfile -orbendpoint iiop://:$port");
 164
 165     ##### Start ImplRepo #####
 166     $IMR_status = $IMR->Spawn ();
 167     if ($IMR_status != 0) {
 168         print STDERR "ERROR: ImplRepo Service returned $IMR_status\n";
 169         return 1;
 170     }
 171     if ($imr->WaitForFileTimed ($imriorfile, $imr->ProcessStartWaitInterval()) == -1) {
 172         print STDERR "ERROR: cannot find file <$imr_imriorfile>\n";
 173         $IMR->Kill (); $IMR->TimedWait (1);
 174         return 1;
 175     }
 176     if ($imr->GetFile ($imriorfile) == -1) {
 177         print STDERR "ERROR: cannot retrieve file <$imr_imriorfile>\n";
 178         $IMR->Kill (); $IMR->TimedWait (1);
 179         return 1;
 180     }
 181     if ($act->PutFile ($imriorfile) == -1) {
 182         print STDERR "ERROR: cannot set file <$act_imriorfile>\n";
 183         $IMR->Kill (); $IMR->TimedWait (1);
 184         return 1;
 185     }
 186     if ($ti->PutFile ($imriorfile) == -1) {
 187         print STDERR "ERROR: cannot set file <$ti_imriorfile>\n";
 188         $IMR->Kill (); $IMR->TimedWait (1);
 189         return 1;
 190     }
 191     if ($srv->PutFile ($imriorfile) == -1) {
 192         print STDERR "ERROR: cannot set file <$srv_imriorfile>\n";
 193         $IMR->Kill (); $IMR->TimedWait (1);
 194         return 1;
 195     }
 196
 197     server_setup();
 198
 199     sleep (2);
 200
 201     my $ACT_status = $ACT->TerminateWaitKill ($act->ProcessStopWaitInterval());
 202     if ($ACT_status != 0) {
 203         print STDERR "ERROR: IMR Activator returned $ACT_status\n";
 204         $status = 1;
 205     }
 206
 207     my $IMR_status = $IMR->TerminateWaitKill ($imr->ProcessStopWaitInterval());
 208     if ($IMR_status != 0) {
 209         print STDERR "ERROR: IMR returned $IMR_status\n";
 210         $status = 1;
 211     }
 212
 213     my $test_time = time() - $start_time;
 214
 215     print "\nFinished. The test took $test_time seconds.\n";
 216
 217     return $status;
 218 }
 219
 220 sub usage() {
 221     print "Usage: run_test.pl [-debug]\n";
 222 }
 223
 224 ###############################################################################
 225 ###############################################################################
 226
 227 my $ret = interrupt_ping_test();
 228
 229 exit $ret;