<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: ProcessAndroid.pm 97703 2014-04-09 07:36:19Z mcorino $

package PerlACE::ProcessAndroid;

use POSIX "sys_wait_h";
use File::Basename;
use File::Spec;
use FileHandle;
use Cwd;
use Config;

use strict;

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

###  Grab signal names

my @signame;

if (defined $Config{sig_name}) {
    my $i = 0;
    foreach my $name (split (' ', $Config{sig_name})) {
        $signame[$i] = $name;
        $i++;
    }
}
else {
    my $i;
    for ($i = 0; $i &lt; 255; ++$i) {
        $signame[$i] = $i;
    }
}

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

### Constructor and Destructor

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

    $self-&gt;{TARGET} = shift;
    $self-&gt;{RUNNING} = 0;
    $self-&gt;{IGNOREEXESUBDIR} = 1;
    $self-&gt;{IGNOREHOSTROOT} = 0;
    $self-&gt;{PROCESS} = undef;
    $self-&gt;{EXECUTABLE} = shift;

    # Only set argument when they are really supplied via the
    # CreateProcess call. If the weren't supplied, an error like
    # Process_Android::HASH (0x...) is generated.
    if (@_ == 1) {
        $self-&gt;{ARGUMENTS} = shift;
    }
    else {
        $self-&gt;{ARGUMENTS} = "";
    }
    $self-&gt;{FSROOT} = $ENV{'ANDROID_FS_ROOT'};

    bless ($self, $class);

    # copy the test executable to the target at forehand
    $self-&gt;copy_executable ();

    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 $self-&gt;{SCRIPTFILE}) {
        unlink $self-&gt;{SCRIPTFILE};
    }
    if (defined $self-&gt;{UNLINKLIST}) {
        foreach my $ul (@{$self-&gt;{UNLINKLIST}}) {
            unlink $ul;
        }
    }
}

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

sub Arguments
{
    my $self = shift;

    if (@_ != 0) {
        $self-&gt;{ARGUMENTS} = shift;
        if (defined $self-&gt;{SCRIPTFILE}) {
          if (!defined $self-&gt;{UNLINKLIST}) {
              $self-&gt;{UNLINKLIST} = ();
          }
          push(@{$self-&gt;{UNLINKLIST}}, $self-&gt;{SCRIPTFILE});
          $self-&gt;{SCRIPTFILE} = undef;
        }
    }

    return $self-&gt;{ARGUMENTS};
}

sub Executable
{
    my $self = shift;

    if (@_ != 0) {
        $self-&gt;{EXECUTABLE} = shift;
        if (defined $self-&gt;{SCRIPTFILE}) {
            if (!defined $self-&gt;{UNLINKLIST}) {
                $self-&gt;{UNLINKLIST} = ();
            }
            push(@{$self-&gt;{UNLINKLIST}}, $self-&gt;{SCRIPTFILE});
            $self-&gt;{SCRIPTFILE} = undef;
        }
        # copy the (new) test executable to the target
        # previously scanned .vxtest files and detected libraries
        # will not be scanned/copied twice
        $self-&gt;copy_executable ();
    }

    my $executable = $self-&gt;{EXECUTABLE};

    # If the target's config has a different ACE_ROOT, rebase the executable
    # from $ACE_ROOT to the target's root.
    if (defined $self-&gt;{TARGET} &amp;&amp;
          $self-&gt;{TARGET}-&gt;ACE_ROOT() ne $ENV{'ACE_ROOT'}) {
        $executable = PerlACE::rebase_path ($executable,
                                            $ENV{'ACE_ROOT'},
                                            $self-&gt;{TARGET}-&gt;ACE_ROOT());
    }

    if ($self-&gt;{IGNOREEXESUBDIR}) {
        return $executable;
    }

    my $basename = basename ($executable);
    my $dirname = dirname ($executable).'/';

    my $subdir = $PerlACE::Process::ExeSubDir;
    if (defined $self-&gt;{TARGET} &amp;&amp; defined $self-&gt;{TARGET}-&gt;{EXE_SUBDIR}) {
        $subdir = $self-&gt;{TARGET}-&gt;{EXE_SUBDIR};
    }

    $executable = $dirname . $subdir . $basename;

    return $executable;
}

sub Wait ($)
{
    my $self = shift;
    my $timeout = shift;
    if (!defined $timeout || $timeout &lt; 0) {
        waitpid ($self-&gt;{PROCESS}, 0);
    } else {
        return $self-&gt;TimedWait($timeout);
    }
}

