ACE/bin/PerlACE/ProcessVX_Win32.pm

   1 #!/usr/bin/env perl
   2
   3 package PerlACE::ProcessVX;
   4
   5 use strict;
   6 use Win32::Process;
   7 use File::Basename;
   8 use File::Spec;
   9 use FileHandle;
  10 use Cwd;
  11
  12 eval { require Net::Telnet; };
  13
  14 ###############################################################################
  15
  16 # This is what GetExitCode will return if the process is still running.
  17 my $STILL_ACTIVE = 259;
  18
  19 ###############################################################################
  20
  21 ### Constructor and Destructor
  22
  23 sub new
  24 {
  25     my $proto = shift;
  26     my $class = ref ($proto) || $proto;
  27     my $self = {};
  28
  29     $self->{RUNNING} = 0;
  30     $self->{IGNOREEXESUBDIR} = 1;
  31     $self->{IGNOREHOSTROOT} = 0;
  32     $self->{PROCESS} = undef;
  33     $self->{EXECUTABLE} = shift;
  34     $self->{ARGUMENTS} = shift;
  35     if (!defined $PerlACE::ProcessVX::WAIT_DELAY_FACTOR) {
  36         $PerlACE::ProcessVX::WAIT_DELAY_FACTOR = 3;
  37     }
  38     if (!defined $PerlACE::ProcessVX::RebootCmd) {
  39         $PerlACE::ProcessVX::RebootCmd = "reboot";
  40     }
  41     bless ($self, $class);
  42     return $self;
  43 }
  44
  45 sub DESTROY
  46 {
  47     my $self = shift;
  48
  49     if ($self->{RUNNING} == 1) {
  50         print STDERR "ERROR: <", $self->{EXECUTABLE},
  51                      "> still running upon object destruction\n";
  52         $self->Kill ();
  53     }
  54
  55     if (!defined $ENV{'ACE_TEST_VERBOSE'}) {
  56         unlink "run_vx.pl";
  57     }
  58
  59     if (defined $ENV{'ACE_RUN_VX_IBOOT'} && !defined $ENV{'ACE_RUN_VX_NO_SHUTDOWN'}) {
  60         # Shutdown the target to save power
  61         $self->iboot_cycle_power(1);
  62     }
  63 }
  64
  65 ###############################################################################
  66
  67 ### Spawning processes
  68
  69
  70 # Spawn the process and continue.
  71
  72 sub Spawn ()
  73 {
  74     my $self = shift;
  75
  76     if ($self->{RUNNING} == 1) {
  77         print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
  78                      "> already running\n";
  79         return -1;
  80     }
  81
  82     if (!defined $self->{EXECUTABLE}) {
  83         print STDERR "ERROR: Cannot Spawn: No executable specified\n";
  84         return -1;
  85     }
  86
  87     if ($self->{IGNOREEXESUBDIR} == 0) {
  88         if (!-f $self->Executable ()) {
  89             print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
  90                          "> not found\n";
  91             return -1;
  92         }
  93     }
  94
  95     my $status = 0;
  96
  97     my $cmdline;
  98
  99     # Reboot the target if necessery
 100     $self->reboot();
 101
 102     my $program = $self->Executable ();
 103     my $cwdrel = dirname ($program);
 104     my $prjroot = defined $ENV{'ACE_RUN_VX_PRJ_ROOT'} ? $ENV{'ACE_RUN_VX_PRJ_ROOT'} : $ENV{'ACE_ROOT'};
 105     if (length ($cwdrel) > 0) {
 106         $cwdrel = File::Spec->abs2rel( cwd(), $prjroot );
 107     }
 108     else {
 109         $cwdrel = File::Spec->abs2rel( $cwdrel, $prjroot );
 110     }
 111     $cwdrel =~ s/\\/\//g;
 112     $program = basename($program, $PerlACE::ProcessVX::ExeExt);
 113
 114     unlink "run_vx.pl";
 115     my $oh = new FileHandle();
 116     if (!open($oh, ">run_vx.pl")) {
 117         print STDERR "ERROR: Unable to write to run_vx.pl\n";
 118         exit -1;
 119     }
 120
 121     my @cmds;
 122     my $cmdnr = 0;
 123     my $arguments = "";
 124     my $prompt = '';
 125     my $exesubdir = defined $ENV{'ACE_RUN_VX_EXE_SUBDIR'} ? $ENV{'ACE_RUN_VX_EXE_SUBDIR'} : "";
 126
 127     if (defined $ENV{'ACE_RUN_VX_STARTUP_SCRIPT'}) {
 128         if (defined $ENV{'ACE_RUN_VX_STARTUP_SCRIPT_ROOT'}) {
 129             @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_STARTUP_SCRIPT_ROOT'} . '"';
 130         }
 131         @cmds[$cmdnr++] = '< ' . $ENV{'ACE_RUN_VX_STARTUP_SCRIPT'};
 132     }
 133
 134     if (defined $ENV{'ACE_RUN_VX_STARTUP_COMMAND'}) {
 135         @cmds[$cmdnr++] = $ENV{'ACE_RUN_VX_STARTUP_COMMAND'};
 136     }
 137
 138     if ($PerlACE::VxWorks_RTP_Test) {
 139         @cmds[$cmdnr++] = 'cmd';
 140         if ( defined $ENV{'ACE_RUN_VX_TGTSVR_DEFGW'} && $PerlACE::ProcessVX::VxDefGw) {
 141             @cmds[$cmdnr++] = "C mRouteAdd(\"0.0.0.0\", \"" . $ENV{'ACE_RUN_VX_TGTSVR_DEFGW'} . "\", 0,0,0)";
 142             $PerlACE::ProcessVX::VxDefGw = 0;
 143         }
 144
 145         if (defined $ENV{'ACE_RUN_VX_TGT_STARTUP_SCRIPT'}) {
 146             my(@start_commands);
 147             if (handle_startup_script ($ENV{'ACE_RUN_VX_TGT_STARTUP_SCRIPT'}, \@start_commands)) {
 148                 push @cmds, @start_commands;
 149                 $cmdnr += scalar @start_commands;
 150             }
 151         }
 152
 153         @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_TGTSVR_ROOT'} . "/" . $cwdrel . '"';
 154         @cmds[$cmdnr++] = 'C putenv("TMPDIR=' . $ENV{'ACE_RUN_VX_TGTSVR_ROOT'} . "/" . $cwdrel . '")';
 155
 156         if (defined $ENV{'ACE_RUN_ACE_DEBUG'}) {
 157             @cmds[$cmdnr++] = 'C putenv("ACE_DEBUG=' . $ENV{'ACE_RUN_ACE_DEBUG'} . '")';
 158         }
 159
 160         if (defined $ENV{'ACE_RUN_TAO_ORB_DEBUG'}) {
 161             @cmds[$cmdnr++] = 'C putenv("TAO_ORB_DEBUG=' . $ENV{'ACE_RUN_TAO_ORB_DEBUG'} . '")';
 162         }
 163
 164         if (defined $ENV{'ACE_RUN_ACE_LD_SEARCH_PATH'}) {
 165             @cmds[$cmdnr++] = 'C putenv("ACE_LD_SEARCH_PATH=' . $ENV{'ACE_RUN_ACE_LD_SEARCH_PATH'} . '")';
 166         }
 167         if (defined $self->{TARGET}) {
 168             my $x_env_ref = $self->{TARGET}->{EXTRA_ENV};
 169             while ( my ($env_key, $env_value) = each(%$x_env_ref) ) {
 170                 if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 171                     print "INFO: adding target environment $env_key=$env_value\n";
 172                 }
 173                 @cmds[$cmdnr++] = 'C putenv("' . $env_key. '=' . $env_value . '")';
 174             }
 175         }
 176
 177         if (defined $ENV{'ACE_RUN_VX_CHECK_RESOURCES'}) {
 178             @cmds[$cmdnr++] = 'C memShow()';
 179         }
 180
 181         $cmdline = $program . $PerlACE::ProcessVX::ExeExt . ' ' . $self->{ARGUMENTS};
 182         @cmds[$cmdnr++] = $cmdline;
 183         $prompt = '\[vxWorks \*\]\# $';
 184     }
 185     if ($PerlACE::VxWorks_Test) {
 186         if ( defined $ENV{'ACE_RUN_VX_TGTSVR_DEFGW'} && $PerlACE::ProcessVX::VxDefGw) {
 187             @cmds[$cmdnr++] = "mRouteAdd(\"0.0.0.0\", \"" . $ENV{'ACE_RUN_VX_TGTSVR_DEFGW'} . "\", 0,0,0)";
 188             $PerlACE::ProcessVX::VxDefGw = 0;
 189         }
 190
 191         if (defined $ENV{'ACE_RUN_VX_TGT_STARTUP_SCRIPT'}) {
 192             my(@start_commands);
 193             if (handle_startup_script ($ENV{'ACE_RUN_VX_TGT_STARTUP_SCRIPT'}, \@start_commands)) {
 194                 push @cmds, @start_commands;
 195                 $cmdnr += scalar @start_commands;
 196             }
 197         }
 198
 199         my(@load_commands);
 200         my(@unload_commands);
 201         if (!$PerlACE::Static && !$PerlACE::VxWorks_RTP_Test) {
 202             my $vxtest_file = $program . '.vxtest';
 203             if (handle_vxtest_file($self, $vxtest_file, \@load_commands, \@unload_commands)) {
 204                 @cmds[$cmdnr++] = "cd \"$ENV{'ACE_RUN_VX_TGTSVR_ROOT'}/lib\"";
 205                 push @cmds, @load_commands;
 206                 $cmdnr += scalar @load_commands;
 207             } else {
 208               print STDERR "ERROR: Cannot find <", $vxtest_file, ">\n";
 209               return -1;
 210           }
 211         }
 212
 213         @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_TGTSVR_ROOT'} . "/" . $cwdrel . "/" . $exesubdir . '"';
 214         @cmds[$cmdnr++] = 'putenv("TMPDIR=' . $ENV{'ACE_RUN_VX_TGTSVR_ROOT'} . "/" . $cwdrel . '")';
 215
 216         if (defined $ENV{'ACE_RUN_VX_CHECK_RESOURCES'}) {
 217             @cmds[$cmdnr++] = 'memShow()';
 218         }
 219
 220         if (defined $ENV{'ACE_RUN_ACE_DEBUG'}) {
 221             @cmds[$cmdnr++] = 'putenv("ACE_DEBUG=' . $ENV{'ACE_RUN_ACE_DEBUG'} . '")';
 222         }
 223
 224         if (defined $ENV{'ACE_RUN_TAO_ORB_DEBUG'}) {
 225             @cmds[$cmdnr++] = 'putenv("TAO_ORB_DEBUG=' . $ENV{'ACE_RUN_TAO_ORB_DEBUG'} . '")';
 226         }
 227
 228         if (defined $ENV{'ACE_RUN_ACE_LD_SEARCH_PATH'}) {
 229             @cmds[$cmdnr++] = 'putenv("ACE_LD_SEARCH_PATH=' . $ENV{'ACE_RUN_ACE_LD_SEARCH_PATH'} . '")';
 230         }
 231         if (defined $self->{TARGET}) {
 232             my $x_env_ref = $self->{TARGET}->{EXTRA_ENV};
 233             while ( my ($env_key, $env_value) = each(%$x_env_ref) ) {
 234                 if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 235                     print "INFO: adding target environment $env_key=$env_value\n";
 236                 }
 237                 @cmds[$cmdnr++] = 'putenv("' . $env_key. '=' . $env_value . '")';
 238             }
 239         }
 240
 241         @cmds[$cmdnr++] = 'ld <'. $program . $PerlACE::ProcessVX::ExeExt;
 242         if (defined $self->{ARGUMENTS}) {
 243             ($arguments = $self->{ARGUMENTS})=~ s/\"/\\\"/g;
 244             ($arguments = $self->{ARGUMENTS})=~ s/\'/\\\'/g;
 245             $arguments = ",\"" . $arguments . "\"";
 246         }
 247         if (defined $ENV{'ACE_RUN_VX_TGTSRV_WORKINGDIR'}) {
 248             @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_TGTSRV_WORKINGDIR'} . '"';
 249         } else {
 250             @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_TGTSVR_ROOT'} . "/" . $cwdrel . '"';
 251         }
 252         @cmds[$cmdnr++] = 'ace_vx_rc = vx_execae(ace_main' . $arguments . ')';
 253         @cmds[$cmdnr++] = 'unld "'. $program . $PerlACE::ProcessVX::ExeExt . '"';
 254         push @cmds, @unload_commands;
 255         $cmdnr += scalar @unload_commands;
 256         $prompt = '-> $';
 257     }
 258
 259     print $oh "require Net::Telnet;\n";
 260     print $oh "my \@cmds;\n";
 261     print $oh "my \$prompt = '$prompt';\n";
 262     my $i = 0;
 263     while($i < $cmdnr) {
 264         print $oh "\@cmds[$i] = '" . @cmds[$i++] . "';\n";
 265     }
 266     print $oh "my \$cmdnr = $cmdnr;\n\n";
 267
 268     print $oh <<'__END__';
 269
 270 my $ok;
 271 my $telnet_port = $ENV{'ACE_RUN_VX_TGT_TELNET_PORT'};
 272 my $telnet_host = $ENV{'ACE_RUN_VX_TGT_TELNET_HOST'};
 273 if (!defined $telnet_host)  {
 274     $telnet_host = $ENV{'ACE_RUN_VX_TGTHOST'};
 275 }
 276 if (!defined $telnet_port)  {
 277     $telnet_port = 23;
 278 }
 279 my $t = new Net::Telnet(Timeout => 600, Errmode => 'return', Host => $telnet_host, Port => $telnet_port);
 280 if (!defined $t) {
 281     die "ERROR: Telnet failed to <" . $telnet_host . ":". $telnet_port . ">";
 282 }
 283 if (!$t->open()) {
 284     die "ERROR: Telnet open to <" . $telnet_host . ":". $telnet_port . "> " . $t->errmsg;
 285 }
 286 __END__
 287
 288    if (defined $ENV{'ACE_RUN_VX_TERMSERV_DEV'}) {
 289      print $oh <<'__END__';
 290
 291 $t->prompt('/' . $ENV{'ACE_RUN_VX_IBOOT_USER'} . '>$/');
 292 $t->login($ENV{'ACE_RUN_VX_IBOOT_USER'}, $ENV{'ACE_RUN_VX_IBOOT_PASSWORD'});
 293 $t->print('direct ' . $ENV{'ACE_RUN_VX_TERMSERV_DEV'});
 294 $t->waitfor('/Entering Direct mode/');
 295 $t->print('');
 296
 297 __END__
 298    }
 299
 300     print $oh <<'__END__';
 301 my $target_login = $ENV{'ACE_RUN_VX_LOGIN'};
 302 my $target_password = $ENV{'ACE_RUN_VX_PASSWORD'};
 303
 304 if (defined $target_login)  {
 305     $t->waitfor('/VxWorks login: $/');
 306     $t->print("$target_login");
 307 }
 308
 309 if (defined $target_password)  {
 310     $t->waitfor('/Password: $/');
 311     $t->print("$target_password");
 312 }
 313
 314 # wait for the prompt
 315 my $buf = '';
 316 my $prompt1 = '-> $';
 317 while (1) {
 318     my $blk = $t->get;
 319     print $blk;
 320     $buf .= $blk;
 321     if ($buf =~ /$prompt1/) {
 322         last;
 323     }
 324 }
 325 if ($buf !~ /$prompt1/) {
 326     die "ERROR: Didn't got prompt but got <$buf>";
 327 }
 328 my $i = 0;
 329 my @lines;
 330 while($i < $cmdnr) {
 331     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 332         print @cmds[$i]."\n";
 333     }
 334     if ($t->print (@cmds[$i++])) {
 335         my $buf = '';
 336         while (1) {
 337             my $blk = $t->get;
 338             print $blk;
 339             $buf .= $blk;
 340             if ($buf =~ /$prompt/) {
 341                 last;
 342             }
 343         }
 344     } else {
 345         print $t->errmsg;
 346     }
 347 }
 348 $t->close();
 349 sleep(2);
 350 exit;
 351 __END__
 352
 353     close($oh);
 354
 355     Win32::Process::Create ($self->{PROCESS},
 356                             "$^X",
 357                             "$^X run_vx.pl",
 358                             0,
 359                             0,
 360                             '.');
 361
 362     Win32::Process::GetExitCode ($self->{PROCESS}, $status);
 363
 364     if ($status != $STILL_ACTIVE) {
 365         print STDERR "ERROR: Spawn failed for <", "$^X run_vx.pl", ">\n";
 366         exit $status;
 367     }
 368
 369     $self->{RUNNING} = 1;
 370     return 0;
 371 }
 372
 373 # Wait for a process to exit with a timeout
 374
 375 sub TimedWait ($)
 376 {
 377     my($self) = shift;
 378     my($timeout) = shift;
 379     return $self->Wait($timeout);
 380 }
 381
 382
 383 # Terminate the process and wait for it to finish
 384
 385 sub TerminateWaitKill ($)
 386 {
 387     my $self = shift;
 388     my $timeout = shift;
 389
 390     if ($self->{RUNNING}) {
 391         print STDERR "INFO: $self->{EXECUTABLE} being killed.\n";
 392         Win32::Process::Kill ($self->{PROCESS}, 0);
 393         $PerlACE::ProcessVX::DoVxInit = 1; # force reboot on next run
 394     }
 395
 396     return $self->WaitKill ($timeout);
 397 }
 398
 399 # Wait until a process exits.
 400 # return -1 if the process is still alive.
 401 sub Wait ($)
 402 {
 403     my $self = shift;
 404     my $timeout = shift;
 405     if (!defined $timeout || $timeout < 0) {
 406         $timeout = INFINITE;
 407     } else {
 408         $timeout = $timeout * 1000 * $PerlACE::ProcessVX::WAIT_DELAY_FACTOR;
 409     }
 410
 411     my $result = 0;
 412
 413     if ($self->{RUNNING}) {
 414         $result = Win32::Process::Wait ($self->{PROCESS}, $timeout);
 415         if ($result == 0) {
 416             return -1;
 417         }
 418     }
 419     Win32::Process::GetExitCode ($self->{PROCESS}, $result);
 420     $self->{RUNNING} = 0;
 421     if ($result != 0) {
 422           $PerlACE::ProcessVX::DoVxInit = 1; # force reboot on next run
 423     }
 424     return $result;
 425 }
 426
 427
 428
 429 # Kill the process
 430
 431 sub Kill ()
 432 {
 433     my $self = shift;
 434
 435     if ($self->{RUNNING}) {
 436         Win32::Process::Kill ($self->{PROCESS}, -1);
 437     }
 438
 439     $self->{RUNNING} = 0;
 440 }
 441
 442 1;