TAO/orbsvcs/tests/Security/Crash_Test/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 use lib "$ENV{ACE_ROOT}/bin";
   8 use PerlACE::TestTarget;
   9
  10 $status = 0;
  11 $debug_level = '0';
  12
  13 $client_wait_time = 15;
  14
  15
  16 foreach $i (@ARGV) {
  17     if ($i eq '-debug') {
  18         $debug_level = '10';
  19     }
  20 }
  21
  22 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  23 my $client1 = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  24 my $client2 = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  25 my $client3 = PerlACE::TestTarget::create_target (4) || die "Create target 4 failed\n";
  26
  27 my $iorbase = "server.ior";
  28 my $server_iorfile = $server->LocalFile ($iorbase);
  29 my $client1_iorfile = $client1->LocalFile ($iorbase);
  30 my $client2_iorfile = $client2->LocalFile ($iorbase);
  31 my $client3_iorfile = $client3->LocalFile ($iorbase);
  32 $server->DeleteFile($iorbase);
  33 $client1->DeleteFile($iorbase);
  34 $client2->DeleteFile($iorbase);
  35 $client3->DeleteFile($iorbase);
  36
  37 #Config files
  38 $server_conf = $server->LocalFile ("server" . $PerlACE::svcconf_ext);
  39 $client1_conf = $client1->LocalFile ("client" . $PerlACE::svcconf_ext);
  40 $client2_conf = $client2->LocalFile ("client" . $PerlACE::svcconf_ext);
  41 $client3_conf = $client3->LocalFile ("client" . $PerlACE::svcconf_ext);
  42
  43 $port = $server->RandomPort ();
  44
  45 # Set the SSL environment
  46 # This doesn't work on Windows.  For some reason,
  47 # environment variables aren't propagated to child processes.
  48 #$ENV{'SSL_CERT_FILE'} = 'cacert.pem';
  49
  50 $SV = $server->CreateProcess ("server", "-ORBdebuglevel $debug_level " .
  51                               "-ORBSvcConf $server_conf " .
  52                               "-ORBdotteddecimaladdresses 1 " .
  53                               "-ORBEndpoint iiop://:/ssl_port=$port " .
  54                               "-o $server_iorfile");
  55
  56 $CL1 = $client1->CreateProcess ("client",
  57                                 "-ORBSvcConf $client1_conf " .
  58                                 "-w $client_wait_time " .
  59                                 "-s " .
  60                                 "-k file://$client1_iorfile");
  61
  62 $CL2 = $client2->CreateProcess ("client",
  63                                 "-ORBSvcConf $client2_conf " .
  64                                 "-w $client_wait_time " .
  65                                 "-k file://$client2_iorfile");
  66
  67 $CL3 = $client3->CreateProcess ("client",
  68                                 "-ORBSvcConf $client3_conf " .
  69                                 "-w $client_wait_time " .
  70                                 "-k file://$client3_iorfile");
  71
  72
  73 local $start_time = time();
  74 local $max_running_time = 500; # < 10 minutes
  75 local $elapsed = time() - $start_time;
  76
  77 if ($ARGV[0] eq '-quick')  {
  78     $elapsed = 0;
  79     $max_running_time = 1;
  80 }
  81
  82 while($status == 0 && $elapsed < $max_running_time){
  83
  84     # Start the server
  85     $server_status = $SV->Spawn ();
  86
  87     if ($server_status != 0) {
  88         print STDERR "ERROR: server returned $server_status\n";
  89         exit 1;
  90     }
  91
  92     if ($server->WaitForFileTimed ($iorbase,
  93                                $server->ProcessStartWaitInterval()) == -1) {
  94         print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  95         $SV->Kill (); $SV->TimedWait (1);
  96         exit 1;
  97     }
  98     if ($server->GetFile ($iorbase) == -1) {
  99         print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 100         $SV->Kill (); $SV->TimedWait (1);
 101         exit 1;
 102     }
 103     if ($client1->PutFile ($iorbase) == -1) {
 104         print STDERR "ERROR: cannot set file <$client1_iorfile>\n";
 105         $SV->Kill (); $SV->TimedWait (1);
 106         exit 1;
 107     }
 108     if ($client2->PutFile ($iorbase) == -1) {
 109         print STDERR "ERROR: cannot set file <$client2_iorfile>\n";
 110         $SV->Kill (); $SV->TimedWait (1);
 111         exit 1;
 112     }
 113     if ($client3->PutFile ($iorbase) == -1) {
 114         print STDERR "ERROR: cannot set file <$client3_iorfile>\n";
 115         $SV->Kill (); $SV->TimedWait (1);
 116         exit 1;
 117     }
 118
 119     # Start all clients in parallel
 120     $client_status = $CL1->Spawn ();
 121
 122     if ($client_status != 0) {
 123         print STDERR "ERROR: client #1 returned $client_status\n";
 124         $SV->Kill (); $SV->TimedWait (1);
 125         $CL1->Kill (); $CL1->TimedWait (1);
 126         exit 1;
 127     }
 128
 129     $client_status = $CL2->Spawn ();
 130
 131     if ($client_status != 0) {
 132         print STDERR "ERROR: client #2 returned $client_status\n";
 133         $SV->Kill (); $SV->TimedWait (1);
 134         $CL1->Kill (); $CL1->TimedWait (1);
 135         $CL2->Kill (); $CL2->TimedWait (1);
 136         exit 1;
 137     }
 138
 139     $client_status = $CL3->Spawn ();
 140
 141     if ($client_status != 0) {
 142         print STDERR "ERROR: client #2 returned $client_status\n";
 143         $SV->Kill (); $SV->TimedWait (1);
 144         $CL1->Kill (); $CL1->TimedWait (1);
 145         $CL2->Kill (); $CL2->TimedWait (1);
 146         $CL3->Kill (); $CL3->TimedWait (1);
 147         exit 1;
 148     }
 149
 150     # Let our clients to execute few requests
 151     sleep (3);
 152
 153     # Now kill the server and start it again.
 154     $SV->Kill ();
 155     $SV->TimedWait (1);
 156
 157     sleep (5);
 158
 159     $server->DeleteFile($iorbase);
 160     $client1->DeleteFile($iorbase);
 161     $client2->DeleteFile($iorbase);
 162     $client3->DeleteFile($iorbase);
 163
 164
 165     $server_status = $SV->Spawn ();
 166
 167     if (0 != $server_status){
 168       print STDERR "ERROR: Restarting server returned $server_status\n";
 169       $CL3->Kill ();
 170       $CL2->Kill ();
 171       $CL1->Kill ();
 172       exit 1;
 173     }
 174
 175     if ($server->WaitForFileTimed ($iorbase,
 176                                $server->ProcessStartWaitInterval()) == -1) {
 177         print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 178         $SV->Kill (); $SV->TimedWait (1);
 179         $CL1->Kill (); $CL1->TimedWait (1);
 180         $CL2->Kill (); $CL2->TimedWait (1);
 181         $CL3->Kill (); $CL3->TimedWait (1);
 182         exit 1;
 183     }
 184
 185     if ($server->GetFile ($iorbase) == -1) {
 186         print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 187         $SV->Kill (); $SV->TimedWait (1);
 188         $CL1->Kill (); $CL1->TimedWait (1);
 189         $CL2->Kill (); $CL2->TimedWait (1);
 190         $CL3->Kill (); $CL3->TimedWait (1);
 191         exit 1;
 192     }
 193     if ($client1->PutFile ($iorbase) == -1) {
 194         print STDERR "ERROR: cannot set file <$client1_iorfile>\n";
 195         $SV->Kill (); $SV->TimedWait (1);
 196         $CL1->Kill (); $CL1->TimedWait (1);
 197         $CL2->Kill (); $CL2->TimedWait (1);
 198         $CL3->Kill (); $CL3->TimedWait (1);
 199         exit 1;
 200     }
 201     if ($client2->PutFile ($iorbase) == -1) {
 202         print STDERR "ERROR: cannot set file <$client2_iorfile>\n";
 203         $SV->Kill (); $SV->TimedWait (1);
 204         $CL1->Kill (); $CL1->TimedWait (1);
 205         $CL2->Kill (); $CL2->TimedWait (1);
 206         $CL3->Kill (); $CL3->TimedWait (1);
 207         exit 1;
 208     }
 209     if ($client3->PutFile ($iorbase) == -1) {
 210         print STDERR "ERROR: cannot set file <$client3_iorfile>\n";
 211         $SV->Kill (); $SV->TimedWait (1);
 212         $CL1->Kill (); $CL1->TimedWait (1);
 213         $CL2->Kill (); $CL2->TimedWait (1);
 214         $CL3->Kill (); $CL3->TimedWait (1);
 215         exit 1;
 216     }
 217
 218     # Wait for the server and clients to finish
 219
 220     # First client waits for others and shutdowns the server.
 221     $client_status = $CL1->WaitKill ($client1->ProcessStopWaitInterval() + 35);
 222
 223     if (0 != $client_status){
 224       print STDERR "ERROR: Stopping client #1 returned $client_status\n";
 225       $status = 1;
 226     }
 227
 228     $client_status = $CL2->WaitKill ($client2->ProcessStopWaitInterval() + 15);
 229
 230     if (0 != $client_status){
 231       print STDERR "ERROR: Stopping client #2 returned $client_status\n";
 232       $status = 1;
 233     }
 234
 235     $client_status = $CL3->WaitKill ($client3->ProcessStopWaitInterval() + 15);
 236
 237     if (0 != $client_status){
 238       print STDERR "ERROR: Stopping client #3 returned $client_status\n";
 239       $status = 1;
 240     }
 241
 242     $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval() + 15);
 243
 244     if ($server_status != 0) {
 245         print STDERR "ERROR: server returned $server_status\n";
 246         $status = 1;
 247     }
 248
 249     $server->DeleteFile($iorbase);
 250     $client1->DeleteFile($iorbase);
 251     $client2->DeleteFile($iorbase);
 252     $client3->DeleteFile($iorbase);
 253
 254     $elapsed = time() - $start_time;
 255 }
 256
 257 $server->DeleteFile($iorbase);
 258 $client1->DeleteFile($iorbase);
 259 $client2->DeleteFile($iorbase);
 260 $client3->DeleteFile($iorbase);
 261
 262 exit $status;