# really only for internal use
sub check_return_value ($)
{
    my $self = shift;
    my $rc = shift;

    if ($rc &lt; 0x80) {
        return $rc;
    }

    # Remember Core dump flag
    my $dump = 0;

    if ($rc &amp; 0x80) {
        $rc &amp;= ~0x80;
        $dump = 1;
    }

    # check for ABRT, KILL or TERM
    if ($rc == 6 || $rc == 9 || $rc == 15) {
        return 0;
    }

    print STDERR "ERROR: &lt;", $self-&gt;{EXECUTABLE},
                 "&gt; exited with ";

    print STDERR "coredump from " if ($dump == 1);

    print STDERR "signal $rc : ", $signame[$rc], "\n";

    return 255;
}

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

    if ($PerlACE::Process::WAIT_DELAY_FACTOR &gt; 0) {
        $timeout *= $PerlACE::Process::WAIT_DELAY_FACTOR;
    }

    if (defined $ENV{'ACE_TEST_VERBOSE'} &amp;&amp; $self-&gt;{PROCESS} &gt; 0) {
        print STDERR "Wait $timeout to finish executable $self-&gt;{PROCESS}. ";
        print STDERR "RUNNING: $self-&gt;{RUNNING}\n";
    }

    # Multiply with 10 because we wait a tenth of a second each time
    $timeout *= 10;

    while ($timeout-- != 0 &amp;&amp; $self-&gt;{PROCESS} &gt; 0 &amp;&amp; $self-&gt;{RUNNING} == 1) {
        my $pid = waitpid ($self-&gt;{PROCESS}, WNOHANG);
        if ($pid != 0 &amp;&amp; $? != -1) {
            if (defined $ENV{'ACE_TEST_VERBOSE'} &amp;&amp; $self-&gt;{PROCESS} &gt; 0) {
                print STDERR "Executable $self-&gt;{PROCESS} finished ($pid)\n";
            }
            last;
        }
        select(undef, undef, undef, 0.1);
    }

    # attempt to retrieve exitstatus from remote .rc file
    my $shell = $ENV{'ANDROID_SDK_ROOT'} . '/platform-tools/adb shell';
    my $rcfile = $self-&gt;{RCFILE};
    ## wait max 5 * $PerlACE::Process::WAIT_DELAY_FACTOR sec for RC file to appear
    my $start_tm = time ();
    my $max_wait = 5;
    if ($PerlACE::Process::WAIT_DELAY_FACTOR &gt; 0) {
        $max_wait *= $PerlACE::Process::WAIT_DELAY_FACTOR;
    }
    my $rc = -255;
    while ((time() - $start_tm) &lt; $max_wait) {
        select(undef, undef, undef, 0.2);
        $rc = int(`$shell 'if [ -e $rcfile -a -s $rcfile ] ; then cat $rcfile; rm -f $rcfile &gt;/dev/null 2&gt;&amp;1; else echo -255; fi'`);
        if ($rc != -255) {
            return $self-&gt;check_return_value ($rc);
        }
    }

    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        print STDERR "Exit TimedWait with Process: $self-&gt;{PROCESS}, Running: $self-&gt;{RUNNING}\n";
    }

    return -1;
}

sub Kill ()
{
    my $self = shift;

    if ($self-&gt;{RUNNING} == 1) {
        if (defined $ENV{'ACE_TEST_VERBOSE'}) {
            print STDERR "Killing process &lt;$self-&gt;{PROCESS}&gt;\n";
        }
        # killing the adb process, not the actual test executable.
        kill (1, $self-&gt;{PROCESS});

        my $pid = waitpid ($self-&gt;{PROCESS}, WNOHANG);
        if ($pid == -1) {
            if (defined $ENV{'ACE_TEST_VERBOSE'}) {
                print STDERR "Process &lt;$self-&gt;{PROCESS}&gt; already ended\n";
            }
        }
        elsif ($pid == $self-&gt;{PROCESS}) {
            if (defined $ENV{'ACE_TEST_VERBOSE'}) {
                print STDERR "Process &lt;$self-&gt;{PROCESS}&gt; ended\n";
            }
        }
    }

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

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

    if ($self-&gt;{RUNNING} == 0) {
        return 0;
    }

    my $status = $self-&gt;TimedWait ($timeout);

    if ($status == -1) {
        print STDERR "ERROR: $self-&gt;{EXECUTABLE} timedout\n";
        $self-&gt;Kill ();
    }

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

    return $status;
}


