<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#! /usr/bin/perl
# $Id: ProcessVX_Win32.pm 85413 2009-05-20 12:13:40Z johnnyw $

package PerlACE::ProcessVX;

use strict;
use Win32::Process;
use File::Basename;
use File::Spec;
use FileHandle;
use Cwd;

eval { require Net::Telnet; };

###############################################################################

# This is what GetExitCode will return if the process is still running.
my $STILL_ACTIVE = 259;

###############################################################################

### Constructor and Destructor

sub new
{
    my $proto = shift;
    my $class = ref ($proto) || $proto;
    my $self = {};

    $self-&gt;{RUNNING} = 0;
    $self-&gt;{IGNOREEXESUBDIR} = 1;
    $self-&gt;{PROCESS} = undef;
    $self-&gt;{EXECUTABLE} = shift;
    $self-&gt;{ARGUMENTS} = shift;
    $self-&gt;{TARGET} = shift;
    if (!defined $PerlACE::ProcessVX::WAIT_DELAY_FACTOR) {
        $PerlACE::ProcessVX::WAIT_DELAY_FACTOR = 3;
    }
    if (!defined $PerlACE::ProcessVX::RebootCmd) {
        $PerlACE::ProcessVX::RebootCmd = "reboot";
    }
    bless ($self, $class);
    return $self;
}

sub DESTROY
{
    my $self = shift;

    if ($self-&gt;{RUNNING} == 1) {
        print STDERR "ERROR: &lt;", $self-&gt;{EXECUTABLE},
                     "&gt; still running upon object destruction\n";
        $self-&gt;Kill ();
    }

    if (!defined $ENV{'ACE_TEST_VERBOSE'}) {
        unlink "run_vx.pl";
    }

    if (defined $ENV{'ACE_RUN_VX_IBOOT'} &amp;&amp; !defined $ENV{'ACE_RUN_VX_NO_SHUTDOWN'}) {
      # Shutdown the target to save power
      $self-&gt;iboot_cycle_power(1);
    }
}

###############################################################################

### Spawning processes


# Spawn the process and continue.

