ACE/bin/PerlACE/TestTarget.pm

   1 #!/usr/bin/env perl
   2 #
   3 # The TestTarget class is for operations that are per-target while testing.
   4 # They can be overridden for specific needs like embedded systems, etc.
   5
   6 package PerlACE::TestTarget;
   7
   8 use strict;
   9 use English;
  10 use POSIX qw(:time_h);
  11 use File::Copy;
  12 use File::Spec;
  13 use File::Basename;
  14 use PerlACE::Run_Test;
  15 use Socket;
  16 use Sys::Hostname;
  17 use Cwd;
  18
  19 ###############################################################################
  20
  21 # Create the proper kind of TestTarget based on specified test component.
  22 # Pass the component number as the first argument. If there's no
  23 # DOC_TEST_<component-number> environment variable, use the local machine.
  24
  25 sub create_target
  26 {
  27     my $component = shift;
  28     if ($component == 0) {
  29         print STDERR "Warning: components should be numbers, not names\n";
  30     }
  31     my $target = undef;
  32     my $envname = "DOC_TEST_\U$component";
  33     if (!exists $ENV{$envname}) {
  34         $envname = "DOC_TEST_DEFAULT";
  35         if (!exists $ENV{$envname}) {
  36           $target = new PerlACE::TestTarget("default");
  37           return $target;
  38         }
  39     }
  40     my $config_name = $ENV{$envname};
  41     # There's a configuration name; use it to look up the platform.
  42     $config_name = uc $config_name;
  43     $envname = $config_name.'_OS';
  44     if (!exists $ENV{$envname}) {
  45         print STDERR "$config_name requires an OS type in $envname\n";
  46         return undef;
  47     }
  48     my $config_os = $ENV{$envname};
  49     SWITCH: {
  50       if ($config_os =~ m/local|remote|avd/i) {
  51         $target = new PerlACE::TestTarget ($config_name);
  52         last SWITCH;
  53       }
  54       if ($config_os =~ m/LabVIEW_RT/i) {
  55         require PerlACE::TestTarget_LVRT;
  56         $target = new PerlACE::TestTarget_LVRT ($config_name);
  57         last SWITCH;
  58       }
  59       if ($config_os =~ /VxWorks/i) {
  60         require PerlACE::TestTarget_VxWorks;
  61         $target = new PerlACE::TestTarget_VxWorks ($config_name);
  62         last SWITCH;
  63       }
  64       if ($config_os =~ /WinCE/i) {
  65         require PerlACE::TestTarget_WinCE;
  66         $target = new PerlACE::TestTarget_WinCE ($config_name);
  67         last SWITCH;
  68       }
  69       if ($config_os =~ /ANDROID/i) {
  70         require PerlACE::TestTarget_Android;
  71         $target = new PerlACE::TestTarget_Android ($config_name, $component);
  72         last SWITCH;
  73       }
  74       print STDERR "$config_os is an unknown OS type!\n";
  75     }
  76     return $target;
  77 }
  78
  79 ### Constructor and Destructor
  80
  81 sub new
  82 {
  83     my $proto = shift;
  84     my $class = ref ($proto) || $proto;
  85     my $self = {};
  86
  87     my $config_name = shift;
  88     bless ($self, $class);
  89     $self->GetConfigSettings($config_name);
  90
  91     return $self;
  92 }
  93
  94 sub DESTROY
  95 {
  96     my $self = shift;
  97 }
  98
  99 # If there was a config name specified, use it to look up the configure
 100 # info. Else, use the traditional defaults.
 101 sub GetConfigSettings ($)
 102 {
 103     my $self = shift;
 104     my $config_name = shift;
 105     my $env_prefix = '';
 106     my $fs_root;
 107     my $tgt_fs_root;
 108
 109     if (defined $config_name) {
 110         $env_prefix = $config_name."_";
 111     }
 112
 113     my $env_name = $env_prefix.'ACE_ROOT';
 114     if (exists $ENV{$env_name}) {
 115         $self->{ace_root} = $ENV{$env_name};
 116     }
 117     else {
 118         # Fall back to naked ACE_ROOT if no config-specific one.
 119         $self->{ace_root} = $ENV{'ACE_ROOT'};
 120     }
 121     $tgt_fs_root = dirname($self->{ace_root});
 122     if (exists $ENV{'ACE_ROOT'}) {
 123         $fs_root = dirname($ENV{'ACE_ROOT'});
 124     } else {
 125         $fs_root = $tgt_fs_root;
 126     }
 127     $env_name = $env_prefix.'TAO_ROOT';
 128     if (exists $ENV{$env_name})
 129     {
 130       $self->{tao_root} = $ENV{$env_name};
 131     } elsif ($fs_root ne $tgt_fs_root && -d "$fs_root/TAO") {
 132         # flat directory structure
 133         $self->{tao_root} = "$tgt_fs_root/TAO";
 134     } elsif ($fs_root ne $tgt_fs_root && -d "$fs_root/ACE/TAO") {
 135         # hierarchical struture
 136         $self->{tao_root} = "$self->{ace_root}/TAO";
 137     } elsif (exists $ENV{'TAO_ROOT'}) {
 138         if ($fs_root ne $tgt_fs_root) {
 139             $self->{tao_root} =
 140                 PerlACE::rebase_path ($ENV{'TAO_ROOT'}, $fs_root, $tgt_fs_root);
 141         } else {
 142             $self->{tao_root} = $ENV{'TAO_ROOT'};
 143         }
 144     } else {
 145         # fall back to assuming classic hierarchical structure
 146         $self->{tao_root} = "$self->{ace_root}/TAO";
 147     }
 148
 149     $env_name = $env_prefix.'TEST_ROOT';
 150     if (exists $ENV{$env_name}) {
 151       $self->{TEST_ROOT} = $ENV{$env_name};
 152     } else {
 153       $self->{TEST_ROOT} = $self->{ACE_ROOT};
 154     }
 155
 156     $env_name = $env_prefix.'TEST_FSROOT';
 157     if (exists $ENV{$env_name}) {
 158       $self->{TEST_FSROOT} = $ENV{$env_name};
 159     }
 160
 161     if ($fs_root ne $tgt_fs_root) {
 162       $self->{HOST_FSROOT} = $fs_root;
 163       $self->{TARGET_FSROOT} = $tgt_fs_root;
 164     }
 165
 166     $env_name = $env_prefix.'EXE_SUBDIR';
 167     if (exists $ENV{$env_name}) {
 168         $self->{EXE_SUBDIR} = $ENV{$env_name}.'/';
 169     } else {
 170         # If no ExeSubDir given via env variable, and this is an unnamed
 171         # config, allow use of the subdir specified on the command line.
 172         # This preserves historical behavior.
 173         if (defined $config_name && $config_name ne 'default') {
 174             $self->{EXE_SUBDIR} = './';
 175         }
 176         else {
 177             $self->{EXE_SUBDIR} = $PerlACE::Process::ExeSubDir;
 178         }
 179     }
 180     $env_name = $env_prefix.'ARCH';
 181     if (exists $ENV{$env_name}) {
 182         $self->{ARCH} = $ENV{$env_name};
 183     } elsif ($config_name eq 'default'
 184              && grep(($_ eq 'ARCH'), @PerlACE::ConfigList::Configs)) {
 185         $self->{ARCH} = 1;
 186     }
 187     $env_name = $env_prefix.'PROCESS_START_WAIT_INTERVAL';
 188     if (exists $ENV{$env_name}) {
 189         $self->{PROCESS_START_WAIT_INTERVAL} = $ENV{$env_name};
 190     } else {
 191         $self->{PROCESS_START_WAIT_INTERVAL} = 15;
 192     }
 193     $env_name = $env_prefix.'PROCESS_STOP_WAIT_INTERVAL';
 194     if (exists $ENV{$env_name}) {
 195         $self->{PROCESS_STOP_WAIT_INTERVAL} = $ENV{$env_name};
 196     } else {
 197         $self->{PROCESS_STOP_WAIT_INTERVAL} = 10;
 198     }
 199     $env_name = $env_prefix.'ADB_WAIT_FOR_DEVICE_TIMEOUT';
 200     if (exists $ENV{$env_name}) {
 201         $self->{ADB_WAIT_FOR_DEVICE_TIMEOUT} = $ENV{$env_name};
 202     } else {
 203         $self->{ADB_WAIT_FOR_DEVICE_TIMEOUT} = 120;
 204     }
 205     $env_name = $env_prefix.'HOSTNAME';
 206     if (exists $ENV{$env_name}) {
 207         $self->{HOSTNAME} = $ENV{$env_name};
 208     } else {
 209         $self->{HOSTNAME} = hostname();
 210     }
 211     $env_name = $env_prefix.'IP_ADDRESS';
 212     if (exists $ENV{$env_name}) {
 213         $self->{IP_ADDRESS} = $ENV{$env_name};
 214     }
 215     $env_name = $env_prefix.'IBOOT';
 216     if (exists $ENV{$env_name}) {
 217         $self->{IBOOT} = $ENV{$env_name};
 218     }
 219     $env_name = $env_prefix.'IBOOT_PASSWD';
 220     if (exists $ENV{$env_name}) {
 221         $self->{IBOOT_PASSWD} = $ENV{$env_name};
 222     }
 223     $env_name = $env_prefix.'IBOOT_OUTLET';
 224     if (exists $ENV{$env_name}) {
 225         $self->{IBOOT_OUTLET} = $ENV{$env_name};
 226     }
 227     $env_name = $env_prefix.'IBOOT_USER';
 228     if (exists $ENV{$env_name}) {
 229         $self->{IBOOT_USER} = $ENV{$env_name};
 230     }
 231     $env_name = $env_prefix.'IBOOT_PASSWD';
 232     if (exists $ENV{$env_name}) {
 233         $self->{IBOOT_PASSWD} = $ENV{$env_name};
 234     }
 235     $env_name = $env_prefix.'REBOOT_TIME';
 236     if (exists $ENV{$env_name}) {
 237         $self->{REBOOT_TIME} = $ENV{$env_name};
 238     } else {
 239         $self->{REBOOT_TIME} = 0;
 240     }
 241     $env_name = $env_prefix.'REBOOT';
 242     if (exists $ENV{$env_name}) {
 243         $self->{REBOOT} = $ENV{$env_name};
 244     } else {
 245         $self->{REBOOT} = 0;
 246     }
 247     $env_name = $env_prefix.'STARTUP_COMMAND';
 248     if (exists $ENV{$env_name}) {
 249         $self->{STARTUP_COMMAND} = $ENV{$env_name};
 250     }
 251     $env_name = $env_prefix.'TELNET_HOST';
 252     if (exists $ENV{$env_name}) {
 253         $self->{TELNET_HOST} = $ENV{$env_name};
 254     } else {
 255         $self->{TELNET_HOST} = $self->{HOSTNAME};
 256     }
 257     $env_name = $env_prefix.'TELNET_PORT';
 258     if (exists $ENV{$env_name}) {
 259         $self->{TELNET_PORT} = $ENV{$env_name};
 260     } else {
 261         $self->{TELNET_PORT} = 23;
 262     }
 263     $env_name = $env_prefix.'HOST_ROOT';
 264     if (exists $ENV{$env_name}) {
 265         $self->{HOST_ROOT} = $ENV{$env_name};
 266     }
 267     $env_name = $env_prefix.'SYSTEM_LIBS';
 268     if (exists $ENV{$env_name}) {
 269         $self->{SYSTEM_LIBS} = $ENV{$env_name};
 270     }
 271     $env_name = $env_prefix.'REMOTE_SHELL';
 272     if (exists $ENV{$env_name}) {
 273         $self->{REMOTE_SHELL} = $ENV{$env_name};
 274     }
 275     $env_name = $env_prefix.'PUT_CMD';
 276     if (exists $ENV{$env_name}) {
 277         $self->{PUT_CMD} = $ENV{$env_name};
 278     }
 279     $env_name = $env_prefix.'GET_CMD';
 280     if (exists $ENV{$env_name}) {
 281         $self->{GET_CMD} = $ENV{$env_name};
 282     }
 283     $env_name = $env_prefix.'LIBPATH';
 284     if (exists $ENV{$env_name}) {
 285         $self->{LIBPATH} = $ENV{$env_name};
 286     }
 287     $env_name = $env_prefix.'REMOTE_FILETEST';
 288     if (exists $ENV{$env_name}) {
 289         $self->{REMOTE_FILETEST} = $ENV{$env_name};
 290     }
 291     $env_name = $env_prefix.'REMOTE_FILERM';
 292     if (exists $ENV{$env_name}) {
 293         $self->{REMOTE_FILERM} = $ENV{$env_name};
 294     }
 295     $env_name = $env_prefix.'PS_CMD';
 296     if (exists $ENV{$env_name}) {
 297         $self->{PS_CMD} = $ENV{$env_name};
 298     }
 299     $env_name = $env_prefix.'KILLALL_CMD';
 300     if (exists $ENV{$env_name}) {
 301         $self->{KILLALL_CMD} = $ENV{$env_name};
 302     }
 303     $self->{EXTRA_ENV} = {};
 304     $env_name = $env_prefix.'EXTRA_ENV';
 305     if (exists $ENV{$env_name}) {
 306         my @x_env = split (' ', $ENV{$env_name});
 307         foreach my $x_env_s (@x_env) {
 308             if ($x_env_s =~ /(\w+)=(.*)/) {
 309                 $self->{EXTRA_ENV}->{$1} = $2;
 310             } elsif (exists $ENV{$env_prefix.$x_env_s}) {
 311                 $self->{EXTRA_ENV}->{$x_env_s} = $ENV{$env_prefix.$x_env_s};
 312             }
 313         }
 314     }
 315     $self->{RUNTIME_LIBDEP} = ();
 316 }
 317
 318 ##################################################################
 319
 320 sub ACE_ROOT ($)
 321 {
 322     my $self = shift;
 323     return $self->{ace_root};
 324 }
 325
 326 sub TAO_ROOT ($)
 327 {
 328     my $self = shift;
 329     return $self->{tao_root};
 330 }
 331
 332 sub HostName ($)
 333 {
 334     my $self = shift;
 335     return $self->{HOSTNAME};
 336 }
 337
 338 sub IP_Address ($)
 339 {
 340     my $self = shift;
 341     if (!defined $self->{IP_ADDRESS}) {
 342       my @host = gethostbyname($self->{HOSTNAME});
 343       if (scalar(@host) == 0) {
 344           $self->{IP_ADDRESS} = "not found";
 345       } else {
 346           $self->{IP_ADDRESS} = inet_ntoa($host[4]);
 347       }
 348       if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 349           print STDERR "Target host [" . $self->{HOSTNAME} . "] has ipaddres : " . $self->{IP_ADDRESS};
 350       }
 351     }
 352     return $self->{IP_ADDRESS};
 353 }
 354
 355 sub ExeSubDir ($)
 356 {
 357     my $self = shift;
 358     my $new_val = shift;
 359     if (defined $new_val) {
 360         $self->{EXE_SUBDIR} = $new_val;
 361     }
 362     return $self->{EXE_SUBDIR};
 363 }
 364
 365 sub GetArchDir
 366 {
 367     my $self = shift;
 368     my $dir = shift;
 369     if (exists $self->{ARCH}) {
 370         return $dir . $self->{EXE_SUBDIR};
 371     }
 372     return $dir;
 373 }
 374
 375
 376 sub SystemLibs ($)
 377 {
 378     my $self = shift;
 379     return $self->{SYSTEM_LIBS};
 380 }
 381
 382 sub RandomPort ($)
 383 {
 384     my $self = shift;
 385     return (int(rand($$)) % 22766) + 10002;
 386 }
 387
 388 sub ProcessStartWaitInterval ($)
 389 {
 390     my $self = shift;
 391     return $self->{PROCESS_START_WAIT_INTERVAL};
 392 }
 393
 394 sub ProcessStopWaitInterval ($)
 395 {
 396     my $self = shift;
 397     return $self->{PROCESS_STOP_WAIT_INTERVAL};
 398 }
 399
 400 sub AdbWaitForDeviceTimeout ($)
 401 {
 402     my $self = shift;
 403     return $self->{ADB_WAIT_FOR_DEVICE_TIMEOUT};
 404 }
 405
 406 sub LocalEnvDir ($)
 407 {
 408     my $self = shift;
 409     my $dir = shift;
 410     my $newdir = $dir;
 411     if (defined $self->{TARGET_FSROOT}) {
 412       $newdir = PerlACE::rebase_path ($dir,
 413                                       $self->{HOST_FSROOT},
 414                                       $self->{TARGET_FSROOT});
 415
 416     }
 417     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 418         print STDERR "LocalEnvDir for $dir is $newdir\n";
 419     }
 420     return $newdir;
 421 }
 422
 423 # Convert a file in current directory to be local to the target
 424 sub LocalFile ($)
 425 {
 426     my $self = shift;
 427     my $file = shift;
 428     my $newfile = PerlACE::LocalFile($file);
 429     if (defined $self->{TARGET_FSROOT}) {
 430       $newfile = PerlACE::rebase_path ($newfile,
 431                                        $self->{HOST_FSROOT},
 432                                        $self->{TARGET_FSROOT});
 433     }
 434     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 435         print STDERR "LocalFile for $file is $newfile\n";
 436     }
 437     return $newfile;
 438 }
 439
 440 sub AddLibPath ($)
 441 {
 442     my $self = shift;
 443     my $dir = shift;
 444     my $noarch = shift;
 445
 446     # If we have -Config ARCH, use the -ExeSubDir setting as a sub-directory
 447     # of the lib path.  This is in addition to the regular LibPath.
 448     if ((defined $noarch && !$noarch) && defined $self->{ARCH}) {
 449         $self->AddLibPath($dir, 1);
 450         $dir .= '/' . $self->{EXE_SUBDIR};
 451     }
 452
 453     if ($self->ACE_ROOT () eq $ENV{'ACE_ROOT'}) {
 454         # add (relative) path without rebasing
 455         if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 456             print STDERR "Adding libpath $dir\n";
 457         }
 458         $self->{LIBPATH} = PerlACE::concat_path ($self->{LIBPATH}, $dir);
 459     } else {
 460         # add rebased path
 461         $dir = PerlACE::rebase_path ($dir, $self->{HOST_FSROOT}, $self->{TARGET_FSROOT});
 462         if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 463             print STDERR "Adding libpath $dir\n";
 464         }
 465         $self->{LIBPATH} = PerlACE::concat_path ($self->{LIBPATH}, $dir);
 466     }
 467 }
 468
 469 sub AddRuntimeLibrary ($)
 470 {
 471     my $self = shift;
 472     my $lib = shift;
 473     push(@{$self->{RUNTIME_LIBDEP}}, $lib);
 474 }
 475
 476 sub SetEnv ($)
 477 {
 478     my $self = shift;
 479     my $env_name = shift;
 480     my $env_value = shift;
 481     $self->{EXTRA_ENV}->{$env_name} = $env_value;
 482 }
 483
 484 sub GetEnv ($)
 485 {
 486     my $self = shift;
 487     my $env_name = shift;
 488     return $self->{EXTRA_ENV}->{$env_name};
 489 }
 490
 491 sub DeleteFile ($)
 492 {
 493     my $self = shift;
 494     my $file = shift;
 495     # expand path and possibly map to remote target root
 496     my $newfile = $self->LocalFile($file);
 497     if (defined $self->{REMOTE_SHELL} && defined $self->{REMOTE_FILERM}) {
 498         my $cmd = $self->{REMOTE_SHELL};
 499         if ($self->{REMOTE_FILERM} =~ /^\d*$/) {
 500             $cmd .= " 'test -e $newfile && rm $newfile'";
 501         } else {
 502             $cmd .= ' ' . $self->{REMOTE_FILERM} . ' ' . $newfile;
 503         }
 504         if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 505            print STDERR "Deleting remote $file from path $newfile using $cmd\n";
 506         }
 507         if (system ($cmd) != 0) {
 508                 print STDERR "ERROR executing [".$cmd."]\n";
 509         }
 510     } else {
 511         unlink ($newfile);
 512     }
 513 }
 514
 515 sub GetFile ($)
 516 {
 517     # On local host, the file is already there.
 518     my $self = shift;
 519     my $remote_file = shift;
 520     my $local_file = shift;
 521     if (!defined $local_file) {
 522         $local_file = $remote_file;
 523         $remote_file = $self->LocalFile($local_file);
 524     }
 525     if (defined $self->{GET_CMD}) {
 526             if (system ($self->{GET_CMD}.' '.$remote_file.' '.$local_file) != 0) {
 527                 print STDERR "ERROR executing [".$self->{GET_CMD}." $remote_file $local_file]\n";
 528             }
 529     }
 530     elsif (($remote_file ne $local_file) &&
 531         (File::Spec->rel2abs($remote_file) ne File::Spec->rel2abs($local_file))) {
 532         copy ($remote_file, $local_file);
 533     }
 534     return 0;
 535 }
 536
 537 # Put file from a to b
 538 sub PutFile ($)
 539 {
 540     my $self = shift;
 541     my $src = shift;
 542     my $dest = $self->LocalFile ($src);
 543     if (defined $self->{PUT_CMD}) {
 544             if (system ($self->{PUT_CMD}.' '.$src.' '.$dest) != 0) {
 545                 print STDERR "ERROR executing [".$self->{PUT_CMD}." $src $dest]\n";
 546             }
 547     }
 548     elsif (($src ne $dest) &&
 549         (File::Spec->rel2abs($src) ne File::Spec->rel2abs($dest))) {
 550         copy ($src, $dest);
 551     }
 552     return 0;
 553 }
 554
 555 sub WaitForFileTimed ($)
 556 {
 557     my $self = shift;
 558     my $file = shift;
 559     my $timeout = shift;
 560     # expand path and possibly map to remote target root
 561     my $newfile = $self->LocalFile($file);
 562     if (defined $self->{REMOTE_SHELL} && defined $self->{REMOTE_FILETEST}) {
 563         if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 564             print STDERR "Waiting for remote $file using path $newfile\n";
 565         }
 566
 567         $timeout *= $PerlACE::Process::WAIT_DELAY_FACTOR;
 568         my $cmd = $self->{REMOTE_SHELL};
 569         if ($self->{REMOTE_FILETEST} =~ /^\d*$/) {
 570             $cmd .= " 'test -e $newfile && test -s $newfile ; echo \$?'";
 571         } else {
 572             $cmd .= $self->{REMOTE_FILETEST} . ' ' . $file;
 573         }
 574         my $rc = 1;
 575         my $mark_tm = time (); # start time
 576         while ($timeout > 0) {
 577             $rc = int(`$cmd`);
 578             if ($rc == 0) {
 579                 return 0;
 580             }
 581             select(undef, undef, undef, 0.1);
 582             $timeout -= (time () - $mark_tm);
 583             $mark_tm = time ();
 584         }
 585         return -1;
 586     } else {
 587         if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 588             print STDERR "Waiting for local $file using path $newfile\n";
 589         }
 590         return PerlACE::waitforfile_timed ($newfile, $timeout);
 591     }
 592 }
 593
 594 sub CreateProcess ($)
 595 {
 596     my $self = shift;
 597     my $process = new PerlACE::Process (@_);
 598     $process->Target($self);
 599     return $process;
 600 }
 601
 602 # Don't need to do anything in most cases.
 603 sub GetStderrLog ($)
 604 {
 605     my $self = shift;
 606     return;
 607 }
 608
 609 sub KillAll ($)
 610 {
 611     my $self = shift;
 612     my $procmask = shift;
 613     if (defined $self->{KILLALL_CMD}) {
 614         my $cmd = $self->{KILLALL_CMD} . ' ' . $procmask;
 615         if (defined $self->{REMOTE_SHELL}) {
 616           $cmd = $self->{REMOTE_SHELL} . ' ' . $cmd;
 617         }
 618         if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 619             print STDERR "Executing $cmd\n";
 620         }
 621         system ($cmd);
 622     } else {
 623         PerlACE::Process::kill_all ($procmask, $self);
 624     }
 625 }
 626
 627 1;