rantest/East.pm

   1 #############################################################################
   2 #
   3 # Name:         East.pm
   4 #
   5 # Description:  East.pm is a Perl module that encapsulates the East Simulator
   6 #               as an object. Methods are provided to connect, configure and
   7 #               run tests on an East Simulator.
   8 #
   9 # Author:       Andrew@DeFaria.com
  10 #
  11 # Copyright (c) 2008 General Dynamics
  12 #
  13 # All rights reserved except as subject to DFARS 252.227-7014 of contract
  14 # number CP02H8901N issued under prime contract N00039-04-C-2009.
  15 #
  16 # Warning: This document contains technical data whose export is restricted
  17 # by the Arms Export Control Act (Title 22, U.S.C., Sec 2751, et seq.) or the
  18 # Export Administration Act of 1979, as amended, Title, 50, U.S.C., App. 2401
  19 # et seq. Violations of these export laws are subject to severe criminal
  20 # penalties. Disseminate in accordance with provisions of DoD Directive
  21 # 5230.25.
  22 #
  23 ##############################################################################
  24 use strict;
  25 use warnings;
  26
  27 package Nethawk::East;
  28
  29 use Carp;
  30 use Expect;
  31 use File::Basename;
  32 use File::Copy;
  33 use File::Path;
  34 use File::Temp qw (tempfile);
  35 use Getopt::Long;
  36
  37 use DateUtils;
  38 use Display;
  39 use Utils;
  40 use Rexec;
  41 use SCCM::Build::Utils;
  42
  43 use constant DEFAULT_TIMEOUT    => 180;
  44 use constant CCMACHINE          => "cclinux";
  45 use constant CLEARTOOL          => "ssh " . CCMACHINE . " \"cd $ENV{PWD} && /opt/rational/clearcase/bin/cleartool\"";
  46
  47 use constant RANHOST            => "ranray";
  48 use constant RANUSER            => "pswit";
  49
  50 use constant LOGHOST            => "seast1";
  51 use constant LOGUSER            => "pswit";
  52 use constant LOGBASE            => "$ENV{MNT_DIR}/testlogs";
  53 use constant RANTVL_LOGBASE     => "/export/rantvl";
  54
  55 # This is a non-standard, but commonly used prompt around here. For
  56 # EAST systems they use a terminator of "]$" as in "[p6258c@ceast1
  57 # p6258c]$ " however on ranray it's more like "[ranray/home/pwit]
  58 # ". So we look for both.
  59 use constant PROMPT             => qr'(\]\$|\] $)';
  60
  61 ############################################################################
  62 # Globals
  63 ############################################################################
  64 my %_validTestTypes = (
  65   "load"        => "LoadTCRunner",
  66   "manual"      => "Manual",
  67   "pool"        => "RegressionLoadRunner",
  68   "tc"          => "RegressionRunner",
  69   "ts"          => "RegressionTSRunner",
  70   "log"         => "Rantvl",
  71   "shell"       => "Shell",
  72 );
  73
  74 sub LogDebug ($) {
  75   my ($msg) = @_;
  76
  77   open FILE, ">>/tmp/rantest.debug.log"
  78     or die "Unable to open /tmp/rantest.debug.log for append - $!";
  79
  80   print FILE "$msg";
  81
  82   close FILE;
  83 } # LogDebug
  84
  85 ############################################################################
  86 #
  87 # new: Instantiate a new East object
  88 #
  89 # Parms:
  90 #   none
  91 #
  92 # Returns:      New East object
  93 #
  94 ############################################################################
  95 sub new {
  96   my ($class) = @_;
  97
  98   bless {
  99     timeout     => DEFAULT_TIMEOUT,
 100     prompt      => PROMPT,
 101   }, $class;
 102 } # new
 103
 104 ############################################################################
 105 #
 106 # validTestType:        Return a status indicating if the passed in
 107 #                       test type is valid (and an error message if not)
 108 # Parms:
 109 #   testType:           Type of test requested
 110 #
 111 # Returns:              List contains a status (0 = valid test type, 1 =
 112 #                       invalid test type) and an optional error message.
 113 #
 114 ############################################################################
 115 sub validTestType ($) {
 116   my ($testType) = @_;
 117
 118   $testType = "<undefined>" if !$testType;
 119
 120   return (0, "") if InArray (lc $testType, keys %_validTestTypes);
 121
 122   my $msg = "Type must be one of:\n\n";
 123
 124   foreach (sort keys %_validTestTypes) {
 125     $msg .= "  $_\t$_validTestTypes{$_}\n";
 126   } # foreach
 127
 128   return (1, $msg);
 129 } # validTestType
 130
 131 ############################################################################
 132 #
 133 # inUse:        Check if the unit type and number is in use. Returns undef
 134 #               if it is not being used or an error message if it is.
 135 # Parms:        none
 136 #
 137 # Returns:      List contains a status (0 = not in use, 1 = in use) and an
 138 #               optional error message.
 139 #
 140 ############################################################################
 141 sub inUse ($$) {
 142   my ($self) = @_;
 143
 144   my $dut = "$self->{unitType}$self->{unitNbr}";
 145
 146   my $lockfile1 = "$ENV{MNT_DIR}/$ENV{EAST_REL}/DUT/$dut/desktop.lock";
 147   my $lockfile2 = "$ENV{MNT_DIR}/$ENV{EAST_REL}/loadservers/$dut/desktop.lock";
 148
 149   my ($owner, @lines);
 150
 151   if (-f $lockfile1) {
 152     @lines = `ls -l $lockfile1`;
 153
 154     $owner = (split /\s+/, $lines[0])[2] if $lines[0];
 155   } elsif (-f $lockfile2) {
 156     @lines = `ls -l $lockfile2`;
 157
 158     $owner = (split /\s+/, $lines[0])[2] if $lines[0];
 159   } else {
 160     return undef;
 161   } # if
 162
 163   my $owner_name = "Unknown user";
 164
 165   return "ERROR: $dut is being tested now by $owner_name.\nDo not attempt to start EAST, it could cause serious problems." if !$owner;
 166
 167   @lines = `ypmatch $owner passwd 2>&1`;
 168
 169   if ($? == 0) {
 170     $owner_name = (split /:/, $lines[0])[4];
 171   } else {
 172     $owner_name = "ypmatch $owner passwd - failed";
 173   } # if
 174
 175   if ($ENV{LOGNAME} eq $owner) {
 176     return "East in use by you. Exit east using desktop button before starting again.";
 177   } else {
 178     return "$dut is being tested now by $owner_name.\nDo not attempt to start EAST, it could cause serious problems.";
 179   } # if
 180 } # inUse
 181
 182 ############################################################################
 183 #
 184 # viewExists:   Checks to see if a remote view exists.
 185 #
 186 # Parms:
 187 #   tag:        View tag to check
 188 #
 189 # Returns:      List contains a status (0 = view does not exist, 1 = view
 190 #               exists) and the optional output from the lsview command.
 191 #
 192 ############################################################################
 193 sub viewExists ($) {
 194   my ($self, $tag) = @_;
 195
 196   my $cmd = CLEARTOOL . " lsview $tag 2>&1";
 197   my @lines = `$cmd`;
 198
 199   return ($?, @lines);
 200 } # viewExists
 201
 202 ############################################################################
 203 #
 204 # testExists:   Checks to see if a test exists
 205 #
 206 # Parms:
 207 #   type:       Type of test to check (rbs, rnc or east)
 208 #   name:       Name of test
 209 #
 210 # Returns:      0 if test exists, 1 if it doesn't.
 211 #
 212 ############################################################################
 213 sub testExists ($$) {
 214   my ($self, $type, $name) = @_;
 215
 216   return 1 unless $self->{view};
 217
 218   return 1 if $name eq "";
 219
 220   my $vobPath = "vobs/simdev/tc_data";
 221
 222   # Now compose testPath
 223   my $testPath = "$ENV{MNT_DIR}/snapshot_views/$self->{userdir}/$self->{view}/$vobPath";
 224
 225   if ($type eq "LoadTCRunner") {
 226     $testPath .= "/tc/profiles/load/$name";
 227   } elsif ($type eq "RegressionRunner") {
 228     $testPath .= "/tc/profiles/tc/$name";
 229   } elsif ($type eq "RegressionLoadRunner") {
 230     croak "RegressionLoadRunner tests are not supported!";
 231   } elsif ($type eq "RegressionTSRunner") {
 232     $testPath .= "/tc/profiles/ts/$name";
 233   } # if
 234
 235   return 0 if !-f $testPath;
 236
 237   # Get test's name. Testname is stored in the profile file with a
 238   # .script at the end. This later useful when trying to find the
 239   # logfile as test name, not test filename, is used as part of the
 240   # component of the path of where the logfile will be written.
 241   my @lines = `strings $testPath | grep '\\.script'`;
 242
 243   if ($? == 0 && $lines[0] =~ /(\S+)\.script$/) {
 244     $self->{testName} = $1;
 245
 246     # We're looking for the leaf name therefore strip off everything
 247     # up to the last slash. For example, foo/bar/testname.scipt should
 248     # result in "testname".
 249     if ($self->{testName} =~ /.*\/(\S+)/) {
 250       $self->{testName} = $1;
 251     } # if
 252   } # if
 253
 254   return 1;
 255 } # testExists
 256
 257 ############################################################################
 258 #
 259 # getLogFileContents:   Returns an array of the lines in the log file.
 260 #
 261 # Parms:                none
 262 #
 263 # Returns:              Array of lines from the "logical" logfile
 264 #
 265 ############################################################################
 266 sub getLogFileContents ($) {
 267   my ($self, $logFileName) = @_;
 268
 269   # Get timestamp: A porition of the path to the log file is actually
 270   # a timestamp of the format MM.DD.YY_HH.MM.SS.MMM. It's difficult to
 271   # tell what this timestamp will become so we use the following
 272   # hueristic: We do an "ls -t $logFileName | head -1" on the remote
 273   # system. This should give us the most recently modified
 274   # file. Hopefully this will be the log file. However if multiple
 275   # processes are writing in this directory then there is the
 276   # possibility that our guess is wrong.
 277   my @lines = `ls -t $logFileName 2> /dev/null`;
 278
 279   if ($? != 0) {
 280     error "Unable to ls -t $logFileName";
 281
 282     LogDebug "BUG CATCHER: Here are the currently running java processes\n";
 283     @lines = `ps -efww | grep java | grep -v \'grep java\'`;
 284
 285     LogDebug $_ foreach (@lines);
 286
 287     return undef;
 288   } # if
 289
 290   chomp $lines[0];
 291
 292   # Get a list of logfiles
 293   $logFileName .= "/" . $lines[0] . "/detailedlogs/*_logs_*";
 294
 295   @lines        = ();
 296   my @logfiles  = `ls $logFileName 2> /dev/null`;
 297
 298   chomp @logfiles;
 299
 300   foreach (@logfiles) {
 301     # Logfiles still contain binary stuff so use strings(1)
 302     my @logLines = `strings $_`;
 303
 304     chomp @logLines;
 305
 306     push @lines, @logLines;
 307   } # foreach
 308
 309   return @lines;
 310 } # getLogFileContents
 311
 312 ############################################################################
 313 #
 314 # getLogFile:   Returns an array of the lines in the log file. Turns out
 315 #               that EAST creates a $self->{testName}_logs_1 file until
 316 #               it gets too large then creates a $self->{testName}_logs_2
 317 #               logfile and so on. So we want to present one logical file
 318 #               from n number of log files.
 319 #
 320 # Parms:        none
 321 #
 322 # Returns:      Array of lines from the "logical" logfile
 323 #
 324 ############################################################################
 325 sub getLogFile () {
 326   my ($self) = @_;
 327
 328   # Bail out if testName not set
 329   return () if !$self->{testName};
 330
 331   # Start path
 332   my $logFileName = "$ENV{MNT_DIR}/$ENV{EAST_REL}/DUT/$self->{unitType}$self->{unitNbr}/data/logs/";
 333
 334   # Add on path as per type of test
 335   if ($self->{class} eq "load") {
 336     $logFileName .= "load/testcase/$self->{testName}";
 337   } elsif ($self->{class} eq "tc") {
 338     $logFileName .= "regression/testcase/$self->{testName}";
 339   } elsif ($self->{class} eq "ts") {
 340     # Testsuites can have "parts"
 341     $logFileName .= "regression/testsuite";
 342
 343     my @lines;
 344     my @logfiles = `ls $logFileName 2> /dev/null`;
 345
 346     chomp @logfiles;
 347
 348     if (scalar @logfiles > 0) {
 349       foreach (@logfiles) {
 350         my @logLines = $self->getLogFileContents ("$logFileName/$_");
 351
 352         push @lines, @logLines;
 353       } # foreach
 354
 355       return @lines;
 356     } # if
 357   } elsif ($self->{class} eq "pool") {
 358     croak "Pool test type not implemented";
 359   } else  {
 360     croak "Invalid test case type $self->{class} found";
 361   } # if
 362
 363   return $self->getLogFileContents ($logFileName);
 364 } # getLogFile
 365
 366 ############################################################################
 367 #
 368 # testResult:   Checks the test's logfile to determine the result
 369 #
 370 # Parms:
 371 #   name:       Name of test
 372 #
 373 # Returns:      A status - 0 if we are able to get the results, 1 if we
 374 #               can't - and a message of "Success", "Failure", "Incomplete"
 375 #               or an error message
 376 #
 377 ############################################################################
 378 sub testResult ($) {
 379   my ($self, $name) = @_;
 380
 381   my @lines = grep (/EXECUTION STATUS/, $self->getLogFile);
 382
 383   my $testResult = "Incomplete";
 384
 385   # Search for EXECUTION STATUS. Note there may be more than one
 386   # EXECUTION STATUS in the array. If so return the last one.
 387   if (scalar @lines > 0 && $lines[$#lines] =~ /EXECUTION STATUS :: (.*)/) {
 388     $testResult = $1;
 389     $testResult =~ s/\s+$//;
 390   } # if
 391
 392   return (0, $testResult);
 393 } # testResult
 394
 395 ############################################################################
 396 #
 397 # shell:        Execute a shell script returning the results.
 398 #
 399 # Parms:
 400 #   script:     Script to run.
 401 #   opts:       Additional options passed to script
 402 #
 403 # Returns:      $status of shell exeuction and @lines of output
 404 #
 405 ############################################################################
 406 sub shell ($;$@) {
 407   my ($self, $script, @opts) = @_;
 408
 409   my ($status, @output) = Execute ($script . join " ", @opts);
 410
 411   $status >>= 8;
 412
 413   return ($status, @output);
 414 } # shell
 415
 416 ############################################################################
 417 #
 418 # stackOptions: Stacks options into an array. This is mainly here to handle
 419 #               options that are quoted. Given a string of options like
 420 #               'foo -bar "quoted value"' a simple split /\s+/, $str would
 421 #               result in:
 422 #
 423 #               0 'foo'
 424 #               1 '-bar'
 425 #               2 '"quoted'
 426 #               3 'value"'
 427 #
 428 #               using this function we'll get:
 429 #
 430 #               0 'foo'
 431 #               1 '-bar'
 432 #               2 'quoted value'
 433 #
 434 #               instead.
 435 #
 436 # Parms:
 437 #   str         String of options to stack
 438 #
 439 # Returns:      Array of options stacked with quoted strings occupying a
 440 #               single slot in the array.
 441 #
 442 # Notes:        Doesn't balance quotes. Also, you can use () instead of ""
 443 #               (e.g. -if (condition is specified here)).
 444 #
 445 ############################################################################
 446 sub stackOptions ($) {
 447   my ($options) = @_;
 448
 449   my (@opts, $str);
 450
 451   my $hitString = 0;
 452
 453   foreach (split /\s+/, $options) {
 454     if ($hitString) {
 455       if (/(\S*)[\"|\'|\)]$/) {
 456         $str .= $str ? " $1" : $1;
 457         $hitString = 0;
 458
 459         push @opts, $str;
 460
 461         undef $str;
 462       } else {
 463         $str .= $str ? " $_" : $_;
 464       } # if
 465
 466       next;
 467     } else {
 468       # Handle situation where you got only one "word"
 469       if (/[\"|\'|\(](\S*)[\"\'\)]/) {
 470         push @opts, $1;
 471       } elsif (/[\"|\'|\(](\S*)/) {
 472         $str .= $str ? " $1" : $1;
 473         $hitString = 1;
 474       } else {
 475         push @opts, $_;
 476       } # if
 477     } # if
 478   } # foreach
 479
 480   return @opts;
 481 } # stackOptions
 482
 483 ############################################################################
 484 #
 485 # rantvl:       Start rantvl
 486 #
 487 # Parms:
 488 #   cmd:        Rantvl command to execute
 489 #
 490 # Returns:      $pid of rantvl process and a message
 491 #
 492 ############################################################################
 493 sub rantvl ($) {
 494   my ($self, $cmd) = @_;
 495
 496   my $logged_in         = 0;
 497   my $timedout          = 0;
 498   my $logging_started   = 0;
 499   my @lines;
 500
 501   # First establish an ssh session to RANHOST as RANUSER. Note we are
 502   # assuming that pre-shared key ssh access has already been set up
 503   # here.
 504   $self->{rantvl} = new Expect ("ssh " . RANUSER . "\@" . RANHOST);
 505
 506   return (1, "Unable to connect to " . RANHOST . " as " . RANUSER)
 507     unless $self->{rantvl};
 508
 509   $self->{rantvl}->log_user (get_debug);
 510
 511   $self->{rantvl}->expect (
 512     $self->{timeout},
 513
 514     [ PROMPT,
 515       sub {
 516         $logged_in = 1;
 517       }
 518     ],
 519
 520     [ timeout =>
 521       sub {
 522         $timedout = 1;
 523       }
 524     ],
 525   );
 526
 527   if ($timedout) {
 528     return (1, "Timed out when connecting to " . RANHOST . " as " . RANUSER);
 529   } elsif (!$logged_in) {
 530     return (1, "Unable to connect to " . RANHOST . " as ". RANUSER);
 531   } # if
 532
 533   # Get test options. It seems GetOptions doesn't support taking input
 534   # from anything but @ARGV so we'll have to save a copy and restore
 535   # it.  See eastUsage for more info.
 536   my $rantvlTimeout     = $self->{timeout};
 537   my @savedOptions      = @ARGV;
 538   @ARGV                 = stackOptions $cmd;
 539
 540   # Don't complain about unknown options
 541   Getopt::Long::Configure "pass_through";
 542
 543   # Only really care about timeout...
 544   GetOptions (
 545     "timeout=i", \$rantvlTimeout,
 546   );
 547
 548   # Reassemble $cmd after GetOptions has processed it
 549   $cmd  = join " ", @ARGV;
 550   @ARGV = @savedOptions;
 551
 552   # Now start rantvl
 553   $self->{rantvl}->send ("$cmd\n");
 554
 555   $self->{rantvl}->expect (
 556     $rantvlTimeout,
 557
 558     [ qr"^Our pid is ",
 559       sub {
 560         my $pid = $_[0]->after;
 561
 562         if ($pid =~ /(\d+)/) {
 563           $logging_started = $1;
 564         } # if
 565       }
 566     ],
 567
 568     [ PROMPT,
 569       sub {
 570         my @output = split /\n/, $_[0]->before;
 571
 572         foreach (@output) {
 573           chomp;
 574           chop if /\r$/;
 575           push @lines, $_;
 576         } # foreach
 577       }
 578     ],
 579
 580     [ timeout =>
 581       sub {
 582         $timedout = 1;
 583       }
 584     ],
 585   );
 586
 587   if ($logging_started) {
 588     return ($logging_started, "Logging started");
 589   } elsif ($timedout) {
 590     return (0, "Timed out executing rantvl");
 591   } else {
 592     return (0, join "\n", @lines);
 593   } #if
 594 } # rantvl
 595
 596 ############################################################################
 597 #
 598 # rendezvous:   Rendezvous with EAST process by searching the log file for
 599 #               a specific phrase. We will use $self->{timeout} to determine
 600 #               how long we are gonna wait for this phrase to appear. We
 601 #               will divide $self->{timeout} by 10, making 10 attempts. So
 602 #               with a default timeout of 180 seconds, we will try 10 times
 603 #               18 seconds apart, for the phrase to appear before timing
 604 #               out.
 605 #
 606 # Parms:
 607 #   phrase:     Phrase to search for
 608 #   timeout:    How long to time out waiting for the rendezvous
 609 #
 610 # Returns:      undef if rendezvous was successful - error message
 611 #               otherwise.
 612 #
 613 ############################################################################
 614 sub rendezvous ($;$) {
 615   my ($self, $phrase, $timeout) = @_;
 616
 617   my $status;
 618
 619   my $attempts = 0;
 620
 621   $timeout = $timeout ? $timeout : $self->{timeout};
 622
 623   while (!$status && $attempts++ < 10) {
 624     display_nolf "Attempt #$attempts" if get_debug;
 625
 626     my @lines = grep (/$phrase/, $self->getLogFile);
 627
 628     last if scalar @lines > 0;
 629
 630     display " sleeping " . $timeout / 10 . " seconds" if get_debug;
 631     sleep $timeout / 10;
 632   } # while
 633
 634   if ($attempts > 10) {
 635     return "Timed out";
 636   } else {
 637     return undef;
 638   } # if
 639 } # rendezvous
 640
 641 ############################################################################
 642 #
 643 # connected:    Checks to see if you're connected to EAST
 644 #
 645 # Parms:
 646 #   none
 647 #
 648 # Returns:      undef if connected - error message otherwise
 649 #
 650 ############################################################################
 651 sub connected () {
 652   my ($self) = @_;
 653
 654   my $serverLogPath     = "$ENV{MNT_DIR}/$ENV{EAST_REL}/DUT/$self->{unitType}$self->{unitNbr}/data/logs/Server_Logs";
 655   my $serverLog         = $self->{unitType} eq "rbs"
 656                         ? "$serverLogPath/rnc_aal2.log"
 657                         : "$serverLogPath/nodeb_aal2_utran.log";
 658   my $searchStr         = "Successfully connected to EventServer";
 659   my $cmd               = "grep -q \"$searchStr\" $serverLog > /dev/null 2>&1";
 660   my @lines;
 661
 662   # We'll try up to 2 minutes, every 5 seconds...
 663   my $timedout = 0;
 664
 665   while ($timedout < (60 * 2)) {
 666     @lines = `$cmd`;
 667
 668     last if $? == 0;
 669
 670     sleep 5;
 671
 672     $timedout += 5;
 673   } # while
 674
 675   return "Timed out while attempting to rendezvous with server"
 676     if $timedout >= (60 * 2);
 677
 678   # Get RBS/RNC version string Must translate unitType and unitNbr
 679   # into a machine name of the form "ran{type}{nbr}" but we refer to
 680   # to things as 1-7 and they want things like 01-07. So we do
 681   # "ran{type}0{nbr}" give us things like ranrbs01 or ranrnc03.
 682
 683   # Here's another instance where using DNS aliases are messing us up.
 684   # Pat Phelps was testing on -unit 3m2. But that would have made
 685   # $machine = ranrnc03m2 and the "grep ^$machine below would fail. So
 686   # for a kludge we simply substr the first character of
 687   # $self->{unitNbr}.
 688   my $machine = "ran$self->{unitType}0" . substr $self->{unitNbr}, 0, 1;
 689
 690   $cmd  = "/prj/muosran/SWIT/moshell/swstat ";
 691   $cmd .= "/prj/muosran/SWIT/moshell/sitefiles/$machine ";
 692
 693   # Here we are grepping for lines begining with ^$machine, however
 694   # there are more than one, hence the tail -1.
 695   $cmd .= "| grep ^$machine | tail -1";
 696
 697   @lines = $self->{msh}->exec ($cmd);
 698
 699   # For some reason we are sometimes getting junk in $lines [0] so
 700   # filter out lines that don't have ^$machine in it.
 701   @lines = grep (/^$machine/, @lines);
 702
 703   if ($lines[0] && $lines[0] =~ /\w+\s+(\w+)/) {
 704     my $rstate = $1;
 705
 706     my $build_no = Utils->getLoadFromRState ($rstate);
 707
 708     $self->{ran_version} = uc ($self->{unitType}) . ":$rstate-$build_no";
 709   } # if
 710
 711   return undef;
 712 } # connected
 713
 714 ############################################################################
 715 #
 716 # connect:      Connects to the remote East machine
 717 #
 718 # Parms:
 719 #   view:       View name to set to to run the the test
 720 #   unitType:   Type of unit (rbs, rnc or east)
 721 #   unitNbr:    Number of the unit
 722 #   tm500:      Name of tm500 view (if any)
 723 #   nms:        Name of nms view (if any)
 724 #
 725 # Returns:      Undefined if connection was successful or error message if
 726 #               not
 727 #
 728 ############################################################################
 729 sub connect ($$$;$$$$) {
 730   my ($self, $view, $unitType, $unitNbr, $tm500, $nms, $feature, $secure) = @_;
 731
 732   $self->{unitType} = lc $unitType;
 733
 734   croak "ERROR: Type must be rbs, rnc or east"
 735     unless $self->{unitType} eq "rbs" or
 736            $self->{unitType} eq "rnc" or
 737            $self->{unitType} eq "east";
 738
 739   $self->{unitNbr} = $unitNbr;
 740
 741   # Check if unit is in use
 742   my $msg = $self->inUse;
 743
 744   return $msg if $msg;
 745
 746   # Check that view exists
 747   my ($status, @lines) = $self->viewExists ($view);
 748
 749   return "View $view does not exist" if $status;
 750
 751   # Save $view - we'll need it later...
 752   $self->{view} = $view;
 753
 754   if ($self->{view} =~ /(\S+)_SIM/) {
 755     $self->{userdir} = $1;
 756   } else {
 757     croak "ERROR: Unable to find userdir";
 758   } # if
 759
 760   # Connect as RANUSER@RANHOST and store the connection. We'll need
 761   # this to secure the node and we'll need this later on too.
 762   debug "Connecting to ". RANHOST . " as " . RANUSER;
 763
 764   $self->{msh} = new Rexec (
 765     host        => RANHOST,
 766     username    => RANUSER,
 767     prompt      => PROMPT,
 768   );
 769
 770   error "Unable to connect to " . RANHOST . " as " . RANUSER, 1
 771     unless $self->{msh};
 772
 773   # Secure node
 774   if ($secure) {
 775     my $node   = "$self->{unitType}$self->{unitNbr}";
 776
 777     # We need to wait for a while since this securenode command takes
 778     # a while. Looking briefly, securenode took 4'51" to run. So we'll
 779     # wait up to... 10 minutes...
 780     my $secureNodeTimeoutMinutes = 10;
 781     my $secureNodeTimeoutSeconds = $secureNodeTimeoutMinutes * 60;
 782
 783     verbose "Attempting to secure node $node - This make take a while...\n"
 784           . "(Will timeout in $secureNodeTimeoutMinutes minutes)";
 785
 786     my @lines  = $self->{msh}->exec ("/prj/muosran/SWIT/tools/bin/securenode $node", $secureNodeTimeoutSeconds);
 787     my $status = $self->{msh}->status;
 788
 789     if ($status != 0) {
 790       if ($status == 1) {
 791         error "The node $node is not known", $status;
 792       } elsif ($status == 2) {
 793         error "The node $node is not responding", $status;
 794       } elsif ($status == 3) {
 795         error "Unable to secure $node", $status;
 796       } elsif ($status == -1) {
 797         error "Timed out attempting to secure node $node", $status;
 798       } else {
 799         error "Unknown error has occurred", $status;
 800       } # if
 801     } else {
 802       verbose "Node $node secured";
 803     } # if
 804   } # if
 805
 806   debug "Starting $unitType on unit $unitNbr";
 807
 808   my $cmd = "$self->{unitType} $self->{unitNbr}";
 809
 810   my $start_str         = "StaRT";
 811   my $errno_str         = "ReXeCerRoNO=\$?";
 812   my $compound_cmd      = "echo $start_str; $cmd; echo $errno_str";
 813
 814   $self->{remote} = new Expect ($compound_cmd);
 815
 816   $self->{remote}->log_user (get_debug);
 817
 818   my $result;
 819
 820   @lines = ();
 821
 822   $self->{remote}->expect (
 823     $self->{timeout},
 824
 825     [ timeout =>
 826       sub {
 827         my $exp         = shift;
 828         my $before      = $exp->before;
 829         my $after       = $exp->after;
 830         push @lines, "$cmd timed out";
 831         $result = -1;
 832       }
 833     ],
 834
 835     [ qr "$start_str",
 836       sub {
 837         exp_continue;
 838       }
 839     ],
 840
 841     [ qr "$errno_str",
 842       sub {
 843         my $exp         = shift;
 844         my $before      = $exp->before;
 845         my $after       = $exp->after;
 846
 847         if ($after =~ /(\d+)/) {
 848           $status = $1;
 849         } # if
 850
 851         my @output = split /(\n\r)/, $before;
 852
 853         foreach (@output) {
 854           chomp;
 855           chop if /\r$/;
 856           last if /$errno_str=/;
 857           next if /^$/;
 858           push @lines, $_;
 859         } # foreach
 860
 861         exp_continue;
 862       }
 863     ],
 864
 865     [ $self->{prompt},
 866       sub {
 867         debug "Hit prompt";
 868       }
 869     ],
 870   );
 871
 872   return join "\n", @lines if $status != 0;
 873
 874   # Set prompt to something distinctive
 875   $self->{prompt}       = "\@\@\@";
 876   $cmd                  = "export PS1=$self->{prompt}\n";
 877
 878   $self->{remote}->send ($cmd);
 879
 880   $self->{remote}->expect (
 881     $self->{timeout},
 882
 883     [ timeout =>
 884       sub {
 885         $result = "$cmd timed out";
 886       }
 887     ],
 888
 889     [ "^$self->{prompt}",
 890       sub {
 891         debug "Hit prompt";
 892       }
 893     ],
 894   );
 895
 896   return $result if $result;
 897
 898   # Set TM500_VIEW if passed in
 899   if ($tm500) {
 900     $cmd = "export TM500_VIEW=$tm500\n";
 901
 902     $self->{remote}->send ($cmd);
 903
 904     $self->{remote}->expect (
 905       $self->{timeout},
 906
 907       [ timeout =>
 908         sub {
 909           $result = "$cmd timed out";
 910         }
 911       ],
 912
 913       [ "^$self->{prompt}",
 914         sub {
 915           debug "Hit prompt";
 916         }
 917       ],
 918     );
 919
 920     return $result if $result;
 921   } # if
 922
 923   # Set NMS_VIEW if passed in
 924   if ($nms) {
 925     $cmd = "export NMS_VIEW=$nms\n";
 926
 927     $self->{remote}->send ($cmd);
 928
 929     $self->{remote}->expect (
 930       $self->{timeout},
 931
 932       [ timeout =>
 933         sub {
 934           $result = "$cmd timed out";
 935         }
 936       ],
 937
 938       [ "^$self->{prompt}",
 939         sub {
 940           debug "Hit prompt";
 941         }
 942       ],
 943     );
 944
 945     return $result if $result;
 946   } # if
 947
 948   # Set FEATURE if passed in
 949   if ($feature) {
 950     $cmd = "export FEATURE=$feature\n";
 951
 952     $self->{remote}->send ($cmd);
 953
 954     $self->{remote}->expect (
 955       $self->{timeout},
 956
 957       [ timeout =>
 958         sub {
 959           $result = "$cmd timed out";
 960         }
 961       ],
 962
 963       [ "^$self->{prompt}",
 964         sub {
 965           debug "Hit prompt";
 966         }
 967       ],
 968     );
 969
 970     return $result if $result;
 971   } # if
 972
 973   debug "Starting EAST CLI in view $self->{view} on $self->{unitType}$self->{unitNbr}";
 974
 975   $cmd          = "start_east_auto $self->{view} $self->{unitType}$self->{unitNbr}";
 976   $compound_cmd = "echo $start_str; $cmd; echo $errno_str";
 977
 978   my $attempts = 0;
 979
 980   $self->{remote}->send ("$compound_cmd\n");
 981
 982   $self->{remote}->expect (
 983     $self->{timeout},
 984
 985     [ timeout =>
 986       sub {
 987         push @lines, "$cmd timed out";
 988         $status = -1;
 989       }
 990     ],
 991
 992     [ qr "$start_str",
 993       sub {
 994         exp_continue;
 995       }
 996     ],
 997
 998     [ qr "$errno_str",
 999       sub {
1000         my $exp         = shift;
1001         my $before      = $exp->before;
1002         my $after       = $exp->after;
1003
1004         if ($after =~ /(\d+)/) {
1005           $status = $1;
1006         } # if
1007
1008         my @output = split /(\n\r)/, $before;
1009
1010         foreach (@output) {
1011           chomp;
1012           chop if /\r$/;
1013           last if /$errno_str=/;
1014           next if /^$/;
1015           push @lines, $_;
1016         } # foreach
1017
1018         exp_continue;
1019       }
1020     ],
1021
1022     [ $self->{prompt},
1023       sub {
1024         debug "Hit prompt";
1025       }
1026     ],
1027   );
1028
1029   unless ($status == 0) {
1030     return "Unable to execute $cmd" . join "\n", @lines;
1031   } else {
1032     return $self->connected;
1033   } # if
1034 } # connect
1035
1036 ############################################################################
1037 #
1038 # eastUsage:    Displays East command options
1039 #
1040 # Parms:
1041 #   msg:        Usage message
1042 #
1043 # Returns:      1 for failure
1044 #
1045 ############################################################################
1046 sub eastUsage (;$) {
1047   my ($msg) = @_;
1048
1049   my $usage = "ERROR: $msg\n\n" if $msg;
1050
1051   $usage .= <<END;
1052 Usage: East::exec (<test class> <testname> <opts>)
1053
1054 Where <opts>:
1055
1056 \t[-activecalls <n>]
1057 \t[-displaylevel <n>]
1058 \t[-executionlevel <n>]
1059 \t[-loglevel <n>]
1060 \t[-mode <admin|local>]
1061 \t[-p <property=value>]
1062 \t[-runnerid <id>]
1063 \t[-testbed <name>]
1064 \t[-testenvironment <testenvironmentname>]
1065 \t[-timeout <n>]
1066 \t[-pause <n>]
1067
1068   -timeout <n>          Specifies the timeout for this test's execution.
1069                         If negative the test will be placed in the
1070                         background. No result is recovered from
1071                         background tests nor are any logfiles analysed
1072                         or stored. If positive then this sets the
1073                         timeout period for this test in seconds.
1074
1075   -pause <n>            Used in conjunction with -timeout. If test is
1076                         backgrounded then $FindBin::Script will wait
1077                         pause seconds before returning control from
1078                         this test. This allows the backgrounded test
1079                         time to start.
1080
1081   -name <name>          Names a test. Used in conditional execution.
1082
1083   -if (<name> <status>) Run this test if the named test returned <status>
1084                         where <status> is one of
1085
1086                           . Success
1087                           . Failure
1088                           . In Progress
1089                           . Timed out
1090                           . Failed to execute
1091                           . Rendezvous
1092                           . Failed to rendezvous
1093
1094 Note: -flag is supported by setting the -timeout appropriately. Setting
1095 timeout <= 0 will result in -flag NOT being specified. Setting timeout
1096 > 0 will result in -flag being specified.
1097
1098 Also -run is always set. After all, we're automation here! :-)
1099
1100 For other options see "Command Line in EAST" for more info.
1101 END
1102
1103   display $usage;
1104
1105   return 1 if $msg;
1106 } # easeUsage
1107
1108 ############################################################################
1109 #
1110 # exec:         Executes a test remotely on East.
1111 #
1112 # Parms:
1113 #   opts        A reference to a hash of options
1114 #   results     A reference to a hash of execution results
1115 #
1116 # Note: $opts{timeout} can be set to the nNumber of seconds to wait
1117 # for test to finish. Default: DEFAULT_TIMEOUT seconds. Set to 0 to
1118 # indicate to wait forever. Note that timeout can be set per
1119 # individual exec of a test case or set view setTimeout for all future
1120 # test exec's or obtained via getTimeout.
1121 #
1122 # Returns:      0 for success, otherwise failure
1123 #
1124 ############################################################################
1125 sub exec ($$) {
1126   my ($self, $opts, $results) = @_;
1127
1128   my $testResult;
1129
1130   $self->{class} = lc $$opts{class};
1131
1132   # The log class is special - It means run rantvl - so we handled it
1133   # differently here and then return quickly.
1134   if ($self->{class} eq "log") {
1135     # You'd think that /prj/muosran/SWIT/tools/bin would be in pswit's
1136     # path...
1137     my $cmd = "/prj/muosran/SWIT/tools/bin/$$opts{test}";
1138
1139     # Add unit and number
1140     $cmd .= " -$self->{unitType} $self->{unitNbr}";
1141
1142     # Add flag to get pid
1143     $cmd .= " -pid";
1144
1145     # Compose -logpath
1146     $cmd .= " -logpath $self->{saveTo}";
1147
1148     # Now start up rantvl
1149     my ($status, $msg) = $self->rantvl ($cmd);
1150
1151     # Status is reversed here. The rantvl subroutine returns the pid
1152     # of the rantvl process for success - 0 for failure. So we flip
1153     # the boolean here.
1154     return !$status, $msg;
1155   } elsif ($self->{class} eq "shell") {
1156     # The shell class is also special. Here we execute any arbitrary
1157     # shell command. Initially this has been implemented simply
1158     # because of a request to be able to pause between test steps
1159     # (e.g. sleep 10) but it was decided to make this pretty general
1160     # so any shell command is acceptable. Note we do not evaluate the
1161     # result of the execution or at least it does not influence the
1162     # status of the test at this time.
1163     my ($status, @lines) = $self->shell ($$opts{test});
1164
1165     if ($status == 0) {
1166       return $status, "Success";
1167     } else {
1168       if (scalar @lines == 0) {
1169         return $status, "Unknown error occurred while executing $$opts{test}";
1170       } else {
1171         return $status, join "\n", @lines;
1172       } # if
1173     } # if
1174   } elsif ($self->{class} eq "manual") {
1175     # The manual class will be similiar to the shell class except
1176     # that its intent is to provide an environment for the user
1177     # to run any number of manual tests and then return to rantest
1178
1179     # For the user's convenience - put $logpath into the environment
1180     $ENV{LOGPATH} = LOGBASE . "/$self->{saveTo}";
1181
1182     display "Perform your manual tests - type exit when finished";
1183
1184     # Now run the user's shell
1185     system ($ENV{SHELL});
1186
1187     print "Did your tests complete successfully? (y/N) ";
1188
1189     my $response = <STDIN>;
1190
1191     if ($response =~ /y/i) {
1192       return 0, "Success";
1193     } else {
1194       return 1, "Manual test(s) failed";
1195     } # if
1196   } # if
1197
1198   my ($status, $msg) = validTestType ($self->{class});
1199
1200   return ($status, $msg) if $status;
1201
1202   # Convert short type names -> a valid test class
1203   my $testClass = $_validTestTypes{$self->{class}};
1204
1205   my $runopts = "-log -run";
1206
1207   # Get test options. It seems GetOptions doesn't support taking input
1208   # from anything but @ARGV so we'll have to save a copy and restore
1209   # it.  See eastUsage for more info.
1210   my @savedOptions = @ARGV;
1211
1212   @ARGV = stackOptions $$opts{test};
1213
1214   # These options should be reset and not linger from one test to the
1215   # next.
1216   undef $$opts{if};
1217   undef $$opts{name};
1218   undef $$opts{rendezvous};
1219   undef $$opts{timeout};
1220
1221   # Default testbed to type & unit #
1222   $$opts{testbed} = "$self->{unitType}$self->{unitNbr}";
1223
1224   $status = GetOptions (
1225     $opts,
1226     "activecalls=i",
1227     "displaylevel=i",
1228     "executionlevel=i",
1229     "loglevel=i",
1230     "mode=s",
1231     "p=s",
1232     "pause=i",
1233     "runnerid=s",
1234     "testbed=s",
1235     "testenvironment=s",
1236     "timeout=i",
1237     "name=s",
1238     "if=s",
1239     "rendezvous=s",
1240   );
1241
1242   if (!$status) {
1243     $msg = "Unknown option";
1244
1245     eastUsage $msg;
1246
1247     return (1, $msg);
1248   } # if
1249
1250   # Reassemble $$opts{test} after GetOptions has processed it
1251   $$opts{test}  = join " ", @ARGV;
1252   @ARGV         = @savedOptions;
1253
1254   # Check other options:
1255   if (defined $$opts{displaylevel} and
1256       ($$opts{displaylevel} < 0 or
1257        $$opts{displaylevel} > 6)) {
1258     $msg = "displaylevel must be between 0-6";
1259
1260     eastUsage $msg;
1261
1262     return (1, $msg);
1263   } # if
1264
1265   if (defined $$opts{executionlevel} and
1266       ($$opts{executionlevel} < 0 or
1267        $$opts{executionlevel} > 6)) {
1268     $msg = "executionlevel must be between 0-6";
1269
1270     eastUsage $msg;
1271
1272     return (1, $msg);
1273   } # if
1274
1275   return (1, "ERROR: Test $$opts{test} does not exist")
1276     unless $self->testExists ($testClass, $$opts{test});
1277
1278   # If run sequentially then we add the -flag that says run the test
1279   # then close the window - Odd I know... Otherwise we omit the -flag
1280   # which will cause the test to run and the window to remain up.
1281   $runopts .= " -flag" if !$$opts{timeout} || $$opts{timeout} > 0;
1282
1283   # Options that must appear in the front
1284   my $frontopts = "-name $$opts{test}";
1285   $frontopts   .= " -testbed $$opts{testbed}"                   if $$opts{testbed};
1286   $frontopts   .= " -testenvironment $$opts{testenvironment}"   if $$opts{testenvironment};
1287
1288   # Process other options
1289   $runopts .= " -activecalls $$opts{activecalls}"               if $$opts{activecalls};
1290   $runopts .= " -displaylevel $$opts{displaylevel}"             if $$opts{displaylevel};
1291   $runopts .= " -executionlevel $$opts{executionlevel}"         if $$opts{executionlevel};
1292   $runopts .= " -mode $$opts{mode}"                             if $$opts{mode};
1293   $runopts .= " -p $$opts{p}"                                   if $$opts{p};
1294   $runopts .= " -runnerid $$opts{runnerid}"                     if $$opts{runnerid};
1295
1296   my $cmd = "java $testClass $frontopts $runopts";
1297
1298   $cmd .= "&" if $$opts{timeout} && $$opts{timeout} < 0 ||
1299                  $$opts{rendezvous};
1300
1301   my $timeout = $$opts{timeout} && $$opts{timeout} > 0 ? $$opts{timeout} : $self->{timeout};
1302
1303   if ($$opts{if}) {
1304     my @components      = split " ", $$opts{if};
1305     my $testName        = shift @components;
1306     my $result          = lc (join " ", @components);
1307
1308     if ($$results{$testName} && $$results{$testName} ne $result) {
1309       $testResult = "Skipped";
1310
1311       $$results{$$opts{name}} = lc $testResult if $$opts{name};
1312
1313       return (1, $testResult);
1314     } # if
1315   } # if
1316
1317   debug "\nRunning $cmd";
1318
1319   my ($startTime, $attempts, $duration);
1320
1321   my $result = 0;
1322
1323   use constant MAX_ATTEMPTS => 4;
1324
1325   $attempts     = 0;
1326   $duration     = 60;
1327
1328   my $expectBuffer;
1329
1330   do {
1331     $startTime  = time;
1332     $attempts++;
1333
1334     $self->{remote}->send ("$cmd\n");
1335
1336     $self->{remote}->expect (
1337       $timeout,
1338
1339       [ timeout =>
1340         sub {
1341           $result = -1;
1342         }
1343       ],
1344
1345       [ $self->{prompt},
1346         sub {
1347           my $exp       = shift;
1348           my $before    = $exp->before;
1349           my $after     = $exp->after;
1350
1351           $expectBuffer = "->$before<->$after<-";
1352           debug "Hit prompt";
1353         }
1354       ],
1355     );
1356
1357     $duration = time - $startTime;
1358
1359     if ($duration < 2 and $attempts > 0) {
1360       if ($cmd !~ /&$/) {
1361         if ($$opts{file}) {
1362           LogDebug "File: $$opts{file}";
1363         } else {
1364           LogDebug "File: Not set";
1365         } # if
1366         LogDebug "That happened too quickly! Attempt #$attempts of " . MAX_ATTEMPTS . " to restart cmd (Duration: $duration)\n$cmd\n";
1367         LogDebug "Contents of expect buffer:\n$expectBuffer";
1368         warning "That happened too quickly! Attempt #$attempts of " . MAX_ATTEMPTS . " to restart cmd\n$cmd\n";
1369         display "The following is debug output:";
1370         display "-" x 80;
1371         display "Contents of expect buffer:\n$expectBuffer";
1372         display "-" x 80;
1373         display "End of debug output";
1374       } # if
1375     } # if
1376
1377     unless ($duration > 2 or $attempts >= MAX_ATTEMPTS or $cmd =~ /&$/) {
1378       LogDebug "Looping around for another try\n";
1379     } # unless
1380   } until ($duration > 2 or $attempts >= MAX_ATTEMPTS or $cmd =~ /&$/);
1381
1382   if ($result == -1) {
1383     # Timed out. Kill stuck process
1384     $self->{remote}->send ("\cC");
1385
1386     $self->{remote}->expect (
1387       $timeout,
1388
1389       [ $self->{prompt},
1390         sub {
1391           debug "Hit prompt";
1392         }
1393       ],
1394     );
1395
1396     return (-1, "Timed out");
1397   } # if
1398
1399   # If we backgrounded ourselves then there's no real status to
1400   # retrieve - we must just hope for the best.
1401   if ($cmd =~ /&$/) {
1402     # Pause to allow test to start up.
1403     my $pause = $$opts{pause} ? $$opts{pause} : 0;
1404
1405     debug "Sleeping $pause seconds";
1406     sleep $pause;
1407     debug " Gee that was refressing!";
1408
1409     if ($$opts{rendezvous}) {
1410       if ($self->rendezvous ($$opts{rendezvous}, $$opts{timeout})) {
1411         $testResult = "Unable to rendezvous";
1412
1413         $$results{$$opts{name}} = lc $testResult if $$opts{name};
1414
1415         return (1, $testResult);
1416       } else {
1417         $testResult = "Rendezvous";
1418
1419         $$results{$$opts{name}} = lc $testResult if $$opts{name};
1420
1421         return (0, $testResult);
1422       } # if
1423     } else {
1424       $testResult = "In progress";
1425
1426       $$results{$$opts{name}} = lc $testResult if $$opts{name};
1427
1428       return (0, $testResult);
1429     } # if
1430   } # if
1431
1432   ($status, $testResult) = $self->testResult ($$opts{test});
1433
1434   $$results{$$opts{name}} = lc $testResult if $$opts{name};
1435
1436   # Get TM500 version used (if any)
1437   delete $self->{tm500_version};
1438
1439   my @logLines  = $self->getLogFile;
1440   my @lines     = grep (/^Command:.*version/, @logLines);
1441
1442   if ($lines[0] && $lines[0] =~ /\-\-version\s+(.+)/) {
1443     $self->{tm500_version} = $1;
1444   } # if
1445
1446   @lines = grep (/^Simulator version is/, @logLines);
1447
1448   if ($lines[0] && $lines[0] =~ /Simulator version is\s+(.+)\./) {
1449     $self->{nms_version} = $1;
1450   } # if
1451
1452   return ($status, $testResult);
1453 } # exec
1454
1455 ############################################################################
1456 #
1457 # disconnect:   Disconnects from East simulator
1458 #
1459 # Parms:        none
1460 #
1461 # Returns:      nothing
1462 #
1463 ############################################################################
1464 sub disconnect {
1465   my ($self) = @_;
1466
1467   if ($self->{rantvl}) {
1468     # Send Control-C to terminate any processes running
1469     $self->{rantvl}->send ("\cC");
1470
1471     # Try to exit remote command
1472     $self->{rantvl}->send ("exit\n");
1473
1474     # Try a hard close
1475     $self->{rantvl}->hard_close;
1476
1477     # Let's remember that we were connected so we know in
1478     # collectLogFiles that we need to collect the rantvl log files.
1479     $self->{collectRantvl} = 1;
1480
1481     # Call destructor on Expect process
1482     undef $self->{rantvl};
1483   } # if
1484
1485   if ($self->{remote}) {
1486     # Send Control-C to terminate any processes running
1487     $self->{remote}->send ("\cC");
1488
1489     # Try to exit remote command
1490     $self->{remote}->send ("exit\n");
1491
1492     # Try a hard close
1493     $self->{remote}->hard_close;
1494
1495     # Call destructor on Expect process
1496     undef $self->{remote};
1497   } # if
1498 } # disconnect
1499
1500 ############################################################################
1501 #
1502 # getCollectLogFiles:   Gets CollectLogFiles
1503 #
1504 # Parms:                None
1505 #
1506 # Returns:              collectLogFiles setting
1507 #
1508 ############################################################################
1509 sub getCollectLogFiles () {
1510   my ($self) = @_;
1511
1512   return $self->{collectLogFiles};
1513 } # getCollectLogFiles
1514
1515 ############################################################################
1516 #
1517 # setCollectLogFiles:   Sets CollectLogFiles to notate that we need to
1518 #                       collect log files
1519 #
1520 # Parms:
1521 #   collectLogFiles:    Boolean indictating where or not to collect log
1522 #                       files
1523 #
1524 # Returns:
1525 #   Old collectLogFiles setting
1526 #
1527 ############################################################################
1528 sub setCollectLogFiles ($) {
1529   my ($self, $collectLogFiles) = @_;
1530
1531   my $old = $self->{collectLogFiles};
1532
1533   $self->{collectLogFiles} = $collectLogFiles;
1534
1535   return $old;
1536 } # setCollectLogFiles
1537
1538 ############################################################################
1539 #
1540 # setRantvlStartTime:   Sets rantvlStartTime to notate that we need to
1541 #                       collect alarms
1542 #
1543 # Parms:
1544 #   startTime:          Start time (from time())
1545 #
1546 # Returns:
1547 #   Nothing
1548 #
1549 ############################################################################
1550 sub setRantvlStartTime ($) {
1551   my ($self, $startTime) = @_;
1552
1553   $self->{rantvlStartTime} = $startTime;
1554 } # setRantvlStartTime
1555
1556 ############################################################################
1557 #
1558 # setTestCaseID:        Sets TestCaseID for later use by collectLogFiles
1559 #
1560 # Parms:                TestCaseID
1561 #
1562 # Returns:              Nothing
1563 #
1564 ############################################################################
1565 sub setTestCaseID ($) {
1566   my ($self, $testCaseID) = @_;
1567
1568   $self->{testCaseID} = $testCaseID;
1569 } # setTestCaseID
1570
1571 ############################################################################
1572 #
1573 # setSaveTo:    Sets saveTo for later use by collectLogFiles
1574 #
1575 # Parms:
1576 #   path:       Path to save things to
1577 #
1578 # Returns:      Nothing
1579 #
1580 ############################################################################
1581 sub setSaveTo ($) {
1582   my ($self, $saveTo) = @_;
1583
1584   $self->{saveTo} = $saveTo;
1585 } # setSaveTo
1586
1587 ############################################################################
1588 #
1589 # getSaveTo:    Gets saveTo
1590 #
1591 # Parms:        None
1592 #
1593 # Returns:      saveTo path
1594 #
1595 ############################################################################
1596 sub getSaveTo ($) {
1597   my ($self) = @_;
1598
1599   return $self->{saveTo};
1600 } # getSaveTo
1601
1602 ############################################################################
1603 #
1604 # getTimeout:   Returns the timeout value for the remote execution object
1605 #               (if connected)
1606 #
1607 # Parms:        none
1608 #
1609 # Returns:      Timeout value for remote execution object, if connected, or
1610 #               undefined.
1611 #
1612 ############################################################################
1613 sub getTimeout () {
1614   my ($self) = @_;
1615
1616   return $self->{remote}->getTimeout if $self->{remote}
1617 } # getTimeout
1618
1619 ############################################################################
1620 #
1621 # setTimeout:   Sets timeout value for remote execution object for all
1622 #               subsequent exec's.
1623 #
1624 # Parms:
1625 #   timeout:    new timeout value
1626 #
1627 # Returns:      Old timeout value (if previously connected)
1628 #
1629 ############################################################################
1630 sub setTimeout ($) {
1631   my ($self, $timeout) = @_;
1632
1633   return $self->{remote}->setTimeout ($timeout) if $self->{remote};
1634 } # setTimeout
1635
1636 ############################################################################
1637 #
1638 # _checkOutElement:     Checks out, or creates initial version of the passed
1639 #                       in file into Clearcase
1640 #
1641 # Parms:
1642 #   file:               Name of file to checkout (mkelem)
1643 #
1644 # Returns:              0 if successful - non-zero if unsuccessful
1645 #
1646 ############################################################################
1647 sub _checkOutElement ($;$) {
1648   my ($file, $eltype) = @_;
1649
1650   my $parentDir = dirname $file;
1651
1652   my ($status, @lines);
1653
1654   # If the file already exists attempt to check it out
1655   if (-f $file) {
1656     # Assuming a snapshot view so run update
1657     ($status, @lines) = Execute CLEARTOOL . " update -log /dev/null $file 2>&1";
1658
1659     $status >>= 8;
1660
1661     error ("Unable to update view (Errno: $status)\n" . join ("\n", @lines), 1)
1662       unless $status == 0;
1663
1664     $status >>= 8;
1665
1666     ($status, @lines) = Execute CLEARTOOL . " checkout -nc $file 2>&1";
1667
1668     $status >>= 8;
1669
1670     error ("Unable to checkout $file (Errno: $status)\n" . join ("\n", @lines), 1)
1671       unless $status == 0;
1672   } else {
1673     ($status, @lines) = Execute CLEARTOOL . " checkout -nc $parentDir 2>&1";
1674
1675     $status >>= 8;
1676
1677     error ("Unable to checkout parent directory $parentDir (Errno: $status)\n" . join ("\n", @lines), 1)
1678       unless $status == 0;
1679
1680     # set eltype if passed
1681     my $eltypeParm = $eltype ? "-eltype $eltype" : "";
1682
1683     # create the new element
1684     ($status, @lines) = Execute CLEARTOOL . " mkelem $eltypeParm -nc $file 2>&1";
1685
1686     $status >>= 8;
1687
1688     error ("Unable to mkelem $file (Errno: $status)\n" . join ("\n", @lines), 1)
1689       unless $status == 0;
1690
1691     # Check in parent directory so we don't have to worry about it later
1692     ($status, @lines) = Execute CLEARTOOL . " checkin -nc $parentDir 2>&1";
1693
1694     $status >>= 8;
1695
1696     error ("Unable to checkin parent directory $parentDir (Errno: $status)\n" . join ("\n", @lines), 1)
1697       unless $status == 0;
1698   } # if
1699
1700   return $status;
1701 } # _checkOutElement
1702
1703 ############################################################################
1704 #
1705 # _checkInElement:      Checks in the passed in file into Clearcase
1706 #
1707 # Parms:
1708 #   file:               Name of file to checkin
1709 #
1710 # Returns:              0 if successful - 1 if unsuccessful
1711 #
1712 ############################################################################
1713 sub _checkInElement ($) {
1714   my ($element) = @_;
1715
1716   my ($status, @lines) = Execute CLEARTOOL . " checkin -nc $element 2>&1";
1717
1718   $status >>= 8;
1719
1720   error ("Unable to checkin $element (Errno: $status)\n" . join ("\n", @lines), 1)
1721     unless $status == 0;
1722 } # _checkInElement
1723
1724 ############################################################################
1725 #
1726 # _mkDirElement:        Creates a directory element in Clearcase
1727 #
1728 # Parms:
1729 #   dir:                Name of the directory to mkelem
1730 #
1731 # Returns:              0 if successful - 1 if unsuccessful
1732 #
1733 ############################################################################
1734 sub _mkDirElement ($) {
1735   my ($dir) = @_;
1736
1737   return 0 if -d $dir;
1738
1739   my $parentDir = dirname $dir;
1740
1741   my ($status, @lines) = Execute CLEARTOOL . " checkout -nc $parentDir 2>&1";
1742
1743   $status >>= 8;
1744
1745   error ("Unable to checkout parent directory $parentDir (Errno: $status)\n" . join ("\n", @lines), 1)
1746     unless $status == 0;
1747
1748   eval { mkpath $dir };
1749
1750   error "Unable to mkpath $dir\n$@", 1 if $@;
1751
1752   ($status, @lines) = Execute CLEARTOOL . " mkelem -nc -nco $dir 2>&1";
1753
1754   $status >>= 8;
1755
1756   error ("Unable to mkdir $dir (Errno: $status)\n" . join ("\n", @lines), 1)
1757     unless $status == 0;
1758
1759   return _checkInElement $parentDir;
1760 } # _mkDirElement
1761
1762 ############################################################################
1763 #
1764 # _makeTar:     Creates a tarfile
1765 #
1766 # Parms:
1767 #   file:       Name of tarfile to create
1768 #   path:       Path to use in the tarfile
1769 #   files:      Files to tar up
1770 #
1771 # Returns:      0 if successful - 1 if unsuccessful
1772 #
1773 ############################################################################
1774 sub _makeTar ($;$$) {
1775   my ($file, $path, $files) = @_;
1776
1777   $path = "." unless $path;
1778
1779   eval { mkpath $path };
1780
1781   error "Unable to mkpath $path\n$@", 1 if $@;
1782
1783   my ($status, @lines) = Execute "tar -czf $file -C $path $files";
1784
1785   $status >>= 8;
1786
1787   error ("Unable to create tarfile $file (Errno: $status)\n" . join ("\n", @lines), 1)
1788     unless $status == 0
1789 } # _makeTar
1790
1791 ############################################################################
1792 #
1793 # makeBaselinesReadme   Creates a baselines.readme file
1794 #
1795 # Parms:
1796 #   file:               Name of file to create
1797 #
1798 # Returns:              0 if successful - 1 if unsuccessful
1799 #
1800 ############################################################################
1801 sub makeBaselinesReadme ($) {
1802   my ($self, $file) = @_;
1803
1804   open FILE, ">$file"
1805     or error "Unable to open $file - $!", return 1;
1806
1807   my ($status, @lines) = Execute CLEARTOOL . " lsstream -fmt \"\%[found_bls]p\" -view $self->{view}";
1808
1809   $status >>= 8;
1810
1811   error ("Unable to get baselines (Errno: $status)\n" . join ("\n", @lines), 1)
1812     unless $status == 0;
1813
1814   print FILE "$_\n" foreach (split (" ", $lines[0]));
1815
1816   close FILE;
1817
1818   return 0;
1819 } # makeBaselinesReadme
1820
1821 ############################################################################
1822 #
1823 # fixUpLogs:    Fix up RNC log files (hotfix)
1824 #
1825 # Parms:        none
1826 #
1827 # Returns:      0 if successful - 1 if unsuccessful
1828 #
1829 ############################################################################
1830 sub fixUpLogs () {
1831   my ($self) = @_;
1832
1833   my ($status, @lines);
1834
1835   # Copy over the necessary log files
1836   my $file      = $self->{unitType} eq "rbs"
1837                 ? "rnc_aal5.log"
1838                 : "nodeb_aal5_utran.log";
1839   my $from      = LOGBASE . "/$self->{saveTo}/EASTLogs/Server_Logs/$file";
1840   my $to        = "/tmp/$file.$$";
1841   my $eastfile  = $to;
1842
1843   unless (-f $from) {
1844     error "Unable to find $file file";
1845     return 1;
1846   } # unless
1847
1848   my $cmd = "scp -q $from " . RANUSER . "\@" . RANHOST . ":$to";
1849
1850   ($status, @lines) = Execute $cmd;
1851
1852   $status >>= 8;
1853
1854   if ($status != 0) {
1855     error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1856     return $status;
1857   } # if
1858
1859   my $rnclog = "RNCLog.txt";
1860
1861   $file = $self->{unitType} eq "rbs"
1862         ? "RBSLog.txt"
1863         : "RNCLog.txt";
1864   $from = LOGBASE . "/$self->{saveTo}/Rantvl/$file";
1865   $to   = "/tmp/$file.$$";
1866
1867   my $logfile = $to;
1868
1869   unless (-f $from) {
1870     error "Unable to find $file file";
1871     return 1;
1872   } # unless
1873
1874   $cmd = "scp -q $from " . RANUSER . "\@" . RANHOST . ":$to";
1875
1876   ($status, @lines) = Execute $cmd;
1877
1878   $status >>= 8;
1879
1880   if ($status != 0) {
1881     error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1882     return $status;
1883   } # if
1884
1885   $status = rename $from, "$from.orig";
1886
1887   unless ($status) {
1888     error "Unable to rename $from -> $from.orig";
1889     return 1;
1890   } # unless
1891
1892   (my $buildNbr) = $self->{ran_version} =~ /.*-(.*)/;
1893
1894   $cmd  = "/prj/muosran/SWIT/tools/bin/mergeEAST2RNC.pl ";
1895   $cmd .= "-log $logfile -east $eastfile -out $logfile.tmp -build $buildNbr";
1896
1897   @lines = $self->{msh}->exec ($cmd);
1898   $status = $self->{msh}->status;
1899
1900   if ($status != 0) {
1901     error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1902     return $status;
1903   } # if
1904
1905   $cmd = "scp -q " . RANUSER . "\@" . RANHOST . ":$logfile.tmp $from";
1906
1907   ($status, @lines) = Execute $cmd;
1908
1909   $status >>= 8;
1910
1911   if ($status != 0) {
1912     error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1913     return $status;
1914   } # if
1915
1916   $cmd = "rm -f $eastfile $logfile $logfile.tmp";
1917
1918   ($status, @lines) = $self->{msh}->exec ($cmd);
1919   $status = $self->{msh}->status;
1920
1921   if ($status != 0) {
1922     error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1923   } # if
1924
1925   return $status;
1926 } # fixUpLogs
1927
1928 ############################################################################
1929 #
1930 # collectExtendedLogfiles:      Scours an East logfile for extended logfiles
1931 #                               to collect. Extended logfiles are marked in
1932 #                               the East logfile.
1933 #
1934 # Collection of TM500, NMS and CDR extended logfiles:
1935 #
1936 # Look for other logs. Other logs are logs like those produced by TM500 and
1937 # NMS and CDR. They are noted in the main log file in the format of:
1938 #
1939 #       [LOG]
1940 #       <type> <IP Address> <Logfile>
1941 #       <type> <IP Address> <Logfile>
1942 #       ...
1943 #       [/LOG]
1944 #
1945 # Where:
1946 #
1947 #       <type>:         TM500|NMS|CDR
1948 #       <IP Address>    IP address of the machine (why they don't use names...)
1949 #       <Logfile>       Windows path like:
1950 #
1951 #                       C:\TM500\TestLogs\MDL.cmd.2008.04.02-10.24.27.log
1952 #
1953 # We need to take the above and formulate an scp command like:
1954 #
1955 #       scp -q pswit@<IP Address>:<Logfile> TM500Logs
1956 #
1957 # Note that pswit is a generic user and we have previously configured
1958 # pre-shared ssh access for all users to pswit@<rantm501-rantm507> and
1959 # <Logfile> has been transformed from "\"'s -> "/"'s because "/"'s also work
1960 # and work better!
1961 #
1962 # Parms:                none
1963 #
1964 # Returns:              0 if successful - 1 if unsuccessful
1965 #
1966 ############################################################################
1967 sub collectExtendedLogFiles () {
1968   my ($self) = @_;
1969
1970   # Create @tarfiles if it doesn't already exist
1971   unless ($self->{tarfiles}) {
1972     $self->{tarfiles} = ();
1973   } # unless
1974
1975   my $logpath   = LOGBASE . "/$self->{saveTo}";
1976   my $tm500dir  = "$logpath/TM500Logs";
1977   my $nmsdir    = "$logpath/NMSLogs";
1978   my $cdrdir    = "$logpath/CDRLogs";
1979
1980   my @logLines = $self->getLogFile;
1981
1982   my $tm500Found        = 0;
1983   my $nmsFound          = 0;
1984   my $cdrFound          = 0;
1985   my $hitlog            = 0;
1986
1987   foreach (@logLines) {
1988     chomp;
1989
1990     if (/^\[LOG\]/) {
1991       $hitlog = 1;
1992       next;
1993     } elsif (/^\[\/LOG\]/) {
1994       $hitlog = 0;
1995     } else {
1996       if ($hitlog == 1 and /(\S+)\s+(\S+)\s+(\S+)/) {
1997         my ($type, $dir, $ip, $logfile);
1998
1999         if ($1 eq "TM500") {
2000           $tm500Found   = 1;
2001           $dir          = $tm500dir;
2002         } elsif ($1 eq "NMS") {
2003           $nmsFound     = 1;
2004           $dir          = $nmsdir;
2005         } elsif ($1 eq "CDR") {
2006           $cdrFound     = 1;
2007           $dir          = $cdrdir;
2008         } # if
2009
2010         $type           = $1;
2011         $ip             = $2;
2012         $logfile        = $3;
2013         $logfile        =~ s/\\/\//g;
2014
2015         unless (-d $dir) {
2016           eval { mkpath $dir };
2017
2018           error "Unable to mkpath $dir\n$@", 1 if $@;
2019         } # unless
2020
2021         # scp is failing for some strange reason for NMS. The
2022         # following code is to try to help figure out what's going on
2023         # when scp fails.
2024
2025         # Only do this for NMS
2026         if ($type eq "NMS") {
2027           # Does the $logfile exist to start with?
2028           my $cmd = "ssh pswit\@$ip ls $logfile";
2029
2030           my ($status, @lines) = Execute $cmd;
2031
2032           $status >>= 8;
2033
2034           LogDebug "WARNING: From file, $logfile, does not exist on $ip" if $status != 0;
2035         } # if
2036
2037         my $cmd = "scp -q pswit\@$ip:$logfile $dir";
2038
2039         my ($status, @lines) = Execute $cmd;
2040
2041         $status >>= 8;
2042
2043         if ($type eq "NMS") {
2044           if ($status != 0) {
2045             LogDebug "Unable to execute $cmd";
2046             LogDebug "Lines contains:";
2047             LogDebug $_ foreach (@lines);
2048
2049             my $i = 0;
2050
2051             do {
2052               sleep 1;
2053
2054               ($status, @lines) = Execute $cmd;
2055
2056               $status >>= 8;
2057               $i++;
2058             } until ($status == 0 or $i >= 2);
2059           } # if
2060         } # if
2061
2062         error ("Unable to scp logfile $logfile (Errno: $status)\n$cmd\n" . join ("\n", @lines))
2063           unless $status == 0;
2064       } # if
2065     } # if
2066   } # foreach
2067
2068   if ($tm500Found) {
2069     push @{$self->{tarfiles}}, {
2070       type      => "TM500",
2071       tarfile   => "TM500Logs.tgz",
2072       path      => $tm500dir,
2073       files     => ".",
2074     };
2075   } # if
2076
2077   if ($nmsFound) {
2078     push @{$self->{tarfiles}}, {
2079       type      => "NMS",
2080       tarfile   => "NMSLogs.tgz",
2081       path      => $nmsdir,
2082       files     => ".",
2083     };
2084   } # if
2085
2086   if ($cdrFound) {
2087     push @{$self->{tarfiles}}, {
2088       type      => "CDR",
2089       tarfile   => "CDRLogs.tgz",
2090       path      => $cdrdir,
2091       files     => ".",
2092     };
2093   } # if
2094 } # collectExtendedLogFiles
2095
2096 ############################################################################
2097 #
2098 # createPCScannerLogs:  Creates PC Scanner logs  using msh
2099 #
2100 # Parms:                none
2101 #
2102 # Returns:              0 if successful - 1 if unsuccessful
2103 #
2104 ############################################################################
2105 sub createPCScannerLogs ($) {
2106   my ($self, $node) = @_;
2107
2108   my ($status, @lines);
2109
2110   # Determine how long this test was running
2111   my $duration  = time - $self->{rantvlStartTime};
2112
2113   # Kind of an odd algorithim: Compute to the nearest 1/4 hour
2114   my $hours     = int ($duration / (60 * 60));
2115   my $fractions = int (($duration % (60 * 60)) / 60);
2116
2117   if ($fractions < 15) {
2118     $fractions = 25;
2119   } elsif ($fractions < 30) {
2120     $fractions = 5;
2121   } elsif ($fractions < 45) {
2122     $fractions = 75
2123   } else {
2124     $fractions = 0;
2125     $hours++;
2126   } # if
2127
2128   my $prompt    = uc $node . '.*>';
2129   my $timeout   = 30;
2130   my $noFiles   = 0;
2131
2132   verbose_nolf "Collecting PC Scanner logs from the last $hours.$fractions hours...";
2133
2134   my $cmd = "ssh -t " . RANUSER . "@" . RANHOST. " /prj/muosran/SWIT/moshell/moshell $node";
2135   my $msh = new Expect ($cmd);
2136
2137   error "Unable to start msh", 1 unless $msh;
2138
2139   $msh->log_user (get_debug);
2140
2141   $msh->expect (
2142     $timeout,
2143
2144     [ qr "$prompt",
2145       sub {
2146         debug "Hit prompt!";
2147       }
2148     ],
2149
2150     [ timeout =>
2151       sub {
2152         error "Timed out looking for moshell prompt", 1;
2153       }
2154     ],
2155   );
2156
2157   $cmd = "pmr -m $hours.$fractions";
2158
2159   $msh->send ("$cmd\n");
2160
2161   $msh->expect (
2162     $timeout,
2163
2164     [ qr "Your Choice: " ],
2165
2166     [ qr "No xml files to parse !",
2167       sub {
2168         $noFiles = 1;
2169       }
2170     ],
2171
2172     [ timeout =>
2173       sub {
2174         error "Timed out looking for \"Your Choice:\"", 1;
2175       }
2176     ],
2177   );
2178
2179   if ($noFiles) {
2180     verbose " No logs to process - skipping";
2181     return -1;
2182   } # if
2183
2184   $cmd = "x";
2185
2186   $msh->send ("$cmd\n");
2187
2188   $msh->expect (
2189     $timeout,
2190
2191     [ qr "$prompt" ],
2192
2193     [ timeout =>
2194       sub {
2195         error "Timed out looking for moshell prompt", 1;
2196       }
2197     ],
2198   );
2199
2200   my $proxy_id;
2201
2202   $cmd = "pst";
2203
2204   $msh->send ("$cmd\n");
2205
2206   $msh->expect (
2207     $timeout,
2208
2209     [ qr "$prompt",
2210       sub {
2211         my $exp = shift;
2212
2213         my $before = $exp->before;
2214
2215         if ($before =~ /(\d+).*RNCScanner/) {
2216           $proxy_id = $1;
2217         } # if
2218       }
2219     ],
2220
2221     [ timeout =>
2222       sub {
2223         error "Timed out looking for moshell prompt", 1;
2224       }
2225     ],
2226   );
2227
2228   unless ($proxy_id) {
2229     error "Unable to find proxy_id";
2230     return 1;
2231   } # unless
2232
2233   $cmd = "pbl $proxy_id";
2234
2235   $msh->send ("$cmd\n");
2236
2237   $msh->expect (
2238     $timeout,
2239
2240     [ qr "$prompt" ],
2241
2242     [ timeout =>
2243       sub {
2244         error "Timed out looking for moshell prompt", 1;
2245       }
2246     ],
2247   );
2248
2249   return 0;
2250 } # createPCScannerLogs
2251
2252 ############################################################################
2253 #
2254 # collectRanTVLLogs:    Collect rantvl logs
2255 #
2256 # Parms:                $logPath: Path to logfiles
2257 #
2258 # Returns:              0 if successful - 1 if unsuccessful
2259 #
2260 ############################################################################
2261 sub collectRanTVLLogs ($) {
2262   my ($self, $logpath) = @_;
2263
2264   return unless ($self->{collectRantvl});
2265
2266   my ($status, @lines);
2267
2268   # SIMCQ00007155: We now have unitNbr's like '3m2' which are really
2269   # the same machine as as ranrnc03. While ranrnc03m2 is DNS aliased
2270   # to ranrnc03, it causes problems because we assume that that will
2271   # be the prompt for moshell (see createPCScannerLogs). The following
2272   # substr uses only the first character of unitNbr which makes the
2273   # assumption that unitNbr 3 (ranrnc03) is the same machine as
2274   # unitNbr 3m2 (ranrnc03m2).
2275   my $DUTHost   = "ran" . $self->{unitType} . "0" . substr ($self->{unitNbr}, 0, 1);
2276
2277   if ($self->{unitType} eq "rnc") {
2278     # Create PC Scanner logs
2279     $status = $self->createPCScannerLogs ($DUTHost);
2280
2281     unless ($status == 0) {
2282       warning "Unable to create PCScannerLogs" if $status > 0;
2283     } else {
2284       verbose " done";
2285
2286       # Move files to testlogs
2287       my $from  = "~" . RANUSER . "/moshell_logfiles/logs_moshell/pmfiles/$DUTHost.gddsi.com/pm";
2288       my $to    = "$logpath/PCScannerLogs";
2289
2290       # Create the remote directory
2291       my $cmd = "mkdir -p $to; chmod g+w $to";
2292
2293       ($status, @lines) = Execute ($cmd);
2294
2295       $status >>= 8;
2296
2297       error ("Unable to execute $cmd\n" . join ("\n", @lines), 1)
2298         if $status != 0;
2299
2300       # Copy files
2301       $cmd = "scp -qrp " . RANUSER . "@" . RANHOST . ":$from/* $to";
2302
2303       ($status, @lines) = Execute $cmd;
2304
2305       $status >>= 8;
2306
2307       error ("Unable to execute $cmd\n" . join ("\n", @lines), 1)
2308         if $status != 0;
2309
2310       $status = $self->{msh}->exec ("rm -rf $from/*");
2311       @lines  = $self->{msh}->lines;
2312
2313       error ("Unable to execute $cmd\n" . join ("\n", @lines), 1)
2314         if $status != 0;
2315
2316       push @{$self->{tarfiles}}, {
2317         type            => "PCScanner",
2318         tarfile         => "PCScannerLogs.tgz",
2319         path            => $to,
2320         files           => ".",
2321       };
2322     } # if
2323   } # if
2324
2325   my $from      = RANTVL_LOGBASE . "/$self->{saveTo}";
2326   my $to        = "$logpath/Rantvl";
2327
2328   eval { mkpath $to };
2329
2330   error "Unable to mkpath $to\n$@", 1 if $@;
2331
2332   # Get any alarms
2333   if ($self->{rantvlStartTime}) {
2334     use POSIX qw (ceil);
2335
2336     my $minutes = ceil ((time - $self->{rantvlStartTime}) / 60);
2337     my $DUTHost = "ran" . $self->{unitType} . "0" . $self->{unitNbr};
2338     my $logfile = $to . (($self->{unitType} eq "rnc") ? "/RNCAlarms.txt" : "/RBSAlarms.txt");
2339     my $cmd     = "domsh -v -q -h $DUTHost -m \"lgar ${minutes}m\" > $logfile";
2340
2341     my ($status, @lines) = Execute $cmd;
2342
2343     $status >>= 8;
2344
2345     error ("Unable to execute $cmd\n" . join "\n", @lines) if $status != 0;
2346   } # if
2347
2348   # Copy files
2349   my $cmd = "scp -rpq " . RANUSER . "\@" . RANHOST . ":$from/* $to";
2350
2351   ($status, @lines) = Execute $cmd;
2352
2353   $status >>= 8;
2354
2355   return $status if $status;
2356
2357   verbose_nolf ".";
2358
2359   # Removed copies
2360   $cmd = "ssh " . RANUSER . "\@" . RANHOST . " rm -rf $from";
2361
2362   ($status, @lines) = Execute $cmd;
2363
2364   $status >>= 8;
2365
2366   return $status if $status;
2367
2368   verbose_nolf ".";
2369
2370   push @{$self->{tarfiles}}, {
2371     type                => "RANTVL",
2372     tarfile             => "RANTVLLogs.tgz",
2373     path                => $to,
2374     files               => ".",
2375   };
2376
2377   return 0;
2378 } # collectRanTVLLogs
2379
2380 ############################################################################
2381 #
2382 # collectLogfiles:      Saves the logfiles for an EAST test run
2383 #
2384 # Parms:                none
2385 #
2386 # Returns:              0 if successful - 1 if unsuccessful
2387 #
2388 ############################################################################
2389 sub collectLogFiles (;$$) {
2390   my ($self, $testErrors, $checkin_on_error) = @_;
2391
2392   return 0 unless $self->{collectLogFiles};
2393
2394   $testErrors       ||= 0;
2395   $checkin_on_error ||= 1;
2396
2397   $self->{saveTo} = "." unless $self->{saveTo};
2398
2399   my $viewPath = "$ENV{MNT_DIR}/snapshot_views/$self->{userdir}/$self->{view}";
2400
2401   # Copy relevant logs from
2402   my $eastLogBase = "$ENV{MNT_DIR}/$ENV{EAST_REL}/DUT/$self->{unitType}$self->{unitNbr}/data/logs";
2403
2404   # To here
2405   my $logpath = LOGBASE . "/$self->{saveTo}";
2406
2407   verbose "logpath=$logpath";
2408
2409   eval { mkpath "$logpath/EASTLogs" };
2410
2411   error "Unable to mkpath $logpath/EASTLogs\n$@", 1 if $@;
2412
2413   verbose "Collecting logfiles";
2414
2415   foreach ("Server_Logs", "regression", "load") {
2416     next unless -e "$eastLogBase/$_";
2417
2418     my $cmd = "cp -rp $eastLogBase/$_ $logpath/EASTLogs";
2419
2420     my ($status, @lines) = Execute $cmd;
2421
2422     $status >>= 8;
2423
2424     error "Unable to copy $eastLogBase/$_ -> $logpath/EASTLogs", 1 if $status != 0;
2425   } # foreach
2426
2427   # We always save EAST logs
2428   push @{$self->{tarfiles}}, {
2429     type        => "EAST",
2430     tarfile     => "EASTLogs.tgz",
2431     path        => "$logpath/EASTLogs",
2432     files       => ".",
2433   };
2434
2435   my $status = $self->collectRanTVLLogs ($logpath);
2436
2437   return $status if $status;
2438
2439   verbose "All logfiles collected";
2440
2441   # Report logfiles created
2442   if (get_verbose) {
2443     display "Logfiles created this run:";
2444
2445     my $cmd = "find " . LOGBASE . "/$self->{saveTo}";
2446
2447     print $_ foreach (`$cmd`);
2448   } # if
2449
2450   $self->fixUpLogs if $self->{collectRantvl};
2451
2452   # If we are "run for record" then $self->{testCaseID} should be
2453   # set. If not then we're all done and can return.
2454   unless ($self->{testCaseID}) {
2455     $self->{collectLogFiles} = 0;
2456
2457     return 0;
2458   } # unless
2459
2460   # if $checkin_on_error is not defined set it to false
2461   if ( !defined $checkin_on_error) {
2462     $checkin_on_error = "0";
2463   } # if
2464
2465   # check with user to see if they want to check in logs if errors were encountered
2466   if ( ( $testErrors > 0 ) && ( $checkin_on_error == 0 ) ) {
2467     display_nolf "Errors encountered. Do you still want to check in the log files? (y/n) ";
2468
2469     my $response = <STDIN>;
2470
2471     return 1 unless $response =~ /y/i;
2472   } # if
2473
2474   verbose_nolf "Checking in tar files for run for record"
2475     if scalar @{$self->{tarfiles}} > 0;
2476
2477   foreach (@{$self->{tarfiles}}) {
2478     my $to = "$viewPath/vobs";
2479
2480     if ($$_{type} eq "EAST") {
2481       $to .= "/simdev_log";
2482     } elsif ($$_{type} eq "TM500") {
2483       $to .= "/tm500_log";
2484     } elsif ($$_{type} eq "RANTVL" or $$_{type} eq "CDR" or $$_{type} eq "PCScanner") {
2485       $to .= "/rantest_build3_log";
2486     } elsif ($$_{type} eq "NMS") {
2487       $to .= "/nms_sim_log";
2488     } else {
2489       error "Unknown tarfile type: $$_{type}";
2490       next;
2491     } # if
2492
2493     $to .= "/$self->{testCaseID}";
2494
2495     # Create testcaseID directory if necessary
2496     _mkDirElement $to;
2497
2498     # Will create element if necessary
2499     _checkOutElement "$to/$$_{tarfile}";
2500
2501     # Remove either old tarfile or empty container. We're about to fill it.
2502     my ($status, @lines) = Execute "rm -f $to/$$_{tarfile}";
2503
2504     $status >>= 8;
2505
2506     error "Unable to remove old tarfile", 1
2507       unless $status == 0;
2508
2509     _makeTar "$to/$$_{tarfile}", $$_{path}, $$_{files};
2510
2511     # Check in the element
2512     _checkInElement "$to/$$_{tarfile}";
2513
2514     verbose_nolf ".";
2515   } # foreach
2516
2517   verbose " done"
2518     if scalar @{$self->{tarfiles}} > 0;
2519
2520   verbose_nolf "Capturing baselines.";
2521
2522   # We put baselines into here
2523   my $to = "$viewPath/vobs/rantest_build3_log/$self->{testCaseID}/baselines.readme";
2524
2525   _checkOutElement $to;
2526
2527   # Remove either old file or empty container. We're about to fill it.
2528   my @lines;
2529
2530   ($status, @lines) = Execute "rm -f $to";
2531
2532   $status >>= 8;
2533
2534   error "Unable to remove baseline.readme", 1
2535     unless $status == 0;
2536
2537   $self->makeBaselinesReadme ($to);
2538
2539   # Check in the element
2540   _checkInElement $to;
2541
2542   verbose " done";
2543
2544   $self->{collectLogFiles} = 0;
2545
2546   return 0;
2547 } # collectLogFiles
2548
2549 1;
2550
2551 =head1 NAME
2552
2553 Nethawk::East - East Object Model module
2554
2555 =head1 VERSION
2556
2557 Version 1.0 - January 17, 2008
2558
2559 =head1 DESCRIPTION
2560
2561 Encapsulates the East Simulator as an object. Methods are provided to
2562 connect, configure and run tests on an East Simulator.
2563
2564 =head1 SYNOPSIS
2565
2566 use Nethawk::East;
2567
2568 $e = new Nethawk::East;
2569
2570 =head1 METHODS
2571
2572 =head2 new (<parms>)
2573
2574 Construct a new East object. The following OO style arguments are
2575 supported:
2576
2577 Parameters:
2578
2579 =over
2580
2581 =item host:
2582
2583 Name of host to connect through. Default: raneast
2584
2585 =item username:
2586
2587 Username to connect as. Default $USER
2588
2589 =item password:
2590
2591 Password to use. Default passwordless.
2592
2593 =item debug:
2594
2595 If set then the East object will emit debugging information
2596
2597 =back
2598
2599 =head2 validTestType (type)
2600
2601 Return a status indicating if the passed in test type is valid (and an
2602 error message if not)
2603
2604 =over
2605
2606 =item testType
2607
2608 Type of test requested
2609
2610 =item Returns
2611
2612 List contains a status (0 = valid test type, 1 = invalid test type)
2613 and an optional error message.
2614
2615 =back
2616
2617 =head2 inUse ()
2618
2619 Determines if the unit of type type is in use.
2620
2621 =over
2622
2623 =item Returns undef if not in use or an error message if in use
2624
2625 =back
2626
2627 =head2 viewExists (view)
2628
2629 Determines if the view exists on the remote host
2630
2631 =over
2632
2633 =item view
2634
2635 View tag to check
2636
2637 =item Returns
2638
2639 1 if view exists - 0 otherwise
2640
2641 =back
2642
2643 =head2 testExists (type, name)
2644
2645 Determines if the named test exists for that test type
2646
2647 =over
2648
2649 =item type
2650
2651 Specifies what type of test to check
2652
2653 =item name
2654
2655 Specifies the name of the test
2656
2657 =item Returns 1 if test exists - 0 otherwise
2658
2659 =back
2660
2661 =head2 getLogFile ()
2662
2663 Returns the log in an array
2664
2665 =over
2666
2667 =item None
2668
2669 =item Returns
2670
2671 An array of lines from the log file. Note that although EAST logfiles
2672 are binary, this method first passes the file through strings(1).
2673
2674 =back
2675
2676 =head2 testResult (name)
2677
2678 Checks the test's logfile to determine the result
2679
2680 Parameters:
2681
2682 =over
2683
2684 =item name
2685
2686 Name of test
2687
2688 =item Returns
2689
2690 A status - 0 if we are able to get the results, 1 if we can't - and a
2691 message of "Success", "Failure", "Incomplete" or an error message
2692
2693 =back
2694
2695 =head2 shell (script, opts)
2696
2697 Execute a shell script returning the results.
2698
2699 Parameters:
2700
2701 =over
2702
2703 =item script
2704
2705 Script to run
2706
2707 =item opts
2708
2709 Additional options passed to script
2710
2711 =item Returns
2712
2713 $status of shell exeuction and @lines of output
2714
2715 =back
2716
2717 =head2 rantvl (cmd)
2718
2719 Start rantvl
2720
2721 Parameters:
2722
2723 =over
2724
2725 =item cmd
2726
2727 Rantvl command to execute
2728
2729 =item Returns
2730
2731 $pid of rantvl process and a message
2732
2733 =back
2734
2735 =head2 rendezvous (phrase, timeout)
2736
2737 Rendezvous with EAST process by searching the log file for a specific
2738 phrase. We will use $self->{timeout} to determine how long we are
2739 gonna wait for this phrase to appear. We will divide $self->{timeout}
2740 by 10, making 10 attempts. So with a default timeout of 180 seconds,
2741 we will try 10 times 18 seconds apart, for the phrase to appear before
2742 timing out.
2743
2744 Parameters:
2745
2746 =over
2747
2748 =item phrase
2749
2750 Phrase to search for
2751
2752 =item timeout
2753
2754 How long to time out waiting for the rendezvous
2755
2756 =item Returns
2757
2758 undef if rendezvous was successful - error message otherwise.
2759
2760 =back
2761
2762 =head2 connected ()
2763
2764 Checks to see if you're connected to EAST
2765
2766 Parameters:
2767
2768 =item None
2769
2770 =item Returns
2771
2772 undef if connected - error message otherwise
2773
2774 =back
2775
2776 =head2 connect (view, unitType, unitNbr, tm500, nms)
2777
2778 Connects to the remote East machine
2779
2780 Parameters:
2781
2782 =over
2783
2784 =item view
2785
2786 View name to set to to run the the test
2787
2788 =item unitType
2789
2790 Type of unit (rbs, rnc or east)
2791
2792 =item unitNbr
2793
2794 Number of the unit
2795
2796 =item tm500
2797
2798 Name of tm500 view (if any)
2799
2800 =item nms
2801
2802 Name of nms view (if any)
2803
2804 =item Returns
2805
2806 Undefined if connection was successful or error message if not
2807
2808 =back
2809
2810 =head2 exec (class, name, timeout)
2811
2812 Parameters:
2813
2814 =over
2815
2816 =item class
2817
2818 Specifies which class of test. Must be one of:
2819
2820  load   LoadTCRunner
2821  pool   RegressionLoadRunner
2822  tc     RegressionRunner
2823  ts     RegressionTSRunner
2824
2825 =item name
2826
2827 Name of the test. Currently this is the filename for the test.
2828
2829 =item timeout
2830
2831 (Optional) Timeout value for this command
2832
2833 =item returns status of remotely executed test.
2834
2835 =back
2836
2837 =head2 disconnect ()
2838
2839 Parameters:
2840
2841 =over
2842
2843 =item none
2844
2845 =back
2846
2847 =head2 setCollectLogFiles (collectLogFiles)
2848
2849 Sets CollectLogFiles to notate that we need to collect log files
2850
2851 Parameters:
2852
2853 =over
2854
2855 =item collectLogFiles
2856
2857 Boolean indictating where or not to collect log files
2858
2859 =item Returns
2860
2861 Old collectLogFiles setting
2862
2863 =back
2864
2865 =head setTestCaseID
2866
2867 Sets TestCaseID for later use by collectLogFiles
2868
2869 Parameters:
2870
2871 =over
2872
2873 =item TestCaseID
2874
2875 =item Returns
2876
2877 Nothing
2878
2879 =back
2880
2881 =head2 setSaveTo (path)
2882
2883 Sets saveTo for later use by collectLogFiles
2884
2885 Parameters:
2886
2887 =over
2888
2889 =item path
2890
2891 Path to save things to
2892
2893 =item Returns
2894
2895 Nothing
2896
2897 =back
2898
2899 =head2 getSaveTo ()
2900
2901 Gets saveTo
2902
2903 Parameters:
2904
2905 =over
2906
2907 =item None
2908
2909 =item Returns
2910
2911 saveTo path
2912
2913 =back
2914
2915 =head2 getTimeout ()
2916
2917 Returns the timeout value for the remote execution object (if
2918 connected)
2919
2920 Parameters
2921
2922 =over
2923
2924 =item None
2925
2926 = item Returns
2927
2928 Timeout value for remote execution object, if connected, or undefined.
2929
2930 =head2 collectLogFiles ()
2931
2932 Saves the logfiles for an EAST test run
2933
2934 Parameters:
2935
2936 =over
2937
2938 =item None
2939
2940 =item Returns
2941
2942 0 if successful - 1 if unsuccessful
2943
2944 =back
2945
2946 =head2 setTimeout (timeout)
2947
2948 Sets timeout value for remote execution object for all subsequent
2949 exec's.
2950
2951 Parameters:
2952
2953 =over
2954
2955 =item timeout
2956
2957 New timeout value
2958
2959 =item Returns
2960
2961 Old timeout value (if previously connected)
2962
2963 =head1 ALSO SEE
2964
2965 None.
2966
2967 =head1 KNOWN DEFECTS
2968
2969 None.
2970
2971 =head1 TODO
2972
2973 =over 4
2974
2975 =item ...
2976
2977 =back
2978
2979 =head1 DEVELOPERS
2980
2981 =over 4
2982
2983 =item Andrew@DeFaria.com (Original Author)
2984
2985 =item Gantry York, gantry.york@gdc4s.com (Maintainer)
2986
2987 =back
2988
2989 =head1 LICENSE & COPYRIGHT
2990
2991 Copyright (c) 2008 General Dynamics, Inc.  All Rights Reserved.