sub Spawn ()
{
    my $self = shift;

    if ($self-&gt;{RUNNING} == 1) {
        print STDERR "ERROR: Cannot Spawn: &lt;", $self-&gt;Executable (),
                     "&gt; already running\n";
        return -1;
    }

    if (!defined $self-&gt;{EXECUTABLE}) {
        print STDERR "ERROR: Cannot Spawn: No executable specified\n";
        return -1;
    }

    if ($self-&gt;{IGNOREEXESUBDIR} == 0) {
        if (!-f $self-&gt;Executable ()) {
            print STDERR "ERROR: Cannot Spawn: &lt;", $self-&gt;Executable (),
                         "&gt; not found\n";
            return -1;
        }
    }

    my $status = 0;

    my $cmdline;

    # Reboot the target if necessery
    $self-&gt;reboot();

    my $program = $self-&gt;Executable ();
    my $cwdrel = dirname ($program);
    my $prjroot = defined $ENV{"ACE_RUN_VX_PRJ_ROOT"} ? $ENV{"ACE_RUN_VX_PRJ_ROOT"} : $ENV{"ACE_ROOT"};
    if (length ($cwdrel) &gt; 0) {
        $cwdrel = File::Spec-&gt;abs2rel( cwd(), $prjroot );
    }
    else {
        $cwdrel = File::Spec-&gt;abs2rel( $cwdrel, $prjroot );
    }
    $cwdrel =~ s/\\/\//g;
    $program = basename($program, $PerlACE::ProcessVX::ExeExt);

    unlink "run_vx.pl";
    my $oh = new FileHandle();
    if (!open($oh, "&gt;run_vx.pl")) {
        print STDERR "ERROR: Unable to write to run_vx.pl\n";
        exit -1;
    }

    my @cmds;
    my $cmdnr = 0;
    my $arguments = "";
    my $prompt = '';
    my $exesubdir = defined $ENV{"ACE_RUN_VX_EXE_SUBDIR"} ? $ENV{"ACE_RUN_VX_EXE_SUBDIR"} : "";

    if (defined $ENV{"ACE_RUN_VX_STARTUP_SCRIPT"}) {
      if (defined $ENV{"ACE_RUN_VX_STARTUP_SCRIPT_ROOT"}) {
        @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_STARTUP_SCRIPT_ROOT'} . '"';
      }
      @cmds[$cmdnr++] = '&lt; ' . $ENV{"ACE_RUN_VX_STARTUP_SCRIPT"};
    }

    if (defined $ENV{"ACE_RUN_VX_STARTUP_COMMAND"}) {
      @cmds[$cmdnr++] = $ENV{"ACE_RUN_VX_STARTUP_COMMAND"};
    }

    if ($PerlACE::VxWorks_RTP_Test) {
        @cmds[$cmdnr++] = 'cmd';
        if ( defined $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} &amp;&amp; $PerlACE::ProcessVX::VxDefGw) {
            @cmds[$cmdnr++] = "C mRouteAdd(\"0.0.0.0\", \"" . $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} . "\", 0,0,0)";
            $PerlACE::ProcessVX::VxDefGw = 0;
        }

        if (defined $ENV{"ACE_RUN_VX_TGT_STARTUP_SCRIPT"}) {
            my(@start_commands);
            if (handle_startup_script ($ENV{"ACE_RUN_VX_TGT_STARTUP_SCRIPT"}, \@start_commands)) {
                push @cmds, @start_commands;
                $cmdnr += scalar @start_commands;
            }
         }

        @cmds[$cmdnr++] = 'cd "' . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . '"';
        @cmds[$cmdnr++] = 'C putenv("TMPDIR=' . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . '")';

        if (defined $ENV{'ACE_RUN_ACE_DEBUG'}) {
            @cmds[$cmdnr++] = 'C putenv("ACE_DEBUG=' . $ENV{"ACE_RUN_ACE_DEBUG"} . '")';
        }

        if (defined $ENV{'ACE_RUN_TAO_ORB_DEBUG'}) {
            @cmds[$cmdnr++] = 'C putenv("TAO_ORB_DEBUG=' . $ENV{"ACE_RUN_TAO_ORB_DEBUG"} . '")';
        }

        if (defined $ENV{'ACE_RUN_ACE_LD_SEARCH_PATH'}) {
            @cmds[$cmdnr++] = 'C putenv("ACE_LD_SEARCH_PATH=' . $ENV{"ACE_RUN_ACE_LD_SEARCH_PATH"} . '")';
        }

        if (defined $ENV{'ACE_RUN_VX_CHECK_RESOURCES'}) {
            @cmds[$cmdnr++] = 'C memShow()';
        }

        $cmdline = $program . $PerlACE::ProcessVX::ExeExt . ' ' . $self-&gt;{ARGUMENTS};
        @cmds[$cmdnr++] = $cmdline;
        $prompt = '\[vxWorks \*\]\# $';
    }
    if ($PerlACE::VxWorks_Test) {
        if ( defined $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} &amp;&amp; $PerlACE::ProcessVX::VxDefGw) {
            @cmds[$cmdnr++] = "mRouteAdd(\"0.0.0.0\", \"" . $ENV{"ACE_RUN_VX_TGTSVR_DEFGW"} . "\", 0,0,0)";
            $PerlACE::ProcessVX::VxDefGw = 0;
        }

        if (defined $ENV{"ACE_RUN_VX_TGT_STARTUP_SCRIPT"}) {
            my(@start_commands);
            if (handle_startup_script ($ENV{"ACE_RUN_VX_TGT_STARTUP_SCRIPT"}, \@start_commands)) {
                push @cmds, @start_commands;
                $cmdnr += scalar @start_commands;
            }
         }

        my(@load_commands);
        my(@unload_commands);
        if (!$PerlACE::Static &amp;&amp; !$PerlACE::VxWorks_RTP_Test) {
          my $vxtest_file = $program . '.vxtest';
          if (handle_vxtest_file($self, $vxtest_file, \@load_commands, \@unload_commands)) {
              @cmds[$cmdnr++] = "cd \"$ENV{'ACE_RUN_VX_TGTSVR_ROOT'}/lib\"";
              push @cmds, @load_commands;
              $cmdnr += scalar @load_commands;
          } else {
              print STDERR "ERROR: Cannot find &lt;", $vxtest_file, "&gt;\n";
              return -1;
          }
        }

        @cmds[$cmdnr++] = 'cd "' . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . "/" . $exesubdir . '"';
        @cmds[$cmdnr++] = 'putenv("TMPDIR=' . $ENV{"ACE_RUN_VX_TGTSVR_ROOT"} . "/" . $cwdrel . '")';

        if (defined $ENV{'ACE_RUN_VX_CHECK_RESOURCES'}) {
            @cmds[$cmdnr++] = 'memShow()';
        }

        if (defined $ENV{'ACE_RUN_ACE_DEBUG'}) {
            @cmds[$cmdnr++] = 'putenv("ACE_DEBUG=' . $ENV{"ACE_RUN_ACE_DEBUG"} . '")';
        }

        if (defined $ENV{'ACE_RUN_TAO_ORB_DEBUG'}) {
            @cmds[$cmdnr++] = 'putenv("TAO_ORB_DEBUG=' . $ENV{"ACE_RUN_TAO_ORB_DEBUG"} . '")';
        }

        if (defined $ENV{'ACE_RUN_ACE_LD_SEARCH_PATH'}) {
            @cmds[$cmdnr++] = 'putenv("ACE_LD_SEARCH_PATH=' . $ENV{"ACE_RUN_ACE_LD_SEARCH_PATH"} . '")';
        }

        @cmds[$cmdnr++] = 'ld &lt;'. $program . $PerlACE::ProcessVX::ExeExt;
        if (defined $self-&gt;{ARGUMENTS}) {
            ($arguments = $self-&gt;{ARGUMENTS})=~ s/\"/\\\"/g;
            ($arguments = $self-&gt;{ARGUMENTS})=~ s/\'/\\\'/g;
            $arguments = ",\"" . $arguments . "\"";
        }
        if (defined $ENV{'ACE_RUN_VX_TGTSRV_WORKINGDIR'}) {
            @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_TGTSRV_WORKINGDIR'} . '"';
        } else {
            @cmds[$cmdnr++] = 'cd "' . $ENV{'ACE_RUN_VX_TGTSVR_ROOT'} . "/" . $cwdrel . '"';
        }
        @cmds[$cmdnr++] = 'ace_vx_rc = vx_execae(ace_main' . $arguments . ')';
        @cmds[$cmdnr++] = 'unld "'. $program . $PerlACE::ProcessVX::ExeExt . '"';
        push @cmds, @unload_commands;
        $cmdnr += scalar @unload_commands;
        $prompt = '-&gt; $';
    }

    print $oh "require Net::Telnet;\n";
    print $oh "my \@cmds;\n";
    print $oh "my \$prompt = '$prompt';\n";
    my $i = 0;
    while($i &lt; $cmdnr) {
      print $oh "\@cmds[$i] = '" . @cmds[$i++] . "';\n";
    }
    print $oh "my \$cmdnr = $cmdnr;\n\n";

    print $oh &lt;&lt;'__END__';