# Do a Spawn and immediately WaitKill
#
sub SpawnWaitKill ($)
{
    my $self = shift;
    my $timeout = shift;

    if ($self-&gt;Spawn () == -1) {
        return -1;
    }
    my $result = 0;

    if ($self-&gt;{RUNNING} == 1) {
        $result = $self-&gt;WaitKill ($timeout);
    }

    return $result;
}

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

    if ($self-&gt;{RUNNING}) {
        print STDERR "INFO: $self-&gt;{EXECUTABLE} being killed.\n";

        my $killcmd = $ENV{'ANDROID_SDK_ROOT'} . '/platform-tools/adb shell "kill -s TERM ' . $self-&gt;{REMOTE_PID} . '"';
        system ($killcmd);
    }

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

sub IgnoreExeSubDir
{
    my $self = shift;

    if (@_ != 0) {
        $self-&gt;{IGNOREEXESUBDIR} = shift;
    }

    return $self-&gt;{IGNOREEXESUBDIR};
}

sub IgnoreHostRoot
{
    my $self = shift;

    if (@_ != 0) {
        $self-&gt;{IGNOREHOSTROOT} = shift;
    }

    return $self-&gt;{IGNOREHOSTROOT};
}

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 $fsroot_target = $ENV{'ANDROID_FS_ROOT'};
    my $exe = $self-&gt;Executable ();
    my $program = "$fsroot_target/".basename($exe);

    my($test, $dir, $suffix) = fileparse($program);

    my $local_xdir = cwd ();

    if (!defined $self-&gt;{PIDFILE}) {
        $self-&gt;{PIDFILE} = "$fsroot_target/ace-".rand(time).".pid";
    }
    if (!defined $self-&gt;{RCFILE}) {
        $self-&gt;{RCFILE} = "$fsroot_target/ace-".rand(time).".rc";
    }
    if (!defined $self-&gt;{SCRIPTFILE}) {
        $self-&gt;{SCRIPTFILE} = "$local_xdir/run-".rand(time).".sh";
    }
    ## create scriptfile
    my $run_script =
        # "if [ ! -e /tmp/.acerun ]; then mkdir /tmp/.acerun; fi\n".
        "cd $fsroot_target\n".
        "export LD_LIBRARY_PATH=$fsroot_target/lib:.:\$LD_LIBRARY_PATH\n".
        "export PATH=\$PATH:$fsroot_target/lib:.\n".
        "export ACE_ROOT=$fsroot_target\n";

    if (defined $self-&gt;{TARGET} &amp;&amp; defined $self-&gt;{TARGET}-&gt;{EXTRA_ENV}) {
      my $x_env_ref  = $self-&gt;{TARGET}-&gt;{EXTRA_ENV};
      while ( my ($env_key, $env_value) = each(%$x_env_ref) ) {
          $run_script .=
          "export $env_key=\"$env_value\"\n";
      }
    }
    $run_script .=
      "./$test $self-&gt;{ARGUMENTS} &amp;\n";
    $run_script .=
      "MY_PID=\$!\n".
      "echo \$MY_PID &gt; ".$self-&gt;{PIDFILE}."\n";
    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        $run_script .=
          "echo INFO: Process started remote with pid [\$MY_PID]\n";
    }
    $run_script .=
      "wait \$MY_PID\n";
    $run_script .=
      "MY_RC=\$?\n".
      "echo \$MY_RC &gt; ".$self-&gt;{RCFILE}."\n";
    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        $run_script .=
          "echo INFO: Process [\$MY_PID] returned exit code [\$MY_RC]\n";
    }
    unless (open (RUN_SCRIPT, "&gt;".$self-&gt;{SCRIPTFILE})) {
        print STDERR "ERROR: Cannot Spawn: &lt;", $self-&gt;Executable (),
                      "&gt; failed to create ",$self-&gt;{SCRIPTFILE},"\n";
        return -1;
    }
    print RUN_SCRIPT $run_script;
    close RUN_SCRIPT;

    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        print STDERR "INFO: created run script [",$self-&gt;{SCRIPTFILE},"]\n", $run_script;
    }
    $self-&gt;PutFile ($self-&gt;{SCRIPTFILE}, "$fsroot_target/".basename($self-&gt;{SCRIPTFILE}));

    my $adb_process = $ENV{'ANDROID_SDK_ROOT'} . "/platform-tools/adb";
    my $cmd = $adb_process . ' shell "cd ' . $fsroot_target . ' &amp;&amp; source ./' . basename($self-&gt;{SCRIPTFILE}) . '"';

    FORK: {
        if ($self-&gt;{PROCESS} = fork) {
            bless $self;
        }
        elsif (defined $self-&gt;{PROCESS}) {
            $self-&gt;{RUNNING} = 1;

            if (defined $ENV{'ACE_TEST_VERBOSE'}) {
                print STDERR "Start to execute: $cmd\n";
            }
            exec ( $cmd );
            exit;
        }
        elsif ($! =~ /No more process/) {
            sleep 5;
            redo FORK;
        }
        else {
            print STDERR "ERROR: Can't fork &lt;" . $cmd . "&gt;: $!\n";
       }
    }

    my $shell = $adb_process . ' shell';
    my $pidfile = $self-&gt;{PIDFILE};
    ## wait max 10 * $PerlACE::Process::WAIT_DELAY_FACTOR sec for pid file to appear
    my $start_tm = time ();
    my $max_wait = 10;
    if ($PerlACE::Process::WAIT_DELAY_FACTOR &gt; 0) {
        $max_wait *= $PerlACE::Process::WAIT_DELAY_FACTOR;
    }
    my $rc = 1;
    while ((time() - $start_tm) &lt; $max_wait) {
        select(undef, undef, undef, 0.2);
        $rc = int(`$shell 'if [ -e $pidfile -a -s $pidfile ] ; then cat $pidfile; rm -f $pidfile &gt;/dev/null 2&gt;&amp;1; else echo 0; fi'`);
        if ($rc != 0) {
            $self-&gt;{REMOTE_PID} = $rc;
            last;
        }
    }
    if (!defined $self-&gt;{REMOTE_PID}) {
        print STDERR "ERROR: Remote command failed &lt;" . $test . ' ' . $self-&gt;{ARGUMENTS} . "&gt;: $! No PID found.\n";
        return -1;
    }

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

    return 0;
}

