ACE/bin/PerlACE/Process_Win32.pm

   1 #!/usr/bin/env perl
   2
   3 use PerlACE::Run_Test;
   4
   5 package PerlACE::Process;
   6
   7 use strict;
   8 use Win32::Process;
   9 use File::Basename;
  10 use Cwd;
  11
  12 # Make sure the File::Which module is installed on the machine
  13 # before trying to use it. If the module is installed on this
  14 # machine, then it will be included because of the eval ()
  15 # statement below.
  16 my $has_which = eval ("use File::Which; 1;") ? 1 : 0;
  17
  18 ###############################################################################
  19
  20 # This is what GetExitCode will return if the process is still running.
  21 my $STILL_ACTIVE = 259;
  22
  23 ###############################################################################
  24
  25 ### Constructor and Destructor
  26
  27 #
  28 # Hack in purify support thru 2 environment variables:
  29 #   ACE_RUN_PURIFY_CMD: complete path to purify executable
  30 #   ACE_RUNTEST_DELAY: wait delay factor, default to 10 if
  31 #                      ACE_RUN_PURIFY_CMD is defined, or 1 if
  32 #                      ACE_RUN_PURIFY_CMD is not defined.
  33 # ** Notice that when ACE_RUN_PURIFY_CMD is define, PerlACE::Process
  34 #    reports the return status of *purify*, not the process being purified.
  35 #
  36 # Also hack in the ability to run the test on a WinCE device using the
  37 # ACE_WINCE_TEST_CONTROLLER environment variable. If set, it specifies a
  38 # controlling program to use for setting up and executing the test.
  39 # Further setup can be specialized depending on the value of the variable.
  40
  41 sub new
  42 {
  43     my $proto = shift;
  44     my $class = ref ($proto) || $proto;
  45     my $self = {};
  46
  47     $self->{EXECUTABLE} = shift;
  48     $self->{ARGUMENTS} = shift;
  49     $self->{TARGET} = undef;
  50     $self->{RUNNING} = 0;
  51     $self->{IGNOREEXESUBDIR} = 0;
  52     $self->{IGNOREHOSTROOT} = 0;
  53     $self->{PROCESS} = undef;
  54     $self->{PURIFY_CMD} = $ENV{'ACE_RUN_PURIFY_CMD'};
  55     $self->{PURIFY_OPT} = $ENV{'ACE_RUN_PURIFY_OPT'};
  56     if (!defined $PerlACE::Process::WAIT_DELAY_FACTOR) {
  57         if (defined $self->{PURIFY_CMD}) {
  58             $PerlACE::Process::WAIT_DELAY_FACTOR = 10;
  59         }
  60         else {
  61             $PerlACE::Process::WAIT_DELAY_FACTOR = 1;
  62         }
  63     }
  64     $self->{WINCE_CTL} = $ENV{'ACE_WINCE_TEST_CONTROLLER'};
  65
  66     bless ($self, $class);
  67     return $self;
  68 }
  69
  70 sub DESTROY
  71 {
  72     my $self = shift;
  73
  74     if ($self->{RUNNING} == 1) {
  75         print STDERR "ERROR: <", $self->{EXECUTABLE},
  76                      "> still running upon object destruction\n";
  77         $self->Kill ();
  78     }
  79 }
  80
  81
  82 ###############################################################################
  83
  84 ### Some Accessors
  85
  86 sub Normalize_Executable_Name($)
  87 {
  88     my $self = shift;
  89     my $executable = shift;
  90     my $basename = basename ($executable);
  91     my $dirname = dirname ($executable). '/';
  92     my $subdir;
  93     if (defined $self->{TARGET}) {
  94         $subdir = $self->{TARGET}->ExeSubDir();
  95     }
  96     else {
  97         $subdir = $PerlACE::Process::ExeSubDir;
  98     }
  99     $executable = $dirname.$subdir.$basename.".EXE";
 100
 101     ## Installed executables do not conform to the ExeSubDir
 102     if (! -x $executable && -x $dirname.$basename.'.EXE') {
 103       $executable = $dirname.$basename.'.EXE';
 104     }
 105
 106     $executable =~ s/\//\\/g; # / <- # color coding issue in devenv
 107
 108     return $executable;
 109 }
 110
 111
 112 sub Executable
 113 {
 114     my $self = shift;
 115
 116     if (@_ != 0) {
 117         $self->{EXECUTABLE} = shift;
 118     }
 119
 120     my $executable = $self->{EXECUTABLE};
 121     # If the target's config has a different ACE_ROOT, rebase the executable
 122     # from $ACE_ROOT to the target's root.
 123     if (defined $self->{TARGET} &&
 124         $self->{TARGET}->ACE_ROOT() ne $ENV{'ACE_ROOT'}) {
 125         $executable = File::Spec->rel2abs($executable);
 126         $executable = File::Spec->abs2rel($executable, $ENV{'ACE_ROOT'});
 127         $executable = $self->{TARGET}->ACE_ROOT() . "/$executable";
 128     }
 129
 130     # After VxWorks adopts the TARGET scheme, can do away with this block.
 131     if ($self->{IGNOREHOSTROOT} == 0) {
 132       if (PerlACE::is_vxworks_test()) {
 133           $executable = PerlACE::VX_HostFile ($executable);
 134       }
 135     }
 136
 137     if ($self->{IGNOREEXESUBDIR} == 0) {
 138         $executable = $self->Normalize_Executable_Name ($executable);
 139     }
 140     else {
 141         if ($executable !~ m/\.(BAT|EXE|COM)$/i) {
 142             $executable = $executable.".EXE";
 143         }
 144
 145         $executable =~ s/\//\\/g; # / <- # color coding issue in devenv
 146
 147         # If there is no directory in the executable name, then we are going
 148         # to search the PATH for the executable.
 149         if ($has_which && $executable !~ m/\//) {
 150             my $which = File::Which::which ($executable);
 151
 152             if ($which ne "") {
 153                 $executable = $which;
 154             }
 155         }
 156     }
 157
 158     return $executable;
 159 }
 160
 161 sub Arguments
 162 {
 163     my $self = shift;
 164
 165     if (@_ != 0) {
 166         $self->{ARGUMENTS} = shift;
 167     }
 168
 169     return $self->{ARGUMENTS};
 170 }
 171
 172 sub CommandLine ()
 173 {
 174     my $self = shift;
 175
 176     my $commandline = $self->Executable ();
 177     $commandline = '"' . $commandline . '"' if $commandline =~ /\s/;
 178
 179     if (defined $self->{ARGUMENTS}) {
 180         $commandline .= ' '.$self->{ARGUMENTS};
 181     }
 182
 183     return $commandline;
 184 }
 185
 186 sub IgnoreExeSubDir
 187 {
 188     my $self = shift;
 189
 190     # If we have -Config ARCH, do not set IGNOREEXESUBDIR, since with ARCH
 191     # all executables (even those in $ACE_ROOT/bin, etc.) are located in the
 192     # architecture-specific subdirectory.
 193     if (@_ != 0 && !grep(($_ eq 'ARCH'), @PerlACE::ConfigList::Configs)) {
 194         $self->{IGNOREEXESUBDIR} = shift;
 195     }
 196     elsif (@_ != 0 && $self->{EXECUTABLE} =~ /perl$/) {
 197         print ("==== automatically ignoring...\n");
 198         $self->{IGNOREEXESUBDIR} = shift;
 199     }
 200
 201     return $self->{IGNOREEXESUBDIR};
 202 }
 203
 204 sub IgnoreHostRoot
 205 {
 206     my $self = shift;
 207
 208     if (@_ != 0) {
 209         $self->{IGNOREHOSTROOT} = shift;
 210     }
 211
 212     return $self->{IGNOREHOSTROOT};
 213 }
 214
 215 ###############################################################################
 216
 217 ### Spawning processes
 218
 219
 220 # Spawn the process and continue.
 221
 222 sub Spawn ()
 223 {
 224     my $self = shift;
 225
 226     if ($self->{RUNNING} == 1) {
 227         print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
 228                      "> already running\n";
 229         return -1;
 230     }
 231
 232     if (!defined $self->{EXECUTABLE}) {
 233         print STDERR "ERROR: Cannot Spawn: No executable specified\n";
 234         return -1;
 235     }
 236
 237     if ($self->{IGNOREEXESUBDIR} == 0) {
 238         if (!-f $self->Executable ()) {
 239             print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
 240                          "> not found\n";
 241             return -1;
 242         }
 243
 244         if (!-x $self->Executable ()) {
 245             print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
 246                          "> not executable\n";
 247             return -1;
 248         }
 249     }
 250
 251     my $state = 0;
 252     my $cmdline = "";
 253     my $executable = "";
 254
 255     my $chdir_needed = 0;
 256     my $curdir_bak;
 257
 258     if (defined $self->{PURIFY_CMD}) {
 259         my $orig_cmdline = $self->CommandLine ();
 260         $executable = $self->{PURIFY_CMD};
 261         my $basename = basename ($self->{EXECUTABLE});
 262
 263         my $PurifyOptions = $self->{PURIFY_OPT};
 264         if (!defined $PurifyOptions) {
 265             $PurifyOptions =
 266                 "/run ".
 267 #                "/save-data=$basename.pfy ".
 268                 "/save-text-data=$basename.pfytxt ".
 269                 "/AllocCallStackLength=20 ".
 270                 "/ErrorCallStackLength=20 ".
 271                 "/HandlesInUseAtExit ".
 272                 "/InUseAtExit ".
 273                 "/LeaksAtExit ";
 274         }
 275         $cmdline =
 276             "purify " .
 277             "$PurifyOptions ".
 278             "$orig_cmdline" ;
 279     }
 280     elsif (defined $self->{WINCE_CTL}) {
 281         $executable = $self->Executable ();
 282         $cmdline = $self->CommandLine ();
 283
 284         # Generate a script to copy the test down to the device, run it,
 285         # copy the log file(s) back to the log directory, then delete the
 286         # program and log files on the remote device.
 287         unless (open (SCRIPT, ">start_test.cmd")) {
 288             print STDERR "ERROR: Cannot Spawn: <", $self->Executable (),
 289                          "> failed to create start_test.cmd\n";
 290             return -1;
 291         }
 292
 293         my $testname = basename($executable,'.EXE');
 294         my $here = getcwd();
 295         $here =~ s/\//\\/g;
 296         $executable =~ s/^\.//;      # Chop leading .
 297         $executable = $here . $executable;   # Fully qualified name
 298         # Take off the test name from the start of the command line.
 299         # The command name is preprended in the script below.
 300         my @tokens = split(' ', $cmdline);
 301         @tokens = splice(@tokens,1);
 302         $cmdline = join(' ', @tokens);
 303         print SCRIPT "copy $executable 1:\\Windows\n";
 304         print SCRIPT "start /wait $testname $cmdline\n";
 305         print SCRIPT "copy 1:\\log\\$testname*.txt $here\\log\n";
 306         print SCRIPT "del 1:\\Windows\\$testname.exe\n";
 307         print SCRIPT "del 1:\\log\\$testname*.txt\n";
 308         close SCRIPT;
 309
 310         $executable = $ENV{'ComSpec'};
 311         my $pocket_device_opts = $ENV{'ACE_PCE_DEVICE'};
 312         $cmdline = "cmd /C start /B /WAIT $self->{WINCE_CTL} $pocket_device_opts -m NAME=start_test.cmd;WAIT=401000; -e"
 313     }
 314     elsif (defined $ENV{'ACE_TEST_WINDOW'}) {
 315         $state = ($ENV{'ACE_TEST_WINDOW'} =~ /\/k/i ? CREATE_NEW_CONSOLE : DETACHED_PROCESS);
 316         $executable = $ENV{'ComSpec'};
 317         $cmdline = $ENV{'ACE_TEST_WINDOW'} . ' ' . $self->CommandLine();
 318     }
 319     else {
 320         $executable = $self->Executable ();
 321         $cmdline = $self->CommandLine ();
 322         if ((defined $self->{TARGET}) && ($ENV{'ACE_ROOT'} ne $self->{TARGET}->ACE_ROOT ())) {
 323           $chdir_needed = 1;
 324           $curdir_bak = cwd ();
 325           chdir (dirname ($executable));
 326         }
 327     }
 328     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 329       print "$executable $cmdline\n";
 330     }
 331     my %backup_ENV = %ENV;
 332     # update environment for target
 333     if (defined $self->{TARGET}) {
 334         if (!defined $self->{TARGET}->{REMOTE_SHELL}) {
 335             my $x_env_ref = $self->{TARGET}->{EXTRA_ENV};
 336             while ( my ($env_key, $env_value) = each(%$x_env_ref) ) {
 337                 if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 338                     print "INFO: adding target environment $env_key=$env_value\n";
 339                 }
 340                 $ENV{$env_key} = $env_value;
 341             }
 342         }
 343         if ($self->{TARGET}->{LIBPATH}) {
 344             if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 345                 print "INFO: adding target libpath ".$self->{TARGET}->{LIBPATH}."\n";
 346             }
 347             PerlACE::add_lib_path ($self->{TARGET}->{LIBPATH});
 348         }
 349     }
 350     my $status = Win32::Process::Create ($self->{PROCESS},
 351                                          $executable,
 352                                          $cmdline,
 353                                          ($state == 0 ? 1 : 0),
 354                                          $state,
 355                                          '.');
 356     %ENV = %backup_ENV;
 357     if ($chdir_needed) {
 358       chdir ($curdir_bak);
 359     }
 360     if ($status == 0) {
 361         print STDERR "ERROR: Spawn failed for <", $self->CommandLine (), ">\n";
 362         return -1;
 363     }
 364
 365     $self->{RUNNING} = 1;
 366     return 0;
 367 }
 368
 369
 370 # Wait for the process to exit or kill after a time period
 371
 372 sub WaitKill ($)
 373 {
 374     my $self = shift;
 375     my $timeout = shift;
 376
 377     my $status = $self->TimedWait ($timeout);
 378
 379     if ($status == -1) {
 380         print STDERR "ERROR: $self->{EXECUTABLE} timedout\n";
 381         $self->Kill ();
 382         # Don't need to Wait since we are on Win32
 383     }
 384
 385     $self->{RUNNING} = 0;
 386
 387     return $status;
 388 }
 389
 390
 391 # Do a Spawn and immediately WaitKill
 392
 393 sub SpawnWaitKill ($)
 394 {
 395     my $self = shift;
 396     my $timeout = shift;
 397
 398     if ($self->Spawn () == -1) {
 399         return -1;
 400     }
 401
 402     return $self->WaitKill ($timeout);
 403 }
 404
 405
 406 # Kill the process
 407
 408 sub Kill ($)
 409 {
 410     my $self = shift;
 411     my $notused = shift; #Used in Process_Unix.pm
 412
 413     if ($self->{RUNNING}  && !defined $ENV{'ACE_TEST_WINDOW'}) {
 414         Win32::Process::Kill ($self->{PROCESS}, -1);
 415     }
 416
 417     $self->{RUNNING} = 0;
 418 }
 419
 420
 421 # Terminate the process and wait for it to finish
 422
 423 sub TerminateWaitKill ($)
 424 {
 425     my $self = shift;
 426     my $timeout = shift;
 427
 428     if ($self->{RUNNING}) {
 429         print STDERR "INFO: $self->{EXECUTABLE} being killed.\n";
 430         Win32::Process::Kill ($self->{PROCESS}, 0);
 431     }
 432
 433     return $self->WaitKill ($timeout);
 434 }
 435
 436
 437 # Wait until a process exits.
 438 # return -1 if the process is still alive.
 439
 440 sub Wait ($)
 441 {
 442     my $self = shift;
 443     my $timeout = shift;
 444     if (!defined $timeout || $timeout < 0) {
 445       $timeout = INFINITE;
 446     } else {
 447       $timeout = $timeout * 1000 * $PerlACE::Process::WAIT_DELAY_FACTOR;
 448     }
 449
 450     my $result = 0;
 451
 452     if ($self->{RUNNING}) {
 453       $result = Win32::Process::Wait ($self->{PROCESS}, $timeout);
 454       if ($result == 0) {
 455         return -1;
 456       }
 457     }
 458     Win32::Process::GetExitCode ($self->{PROCESS}, $result);
 459     $self->{RUNNING} = 0;
 460     return $result;
 461 }
 462
 463
 464 # Wait for a process to exit with a timeout
 465
 466 sub TimedWait ($)
 467 {
 468     my($self) = shift;
 469     my($timeout) = shift;
 470     return $self->Wait($timeout);
 471 }
 472
 473 ###
 474
 475 sub kill_all
 476 {
 477     my $procmask = shift;
 478     my $target = shift;
 479     my $pid = -1;
 480     for my $line (`tasklist /nh /fo csv`) {
 481         # find matching process line
 482         if ($line =~ /$procmask/) {
 483             # find process PID
 484             if ($line =~ /^\"[^\"]+\",\"(\d+)\",/) {
 485                 $pid = $1;
 486                 Win32::Process::KillProcess ($pid, 0); # kill process
 487                 if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 488                     print STDERR "INFO: Killed process at [$line]\n"
 489                 }
 490             }
 491         }
 492     }
 493 }
 494
 495 1;