my $ok;
my $telnet_port = $ENV{'ACE_RUN_VX_TGT_TELNET_PORT'};
my $telnet_host = $ENV{'ACE_RUN_VX_TGT_TELNET_HOST'};
if (!defined $telnet_host)  {
  $telnet_host = $ENV{'ACE_RUN_VX_TGTHOST'};
}
if (!defined $telnet_port)  {
  $telnet_port = 23;
}
my $t = new Net::Telnet(Timeout =&gt; 600, Errmode =&gt; 'return', Host =&gt; $telnet_host, Port =&gt; $telnet_port);
if (!defined $t) {
  die "ERROR: Telnet failed to &lt;" . $telnet_host . ":". $telnet_port . "&gt;";
}
if (!$t-&gt;open()) {
  die "ERROR: Telnet open to &lt;" . $telnet_host . ":". $telnet_port . "&gt; " . $t-&gt;errmsg;
}

my $target_login = $ENV{'ACE_RUN_VX_LOGIN'};
my $target_password = $ENV{'ACE_RUN_VX_PASSWORD'};

if (defined $target_login)  {
  $t-&gt;waitfor('/VxWorks login: $/');
  $t-&gt;print("$target_login");
}

if (defined $target_password)  {
  $t-&gt;waitfor('/Password: $/');
  $t-&gt;print("$target_password");
}