sub copy_executable ($)
{
    my $self = shift;

    my $fsroot_target = $ENV{'ANDROID_FS_ROOT'};
    my $program = $self-&gt;Executable ();
    # never copy program subdirectory if specified (like '../Generic_Servant/server')
    my $exe = "$fsroot_target/".basename($program);

    $self-&gt;{SHLIBS} = ();
    $self-&gt;{VXTESTS} = ();
    $self-&gt;{XLIBPATH} = ();

    push (@{$self-&gt;{XLIBPATH}}, '.');
    if (defined $self-&gt;{TARGET} &amp;&amp; defined $self-&gt;{TARGET}-&gt;{LIBPATH}) {
        foreach my $libpath (split(/:|;/, $self-&gt;{TARGET}-&gt;{LIBPATH})) {
          push(@{$self-&gt;{XLIBPATH}}, $libpath);
        }
    }

    $self-&gt;PutFile ("$program", $exe);

    if ($PerlACE::Static == 0) {
        # collect libraries from .vxtest file
        $self-&gt;process_vxtest ($program.'.vxtest');
        # collect libraries from extra lib paths (might be dynamically loaded)
        $self-&gt;collect_extra_libs ();
        # collect any runtime lib dependencies specified
        $self-&gt;collect_runtime_libs ();
        # copy all collected libraries
        foreach my $lib (@{$self-&gt;{SHLIBS}}) {
            $self-&gt;PutFile ($lib, "$self-&gt;{FSROOT}/lib/".basename($lib));
        }
        # handle defined system libraries
        if (defined $self-&gt;{TARGET} &amp;&amp; defined $self-&gt;{TARGET}-&gt;{SYSTEM_LIBS}) {
            $self-&gt;copy_system_libs ($self-&gt;{TARGET}-&gt;{SYSTEM_LIBS});
        }
    }
}

sub process_vxtest ($)
{
    my $self = shift;
    my $newvxtest = shift;

    foreach my $vxtest (@{$self-&gt;{VXTESTS}}) {
        if ($vxtest eq $newvxtest) {
            return;
        }
    }
    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        print STDERR "Processing vxtest file $newvxtest\n";
    }
    $self-&gt;collect_vxtest_libs ($newvxtest);
}

sub add_unique_lib ($)
{
    my $self = shift;
    my $newlib = shift;

    foreach my $lib (@{$self-&gt;{SHLIBS}}) {
        if ($lib eq $newlib) {
            return 0;
        }
    }
    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        print STDERR "Collecting library $newlib\n";
    }
    push(@{$self-&gt;{SHLIBS}}, $newlib);
    return 1;
}

sub collect_vxtest_libs ()
{
    my $self = shift;
    my $vxtestfile = shift;
    my $fh = new FileHandle;

    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        print STDERR "Analyzing vxtest file &lt;$vxtestfile&gt;\n";
    }

    if (open ($fh, $vxtestfile)) {
        my $line1 = &lt;$fh&gt;;
        chomp $line1;
        if (defined $ENV{'ACE_TEST_VERBOSE'}) {
            print STDERR "Analyzing vxtest file: Found line $line1\n";
        }
        while(&lt;$fh&gt;) {
            $line1 = $_;
            chomp $line1;
            if (defined $ENV{'ACE_TEST_VERBOSE'}) {
                print STDERR "Analyzing vxtest file: Found line $line1\n";
            }

            $self-&gt;collect_vxtest_lib ($line1);
        }
    }
    close $fh;
}