# wait for the prompt
my $buf = '';
my $prompt1 = '-&gt; $';
while (1) {
  my $blk = $t-&gt;get;
  print $blk;
  $buf .= $blk;
  if ($buf =~ /$prompt1/) {
    last;
  }
}
if ($buf !~ /$prompt1/) {
  die "ERROR: Didn't got prompt but got &lt;$buf&gt;";
}
my $i = 0;
my @lines;
while($i &lt; $cmdnr) {
  if (defined $ENV{'ACE_TEST_VERBOSE'}) {
    print @cmds[$i]."\n";
  }
  if ($t-&gt;print (@cmds[$i++])) {
    my $buf = '';
    while (1) {
      my $blk = $t-&gt;get;
      print $blk;
      $buf .= $blk;
      if ($buf =~ /$prompt/) {
        last;
      }
    }
  } else {
    print $t-&gt;errmsg;
  }
}
$t-&gt;close();
sleep(2);
exit;
__END__

    close($oh);

    Win32::Process::Create ($self-&gt;{PROCESS},
                            "$^X",
                            "$^X run_vx.pl",
                            0,
                            0,
                            '.');

    Win32::Process::GetExitCode ($self-&gt;{PROCESS}, $status);

    if ($status != $STILL_ACTIVE) {
        print STDERR "ERROR: Spawn failed for &lt;", "$^X run_vx.pl", "&gt;\n";
        exit $status;
    }

    $self-&gt;{RUNNING} = 1;
    return 0;
}

# Wait for a process to exit with a timeout

sub TimedWait ($)
{
    my($self) = shift;
    my($timeout) = shift;
    return $self-&gt;Wait($timeout);
}


# Terminate the process and wait for it to finish

sub TerminateWaitKill ($)
{
    my $self = shift;
    my $timeout = shift;

    if ($self-&gt;{RUNNING}) {
        print STDERR "INFO: $self-&gt;{EXECUTABLE} being killed.\n";
        Win32::Process::Kill ($self-&gt;{PROCESS}, 0);
        $PerlACE::ProcessVX::DoVxInit = 1; # force reboot on next run
    }

    return $self-&gt;WaitKill ($timeout);
}

# Wait until a process exits.
# return -1 if the process is still alive.
sub Wait ($)
{
    my $self = shift;
    my $timeout = shift;
    if (!defined $timeout || $timeout &lt; 0) {
      $timeout = INFINITE;
    } else {
      $timeout = $timeout * 1000 * $PerlACE::ProcessVX::WAIT_DELAY_FACTOR;
    }

    my $result = 0;

    if ($self-&gt;{RUNNING}) {
      $result = Win32::Process::Wait ($self-&gt;{PROCESS}, $timeout);
      if ($result == 0) {
        return -1;
      }
    }
    Win32::Process::GetExitCode ($self-&gt;{PROCESS}, $result);
    if ($result != 0) {
        $PerlACE::ProcessVX::DoVxInit = 1; # force reboot on next run
    }
    return $result;
}



# Kill the process

sub Kill ()
{
    my $self = shift;

    if ($self-&gt;{RUNNING}) {
        Win32::Process::Kill ($self-&gt;{PROCESS}, -1);
    }

    $self-&gt;{RUNNING} = 0;
}


1;
</pre></body></html>