sub collect_vxtest_lib ($)
{
    my $self = shift;
    my $name = shift;
    my $query;
    my @libpaths = ("$ENV{'ACE_ROOT'}/lib");

    push (@libpaths, @{$self-&gt;{XLIBPATH}});

    foreach my $libpath (@libpaths) {
      $query = "$libpath/lib$name.so";
      if (-e $query) {
          if (defined $ENV{'ACE_TEST_VERBOSE'}) {
              print STDERR "Found $name in library directory $libpath\n";
          }
          # look for versioned and non-versioned filenames
          my @files = glob ($query . '*');
          foreach my $file (@files) {
              $self-&gt;add_unique_lib ($file);
          }
      }
    }
}

sub collect_extra_libs ()
{
    my $self = shift;
    # treat current dir as extra libpath
    my @libpaths = (@{$self-&gt;{XLIBPATH}});
    my $query;
    my $vxtest;

    if (defined $ENV{'ACE_TEST_VERBOSE'}) {
        print STDERR "Inspecting libpaths (@libpaths) for extra libraries\n";
    }

    foreach my $libpath (@libpaths) {
      # look for versioned and non-versioned libraries
      $query = "$libpath/lib*.so*";
      my @files = glob ($query);
      foreach my $file (@files) {
          if ($self-&gt;add_unique_lib ($file) == 1) {
              # check for possible .vxtest for new lib dependency
              $vxtest = basename ($file);
              $vxtest =~ s/^lib(.*)[\.]so([\.].*)?$/\1/;
              if (-e "$libpath/$vxtest.vxtest") {
                  # process .vxtest file if not yet processed before
                  $self-&gt;process_vxtest ("$libpath/$vxtest.vxtest");
              }
          }
      }
    }
}

sub collect_runtime_libs ()
{
    my $self = shift;
    # only need to test ACE_ROOT/lib since all libs from '.' and extra libpaths are copied already
    my @libpaths = ("$ENV{'ACE_ROOT'}/lib");
    my $query;

    if (defined $self-&gt;{TARGET} &amp;&amp; defined $self-&gt;{TARGET}-&gt;{RUNTIME_LIBDEP}) {

        foreach my $runtimelib (@{$self-&gt;{TARGET}-&gt;{RUNTIME_LIBDEP}}) {

            if (-e $runtimelib) {
                $self-&gt;add_unique_lib ($runtimelib);
            } else {

                if (defined $ENV{'ACE_TEST_VERBOSE'}) {
                    print STDERR "Inspecting libpaths (@libpaths) for runtime libe $runtimelib\n";
                }

                foreach my $libpath (@libpaths) {
                    # look for versioned and non-versioned libraries
                    $query = "$libpath/lib$runtimelib.so*";
                    my @files = glob ($query);
                    foreach my $file (@files) {
                        $self-&gt;add_unique_lib ($file);
                    }
                }
            }
        }
    }
}

sub copy_system_libs ()
{
    my $self = shift;
    my $syslibs = shift;
    my @liblist = split (',', $syslibs);
    foreach my $lib (@liblist) {
        if (-e $lib) {
            if (defined $ENV{'ACE_TEST_VERBOSE'}) {
                print STDERR "Found system library $lib\n";
            }
            $self-&gt;PutFile ($lib, "$self-&gt;{FSROOT}/lib/" . basename ($lib));
        } else {
            print STDERR "Cannot find system library $lib!\n";
        }
    }
}

sub PutFile ($)
{
    my $self = shift;
    my $src = shift;
    my $dest = shift;

    if (defined $self-&gt;{TARGET}) {
        return $self-&gt;{TARGET}-&gt;PutLib($src, $dest);
    } else {
        my $silent;

        if (!defined $ENV{'ACE_TEST_VERBOSE'}) {
          $silent = "2&gt; /dev/null"
        }

        my $adb_process = $ENV{'ANDROID_SDK_ROOT'} . "/platform-tools/adb";

        my $cmd = "$adb_process" . ' push '. "\"$src\" \"$dest\" $silent";

        if (defined $ENV{'ACE_TEST_VERBOSE'}) {
          print STDERR "PutFile cmd: $cmd\n";
        }

        system ( $cmd );
        if ($? != 0) {
            return -1;
        }
        return 0;
    }
}

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