1 #############################################################################
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.
9 # Author: Andrew@DeFaria.com
11 # Copyright (c) 2008 General Dynamics
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.
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
23 ##############################################################################
27 package Nethawk::East;
34 use File::Temp qw (tempfile);
41 use SCCM::Build::Utils;
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\"";
47 use constant RANHOST => "ranray";
48 use constant RANUSER => "pswit";
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";
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'(\]\$|\] $)';
61 ############################################################################
63 ############################################################################
64 my %_validTestTypes = (
65 "load" => "LoadTCRunner",
67 "pool" => "RegressionLoadRunner",
68 "tc" => "RegressionRunner",
69 "ts" => "RegressionTSRunner",
77 open FILE, ">>/tmp/rantest.debug.log"
78 or die "Unable to open /tmp/rantest.debug.log for append - $!";
85 ############################################################################
87 # new: Instantiate a new East object
92 # Returns: New East object
94 ############################################################################
99 timeout => DEFAULT_TIMEOUT,
104 ############################################################################
106 # validTestType: Return a status indicating if the passed in
107 # test type is valid (and an error message if not)
109 # testType: Type of test requested
111 # Returns: List contains a status (0 = valid test type, 1 =
112 # invalid test type) and an optional error message.
114 ############################################################################
115 sub validTestType ($) {
118 $testType = "<undefined>" if !$testType;
120 return (0, "") if InArray (lc $testType, keys %_validTestTypes);
122 my $msg = "Type must be one of:\n\n";
124 foreach (sort keys %_validTestTypes) {
125 $msg .= " $_\t$_validTestTypes{$_}\n";
131 ############################################################################
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.
137 # Returns: List contains a status (0 = not in use, 1 = in use) and an
138 # optional error message.
140 ############################################################################
144 my $dut = "$self->{unitType}$self->{unitNbr}";
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";
152 @lines = `ls -l $lockfile1`;
154 $owner = (split /\s+/, $lines[0])[2] if $lines[0];
155 } elsif (-f $lockfile2) {
156 @lines = `ls -l $lockfile2`;
158 $owner = (split /\s+/, $lines[0])[2] if $lines[0];
163 my $owner_name = "Unknown user";
165 return "ERROR: $dut is being tested now by $owner_name.\nDo not attempt to start EAST, it could cause serious problems." if !$owner;
167 @lines = `ypmatch $owner passwd 2>&1`;
170 $owner_name = (split /:/, $lines[0])[4];
172 $owner_name = "ypmatch $owner passwd - failed";
175 if ($ENV{LOGNAME} eq $owner) {
176 return "East in use by you. Exit east using desktop button before starting again.";
178 return "$dut is being tested now by $owner_name.\nDo not attempt to start EAST, it could cause serious problems.";
182 ############################################################################
184 # viewExists: Checks to see if a remote view exists.
187 # tag: View tag to check
189 # Returns: List contains a status (0 = view does not exist, 1 = view
190 # exists) and the optional output from the lsview command.
192 ############################################################################
194 my ($self, $tag) = @_;
196 my $cmd = CLEARTOOL . " lsview $tag 2>&1";
202 ############################################################################
204 # testExists: Checks to see if a test exists
207 # type: Type of test to check (rbs, rnc or east)
210 # Returns: 0 if test exists, 1 if it doesn't.
212 ############################################################################
213 sub testExists ($$) {
214 my ($self, $type, $name) = @_;
216 return 1 unless $self->{view};
218 return 1 if $name eq "";
220 my $vobPath = "vobs/simdev/tc_data";
222 # Now compose testPath
223 my $testPath = "$ENV{MNT_DIR}/snapshot_views/$self->{userdir}/$self->{view}/$vobPath";
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";
235 return 0 if !-f $testPath;
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'`;
243 if ($? == 0 && $lines[0] =~ /(\S+)\.script$/) {
244 $self->{testName} = $1;
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;
257 ############################################################################
259 # getLogFileContents: Returns an array of the lines in the log file.
263 # Returns: Array of lines from the "logical" logfile
265 ############################################################################
266 sub getLogFileContents ($) {
267 my ($self, $logFileName) = @_;
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`;
280 error "Unable to ls -t $logFileName";
282 LogDebug "BUG CATCHER: Here are the currently running java processes\n";
283 @lines = `ps -efww | grep java | grep -v \'grep java\'`;
285 LogDebug $_ foreach (@lines);
292 # Get a list of logfiles
293 $logFileName .= "/" . $lines[0] . "/detailedlogs/*_logs_*";
296 my @logfiles = `ls $logFileName 2> /dev/null`;
300 foreach (@logfiles) {
301 # Logfiles still contain binary stuff so use strings(1)
302 my @logLines = `strings $_`;
306 push @lines, @logLines;
310 } # getLogFileContents
312 ############################################################################
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.
322 # Returns: Array of lines from the "logical" logfile
324 ############################################################################
328 # Bail out if testName not set
329 return () if !$self->{testName};
332 my $logFileName = "$ENV{MNT_DIR}/$ENV{EAST_REL}/DUT/$self->{unitType}$self->{unitNbr}/data/logs/";
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";
344 my @logfiles = `ls $logFileName 2> /dev/null`;
348 if (scalar @logfiles > 0) {
349 foreach (@logfiles) {
350 my @logLines = $self->getLogFileContents ("$logFileName/$_");
352 push @lines, @logLines;
357 } elsif ($self->{class} eq "pool") {
358 croak "Pool test type not implemented";
360 croak "Invalid test case type $self->{class} found";
363 return $self->getLogFileContents ($logFileName);
366 ############################################################################
368 # testResult: Checks the test's logfile to determine the result
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
377 ############################################################################
379 my ($self, $name) = @_;
381 my @lines = grep (/EXECUTION STATUS/, $self->getLogFile);
383 my $testResult = "Incomplete";
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 :: (.*)/) {
389 $testResult =~ s/\s+$//;
392 return (0, $testResult);
395 ############################################################################
397 # shell: Execute a shell script returning the results.
400 # script: Script to run.
401 # opts: Additional options passed to script
403 # Returns: $status of shell exeuction and @lines of output
405 ############################################################################
407 my ($self, $script, @opts) = @_;
409 my ($status, @output) = Execute ($script . join " ", @opts);
413 return ($status, @output);
416 ############################################################################
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
428 # using this function we'll get:
437 # str String of options to stack
439 # Returns: Array of options stacked with quoted strings occupying a
440 # single slot in the array.
442 # Notes: Doesn't balance quotes. Also, you can use () instead of ""
443 # (e.g. -if (condition is specified here)).
445 ############################################################################
446 sub stackOptions ($) {
453 foreach (split /\s+/, $options) {
455 if (/(\S*)[\"|\'|\)]$/) {
456 $str .= $str ? " $1" : $1;
463 $str .= $str ? " $_" : $_;
468 # Handle situation where you got only one "word"
469 if (/[\"|\'|\(](\S*)[\"\'\)]/) {
471 } elsif (/[\"|\'|\(](\S*)/) {
472 $str .= $str ? " $1" : $1;
483 ############################################################################
485 # rantvl: Start rantvl
488 # cmd: Rantvl command to execute
490 # Returns: $pid of rantvl process and a message
492 ############################################################################
494 my ($self, $cmd) = @_;
498 my $logging_started = 0;
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
504 $self->{rantvl} = new Expect ("ssh " . RANUSER . "\@" . RANHOST);
506 return (1, "Unable to connect to " . RANHOST . " as " . RANUSER)
507 unless $self->{rantvl};
509 $self->{rantvl}->log_user (get_debug);
511 $self->{rantvl}->expect (
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);
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;
540 # Don't complain about unknown options
541 Getopt::Long::Configure "pass_through";
543 # Only really care about timeout...
545 "timeout=i", \$rantvlTimeout,
548 # Reassemble $cmd after GetOptions has processed it
549 $cmd = join " ", @ARGV;
550 @ARGV = @savedOptions;
553 $self->{rantvl}->send ("$cmd\n");
555 $self->{rantvl}->expect (
560 my $pid = $_[0]->after;
562 if ($pid =~ /(\d+)/) {
563 $logging_started = $1;
570 my @output = split /\n/, $_[0]->before;
587 if ($logging_started) {
588 return ($logging_started, "Logging started");
589 } elsif ($timedout) {
590 return (0, "Timed out executing rantvl");
592 return (0, join "\n", @lines);
596 ############################################################################
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
607 # phrase: Phrase to search for
608 # timeout: How long to time out waiting for the rendezvous
610 # Returns: undef if rendezvous was successful - error message
613 ############################################################################
614 sub rendezvous ($;$) {
615 my ($self, $phrase, $timeout) = @_;
621 $timeout = $timeout ? $timeout : $self->{timeout};
623 while (!$status && $attempts++ < 10) {
624 display_nolf "Attempt #$attempts" if get_debug;
626 my @lines = grep (/$phrase/, $self->getLogFile);
628 last if scalar @lines > 0;
630 display " sleeping " . $timeout / 10 . " seconds" if get_debug;
634 if ($attempts > 10) {
641 ############################################################################
643 # connected: Checks to see if you're connected to EAST
648 # Returns: undef if connected - error message otherwise
650 ############################################################################
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";
662 # We'll try up to 2 minutes, every 5 seconds...
665 while ($timedout < (60 * 2)) {
675 return "Timed out while attempting to rendezvous with server"
676 if $timedout >= (60 * 2);
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.
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
688 my $machine = "ran$self->{unitType}0" . substr $self->{unitNbr}, 0, 1;
690 $cmd = "/prj/muosran/SWIT/moshell/swstat ";
691 $cmd .= "/prj/muosran/SWIT/moshell/sitefiles/$machine ";
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";
697 @lines = $self->{msh}->exec ($cmd);
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);
703 if ($lines[0] && $lines[0] =~ /\w+\s+(\w+)/) {
706 my $build_no = Utils->getLoadFromRState ($rstate);
708 $self->{ran_version} = uc ($self->{unitType}) . ":$rstate-$build_no";
714 ############################################################################
716 # connect: Connects to the remote East machine
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)
725 # Returns: Undefined if connection was successful or error message if
728 ############################################################################
729 sub connect ($$$;$$$$) {
730 my ($self, $view, $unitType, $unitNbr, $tm500, $nms, $feature, $secure) = @_;
732 $self->{unitType} = lc $unitType;
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";
739 $self->{unitNbr} = $unitNbr;
741 # Check if unit is in use
742 my $msg = $self->inUse;
746 # Check that view exists
747 my ($status, @lines) = $self->viewExists ($view);
749 return "View $view does not exist" if $status;
751 # Save $view - we'll need it later...
752 $self->{view} = $view;
754 if ($self->{view} =~ /(\S+)_SIM/) {
755 $self->{userdir} = $1;
757 croak "ERROR: Unable to find userdir";
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;
764 $self->{msh} = new Rexec (
770 error "Unable to connect to " . RANHOST . " as " . RANUSER, 1
775 my $node = "$self->{unitType}$self->{unitNbr}";
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;
783 verbose "Attempting to secure node $node - This make take a while...\n"
784 . "(Will timeout in $secureNodeTimeoutMinutes minutes)";
786 my @lines = $self->{msh}->exec ("/prj/muosran/SWIT/tools/bin/securenode $node", $secureNodeTimeoutSeconds);
787 my $status = $self->{msh}->status;
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;
799 error "Unknown error has occurred", $status;
802 verbose "Node $node secured";
806 debug "Starting $unitType on unit $unitNbr";
808 my $cmd = "$self->{unitType} $self->{unitNbr}";
810 my $start_str = "StaRT";
811 my $errno_str = "ReXeCerRoNO=\$?";
812 my $compound_cmd = "echo $start_str; $cmd; echo $errno_str";
814 $self->{remote} = new Expect ($compound_cmd);
816 $self->{remote}->log_user (get_debug);
822 $self->{remote}->expect (
828 my $before = $exp->before;
829 my $after = $exp->after;
830 push @lines, "$cmd timed out";
844 my $before = $exp->before;
845 my $after = $exp->after;
847 if ($after =~ /(\d+)/) {
851 my @output = split /(\n\r)/, $before;
856 last if /$errno_str=/;
872 return join "\n", @lines if $status != 0;
874 # Set prompt to something distinctive
875 $self->{prompt} = "\@\@\@";
876 $cmd = "export PS1=$self->{prompt}\n";
878 $self->{remote}->send ($cmd);
880 $self->{remote}->expect (
885 $result = "$cmd timed out";
889 [ "^$self->{prompt}",
896 return $result if $result;
898 # Set TM500_VIEW if passed in
900 $cmd = "export TM500_VIEW=$tm500\n";
902 $self->{remote}->send ($cmd);
904 $self->{remote}->expect (
909 $result = "$cmd timed out";
913 [ "^$self->{prompt}",
920 return $result if $result;
923 # Set NMS_VIEW if passed in
925 $cmd = "export NMS_VIEW=$nms\n";
927 $self->{remote}->send ($cmd);
929 $self->{remote}->expect (
934 $result = "$cmd timed out";
938 [ "^$self->{prompt}",
945 return $result if $result;
948 # Set FEATURE if passed in
950 $cmd = "export FEATURE=$feature\n";
952 $self->{remote}->send ($cmd);
954 $self->{remote}->expect (
959 $result = "$cmd timed out";
963 [ "^$self->{prompt}",
970 return $result if $result;
973 debug "Starting EAST CLI in view $self->{view} on $self->{unitType}$self->{unitNbr}";
975 $cmd = "start_east_auto $self->{view} $self->{unitType}$self->{unitNbr}";
976 $compound_cmd = "echo $start_str; $cmd; echo $errno_str";
980 $self->{remote}->send ("$compound_cmd\n");
982 $self->{remote}->expect (
987 push @lines, "$cmd timed out";
1001 my $before = $exp->before;
1002 my $after = $exp->after;
1004 if ($after =~ /(\d+)/) {
1008 my @output = split /(\n\r)/, $before;
1013 last if /$errno_str=/;
1029 unless ($status == 0) {
1030 return "Unable to execute $cmd" . join "\n", @lines;
1032 return $self->connected;
1036 ############################################################################
1038 # eastUsage: Displays East command options
1041 # msg: Usage message
1043 # Returns: 1 for failure
1045 ############################################################################
1046 sub eastUsage (;$) {
1049 my $usage = "ERROR: $msg\n\n" if $msg;
1052 Usage: East::exec (<test class> <testname> <opts>)
1056 \t[-activecalls <n>]
1057 \t[-displaylevel <n>]
1058 \t[-executionlevel <n>]
1060 \t[-mode <admin|local>]
1061 \t[-p <property=value>]
1064 \t[-testenvironment <testenvironmentname>]
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.
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
1081 -name <name> Names a test. Used in conditional execution.
1083 -if (<name> <status>) Run this test if the named test returned <status>
1084 where <status> is one of
1092 . Failed to rendezvous
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.
1098 Also -run is always set. After all, we're automation here! :-)
1100 For other options see "Command Line in EAST" for more info.
1108 ############################################################################
1110 # exec: Executes a test remotely on East.
1113 # opts A reference to a hash of options
1114 # results A reference to a hash of execution results
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.
1122 # Returns: 0 for success, otherwise failure
1124 ############################################################################
1126 my ($self, $opts, $results) = @_;
1130 $self->{class} = lc $$opts{class};
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
1137 my $cmd = "/prj/muosran/SWIT/tools/bin/$$opts{test}";
1139 # Add unit and number
1140 $cmd .= " -$self->{unitType} $self->{unitNbr}";
1142 # Add flag to get pid
1146 $cmd .= " -logpath $self->{saveTo}";
1148 # Now start up rantvl
1149 my ($status, $msg) = $self->rantvl ($cmd);
1151 # Status is reversed here. The rantvl subroutine returns the pid
1152 # of the rantvl process for success - 0 for failure. So we flip
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});
1166 return $status, "Success";
1168 if (scalar @lines == 0) {
1169 return $status, "Unknown error occurred while executing $$opts{test}";
1171 return $status, join "\n", @lines;
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
1179 # For the user's convenience - put $logpath into the environment
1180 $ENV{LOGPATH} = LOGBASE . "/$self->{saveTo}";
1182 display "Perform your manual tests - type exit when finished";
1184 # Now run the user's shell
1185 system ($ENV{SHELL});
1187 print "Did your tests complete successfully? (y/N) ";
1189 my $response = <STDIN>;
1191 if ($response =~ /y/i) {
1192 return 0, "Success";
1194 return 1, "Manual test(s) failed";
1198 my ($status, $msg) = validTestType ($self->{class});
1200 return ($status, $msg) if $status;
1202 # Convert short type names -> a valid test class
1203 my $testClass = $_validTestTypes{$self->{class}};
1205 my $runopts = "-log -run";
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;
1212 @ARGV = stackOptions $$opts{test};
1214 # These options should be reset and not linger from one test to the
1218 undef $$opts{rendezvous};
1219 undef $$opts{timeout};
1221 # Default testbed to type & unit #
1222 $$opts{testbed} = "$self->{unitType}$self->{unitNbr}";
1224 $status = GetOptions (
1235 "testenvironment=s",
1243 $msg = "Unknown option";
1250 # Reassemble $$opts{test} after GetOptions has processed it
1251 $$opts{test} = join " ", @ARGV;
1252 @ARGV = @savedOptions;
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";
1265 if (defined $$opts{executionlevel} and
1266 ($$opts{executionlevel} < 0 or
1267 $$opts{executionlevel} > 6)) {
1268 $msg = "executionlevel must be between 0-6";
1275 return (1, "ERROR: Test $$opts{test} does not exist")
1276 unless $self->testExists ($testClass, $$opts{test});
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;
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};
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};
1296 my $cmd = "java $testClass $frontopts $runopts";
1298 $cmd .= "&" if $$opts{timeout} && $$opts{timeout} < 0 ||
1301 my $timeout = $$opts{timeout} && $$opts{timeout} > 0 ? $$opts{timeout} : $self->{timeout};
1304 my @components = split " ", $$opts{if};
1305 my $testName = shift @components;
1306 my $result = lc (join " ", @components);
1308 if ($$results{$testName} && $$results{$testName} ne $result) {
1309 $testResult = "Skipped";
1311 $$results{$$opts{name}} = lc $testResult if $$opts{name};
1313 return (1, $testResult);
1317 debug "\nRunning $cmd";
1319 my ($startTime, $attempts, $duration);
1323 use constant MAX_ATTEMPTS => 4;
1334 $self->{remote}->send ("$cmd\n");
1336 $self->{remote}->expect (
1348 my $before = $exp->before;
1349 my $after = $exp->after;
1351 $expectBuffer = "->$before<->$after<-";
1357 $duration = time - $startTime;
1359 if ($duration < 2 and $attempts > 0) {
1362 LogDebug "File: $$opts{file}";
1364 LogDebug "File: Not set";
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:";
1371 display "Contents of expect buffer:\n$expectBuffer";
1373 display "End of debug output";
1377 unless ($duration > 2 or $attempts >= MAX_ATTEMPTS or $cmd =~ /&$/) {
1378 LogDebug "Looping around for another try\n";
1380 } until ($duration > 2 or $attempts >= MAX_ATTEMPTS or $cmd =~ /&$/);
1382 if ($result == -1) {
1383 # Timed out. Kill stuck process
1384 $self->{remote}->send ("\cC");
1386 $self->{remote}->expect (
1396 return (-1, "Timed out");
1399 # If we backgrounded ourselves then there's no real status to
1400 # retrieve - we must just hope for the best.
1402 # Pause to allow test to start up.
1403 my $pause = $$opts{pause} ? $$opts{pause} : 0;
1405 debug "Sleeping $pause seconds";
1407 debug " Gee that was refressing!";
1409 if ($$opts{rendezvous}) {
1410 if ($self->rendezvous ($$opts{rendezvous}, $$opts{timeout})) {
1411 $testResult = "Unable to rendezvous";
1413 $$results{$$opts{name}} = lc $testResult if $$opts{name};
1415 return (1, $testResult);
1417 $testResult = "Rendezvous";
1419 $$results{$$opts{name}} = lc $testResult if $$opts{name};
1421 return (0, $testResult);
1424 $testResult = "In progress";
1426 $$results{$$opts{name}} = lc $testResult if $$opts{name};
1428 return (0, $testResult);
1432 ($status, $testResult) = $self->testResult ($$opts{test});
1434 $$results{$$opts{name}} = lc $testResult if $$opts{name};
1436 # Get TM500 version used (if any)
1437 delete $self->{tm500_version};
1439 my @logLines = $self->getLogFile;
1440 my @lines = grep (/^Command:.*version/, @logLines);
1442 if ($lines[0] && $lines[0] =~ /\-\-version\s+(.+)/) {
1443 $self->{tm500_version} = $1;
1446 @lines = grep (/^Simulator version is/, @logLines);
1448 if ($lines[0] && $lines[0] =~ /Simulator version is\s+(.+)\./) {
1449 $self->{nms_version} = $1;
1452 return ($status, $testResult);
1455 ############################################################################
1457 # disconnect: Disconnects from East simulator
1463 ############################################################################
1467 if ($self->{rantvl}) {
1468 # Send Control-C to terminate any processes running
1469 $self->{rantvl}->send ("\cC");
1471 # Try to exit remote command
1472 $self->{rantvl}->send ("exit\n");
1475 $self->{rantvl}->hard_close;
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;
1481 # Call destructor on Expect process
1482 undef $self->{rantvl};
1485 if ($self->{remote}) {
1486 # Send Control-C to terminate any processes running
1487 $self->{remote}->send ("\cC");
1489 # Try to exit remote command
1490 $self->{remote}->send ("exit\n");
1493 $self->{remote}->hard_close;
1495 # Call destructor on Expect process
1496 undef $self->{remote};
1500 ############################################################################
1502 # getCollectLogFiles: Gets CollectLogFiles
1506 # Returns: collectLogFiles setting
1508 ############################################################################
1509 sub getCollectLogFiles () {
1512 return $self->{collectLogFiles};
1513 } # getCollectLogFiles
1515 ############################################################################
1517 # setCollectLogFiles: Sets CollectLogFiles to notate that we need to
1521 # collectLogFiles: Boolean indictating where or not to collect log
1525 # Old collectLogFiles setting
1527 ############################################################################
1528 sub setCollectLogFiles ($) {
1529 my ($self, $collectLogFiles) = @_;
1531 my $old = $self->{collectLogFiles};
1533 $self->{collectLogFiles} = $collectLogFiles;
1536 } # setCollectLogFiles
1538 ############################################################################
1540 # setRantvlStartTime: Sets rantvlStartTime to notate that we need to
1544 # startTime: Start time (from time())
1549 ############################################################################
1550 sub setRantvlStartTime ($) {
1551 my ($self, $startTime) = @_;
1553 $self->{rantvlStartTime} = $startTime;
1554 } # setRantvlStartTime
1556 ############################################################################
1558 # setTestCaseID: Sets TestCaseID for later use by collectLogFiles
1564 ############################################################################
1565 sub setTestCaseID ($) {
1566 my ($self, $testCaseID) = @_;
1568 $self->{testCaseID} = $testCaseID;
1571 ############################################################################
1573 # setSaveTo: Sets saveTo for later use by collectLogFiles
1576 # path: Path to save things to
1580 ############################################################################
1582 my ($self, $saveTo) = @_;
1584 $self->{saveTo} = $saveTo;
1587 ############################################################################
1589 # getSaveTo: Gets saveTo
1593 # Returns: saveTo path
1595 ############################################################################
1599 return $self->{saveTo};
1602 ############################################################################
1604 # getTimeout: Returns the timeout value for the remote execution object
1609 # Returns: Timeout value for remote execution object, if connected, or
1612 ############################################################################
1616 return $self->{remote}->getTimeout if $self->{remote}
1619 ############################################################################
1621 # setTimeout: Sets timeout value for remote execution object for all
1622 # subsequent exec's.
1625 # timeout: new timeout value
1627 # Returns: Old timeout value (if previously connected)
1629 ############################################################################
1630 sub setTimeout ($) {
1631 my ($self, $timeout) = @_;
1633 return $self->{remote}->setTimeout ($timeout) if $self->{remote};
1636 ############################################################################
1638 # _checkOutElement: Checks out, or creates initial version of the passed
1639 # in file into Clearcase
1642 # file: Name of file to checkout (mkelem)
1644 # Returns: 0 if successful - non-zero if unsuccessful
1646 ############################################################################
1647 sub _checkOutElement ($;$) {
1648 my ($file, $eltype) = @_;
1650 my $parentDir = dirname $file;
1652 my ($status, @lines);
1654 # If the file already exists attempt to check it out
1656 # Assuming a snapshot view so run update
1657 ($status, @lines) = Execute CLEARTOOL . " update -log /dev/null $file 2>&1";
1661 error ("Unable to update view (Errno: $status)\n" . join ("\n", @lines), 1)
1662 unless $status == 0;
1666 ($status, @lines) = Execute CLEARTOOL . " checkout -nc $file 2>&1";
1670 error ("Unable to checkout $file (Errno: $status)\n" . join ("\n", @lines), 1)
1671 unless $status == 0;
1673 ($status, @lines) = Execute CLEARTOOL . " checkout -nc $parentDir 2>&1";
1677 error ("Unable to checkout parent directory $parentDir (Errno: $status)\n" . join ("\n", @lines), 1)
1678 unless $status == 0;
1680 # set eltype if passed
1681 my $eltypeParm = $eltype ? "-eltype $eltype" : "";
1683 # create the new element
1684 ($status, @lines) = Execute CLEARTOOL . " mkelem $eltypeParm -nc $file 2>&1";
1688 error ("Unable to mkelem $file (Errno: $status)\n" . join ("\n", @lines), 1)
1689 unless $status == 0;
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";
1696 error ("Unable to checkin parent directory $parentDir (Errno: $status)\n" . join ("\n", @lines), 1)
1697 unless $status == 0;
1701 } # _checkOutElement
1703 ############################################################################
1705 # _checkInElement: Checks in the passed in file into Clearcase
1708 # file: Name of file to checkin
1710 # Returns: 0 if successful - 1 if unsuccessful
1712 ############################################################################
1713 sub _checkInElement ($) {
1716 my ($status, @lines) = Execute CLEARTOOL . " checkin -nc $element 2>&1";
1720 error ("Unable to checkin $element (Errno: $status)\n" . join ("\n", @lines), 1)
1721 unless $status == 0;
1724 ############################################################################
1726 # _mkDirElement: Creates a directory element in Clearcase
1729 # dir: Name of the directory to mkelem
1731 # Returns: 0 if successful - 1 if unsuccessful
1733 ############################################################################
1734 sub _mkDirElement ($) {
1737 return 0 if -d $dir;
1739 my $parentDir = dirname $dir;
1741 my ($status, @lines) = Execute CLEARTOOL . " checkout -nc $parentDir 2>&1";
1745 error ("Unable to checkout parent directory $parentDir (Errno: $status)\n" . join ("\n", @lines), 1)
1746 unless $status == 0;
1748 eval { mkpath $dir };
1750 error "Unable to mkpath $dir\n$@", 1 if $@;
1752 ($status, @lines) = Execute CLEARTOOL . " mkelem -nc -nco $dir 2>&1";
1756 error ("Unable to mkdir $dir (Errno: $status)\n" . join ("\n", @lines), 1)
1757 unless $status == 0;
1759 return _checkInElement $parentDir;
1762 ############################################################################
1764 # _makeTar: Creates a tarfile
1767 # file: Name of tarfile to create
1768 # path: Path to use in the tarfile
1769 # files: Files to tar up
1771 # Returns: 0 if successful - 1 if unsuccessful
1773 ############################################################################
1774 sub _makeTar ($;$$) {
1775 my ($file, $path, $files) = @_;
1777 $path = "." unless $path;
1779 eval { mkpath $path };
1781 error "Unable to mkpath $path\n$@", 1 if $@;
1783 my ($status, @lines) = Execute "tar -czf $file -C $path $files";
1787 error ("Unable to create tarfile $file (Errno: $status)\n" . join ("\n", @lines), 1)
1791 ############################################################################
1793 # makeBaselinesReadme Creates a baselines.readme file
1796 # file: Name of file to create
1798 # Returns: 0 if successful - 1 if unsuccessful
1800 ############################################################################
1801 sub makeBaselinesReadme ($) {
1802 my ($self, $file) = @_;
1805 or error "Unable to open $file - $!", return 1;
1807 my ($status, @lines) = Execute CLEARTOOL . " lsstream -fmt \"\%[found_bls]p\" -view $self->{view}";
1811 error ("Unable to get baselines (Errno: $status)\n" . join ("\n", @lines), 1)
1812 unless $status == 0;
1814 print FILE "$_\n" foreach (split (" ", $lines[0]));
1819 } # makeBaselinesReadme
1821 ############################################################################
1823 # fixUpLogs: Fix up RNC log files (hotfix)
1827 # Returns: 0 if successful - 1 if unsuccessful
1829 ############################################################################
1833 my ($status, @lines);
1835 # Copy over the necessary log files
1836 my $file = $self->{unitType} eq "rbs"
1838 : "nodeb_aal5_utran.log";
1839 my $from = LOGBASE . "/$self->{saveTo}/EASTLogs/Server_Logs/$file";
1840 my $to = "/tmp/$file.$$";
1844 error "Unable to find $file file";
1848 my $cmd = "scp -q $from " . RANUSER . "\@" . RANHOST . ":$to";
1850 ($status, @lines) = Execute $cmd;
1855 error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1859 my $rnclog = "RNCLog.txt";
1861 $file = $self->{unitType} eq "rbs"
1864 $from = LOGBASE . "/$self->{saveTo}/Rantvl/$file";
1865 $to = "/tmp/$file.$$";
1870 error "Unable to find $file file";
1874 $cmd = "scp -q $from " . RANUSER . "\@" . RANHOST . ":$to";
1876 ($status, @lines) = Execute $cmd;
1881 error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1885 $status = rename $from, "$from.orig";
1888 error "Unable to rename $from -> $from.orig";
1892 (my $buildNbr) = $self->{ran_version} =~ /.*-(.*)/;
1894 $cmd = "/prj/muosran/SWIT/tools/bin/mergeEAST2RNC.pl ";
1895 $cmd .= "-log $logfile -east $eastfile -out $logfile.tmp -build $buildNbr";
1897 @lines = $self->{msh}->exec ($cmd);
1898 $status = $self->{msh}->status;
1901 error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1905 $cmd = "scp -q " . RANUSER . "\@" . RANHOST . ":$logfile.tmp $from";
1907 ($status, @lines) = Execute $cmd;
1912 error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1916 $cmd = "rm -f $eastfile $logfile $logfile.tmp";
1918 ($status, @lines) = $self->{msh}->exec ($cmd);
1919 $status = $self->{msh}->status;
1922 error ("Unable to execute command: $cmd\n" . join ("\n", @lines));
1928 ############################################################################
1930 # collectExtendedLogfiles: Scours an East logfile for extended logfiles
1931 # to collect. Extended logfiles are marked in
1934 # Collection of TM500, NMS and CDR extended logfiles:
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:
1940 # <type> <IP Address> <Logfile>
1941 # <type> <IP Address> <Logfile>
1947 # <type>: TM500|NMS|CDR
1948 # <IP Address> IP address of the machine (why they don't use names...)
1949 # <Logfile> Windows path like:
1951 # C:\TM500\TestLogs\MDL.cmd.2008.04.02-10.24.27.log
1953 # We need to take the above and formulate an scp command like:
1955 # scp -q pswit@<IP Address>:<Logfile> TM500Logs
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
1964 # Returns: 0 if successful - 1 if unsuccessful
1966 ############################################################################
1967 sub collectExtendedLogFiles () {
1970 # Create @tarfiles if it doesn't already exist
1971 unless ($self->{tarfiles}) {
1972 $self->{tarfiles} = ();
1975 my $logpath = LOGBASE . "/$self->{saveTo}";
1976 my $tm500dir = "$logpath/TM500Logs";
1977 my $nmsdir = "$logpath/NMSLogs";
1978 my $cdrdir = "$logpath/CDRLogs";
1980 my @logLines = $self->getLogFile;
1987 foreach (@logLines) {
1993 } elsif (/^\[\/LOG\]/) {
1996 if ($hitlog == 1 and /(\S+)\s+(\S+)\s+(\S+)/) {
1997 my ($type, $dir, $ip, $logfile);
1999 if ($1 eq "TM500") {
2002 } elsif ($1 eq "NMS") {
2005 } elsif ($1 eq "CDR") {
2013 $logfile =~ s/\\/\//g;
2016 eval { mkpath $dir };
2018 error "Unable to mkpath $dir\n$@", 1 if $@;
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
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";
2030 my ($status, @lines) = Execute $cmd;
2034 LogDebug "WARNING: From file, $logfile, does not exist on $ip" if $status != 0;
2037 my $cmd = "scp -q pswit\@$ip:$logfile $dir";
2039 my ($status, @lines) = Execute $cmd;
2043 if ($type eq "NMS") {
2045 LogDebug "Unable to execute $cmd";
2046 LogDebug "Lines contains:";
2047 LogDebug $_ foreach (@lines);
2054 ($status, @lines) = Execute $cmd;
2058 } until ($status == 0 or $i >= 2);
2062 error ("Unable to scp logfile $logfile (Errno: $status)\n$cmd\n" . join ("\n", @lines))
2063 unless $status == 0;
2069 push @{$self->{tarfiles}}, {
2071 tarfile => "TM500Logs.tgz",
2078 push @{$self->{tarfiles}}, {
2080 tarfile => "NMSLogs.tgz",
2087 push @{$self->{tarfiles}}, {
2089 tarfile => "CDRLogs.tgz",
2094 } # collectExtendedLogFiles
2096 ############################################################################
2098 # createPCScannerLogs: Creates PC Scanner logs using msh
2102 # Returns: 0 if successful - 1 if unsuccessful
2104 ############################################################################
2105 sub createPCScannerLogs ($) {
2106 my ($self, $node) = @_;
2108 my ($status, @lines);
2110 # Determine how long this test was running
2111 my $duration = time - $self->{rantvlStartTime};
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);
2117 if ($fractions < 15) {
2119 } elsif ($fractions < 30) {
2121 } elsif ($fractions < 45) {
2128 my $prompt = uc $node . '.*>';
2132 verbose_nolf "Collecting PC Scanner logs from the last $hours.$fractions hours...";
2134 my $cmd = "ssh -t " . RANUSER . "@" . RANHOST. " /prj/muosran/SWIT/moshell/moshell $node";
2135 my $msh = new Expect ($cmd);
2137 error "Unable to start msh", 1 unless $msh;
2139 $msh->log_user (get_debug);
2146 debug "Hit prompt!";
2152 error "Timed out looking for moshell prompt", 1;
2157 $cmd = "pmr -m $hours.$fractions";
2159 $msh->send ("$cmd\n");
2164 [ qr "Your Choice: " ],
2166 [ qr "No xml files to parse !",
2174 error "Timed out looking for \"Your Choice:\"", 1;
2180 verbose " No logs to process - skipping";
2186 $msh->send ("$cmd\n");
2195 error "Timed out looking for moshell prompt", 1;
2204 $msh->send ("$cmd\n");
2213 my $before = $exp->before;
2215 if ($before =~ /(\d+).*RNCScanner/) {
2223 error "Timed out looking for moshell prompt", 1;
2228 unless ($proxy_id) {
2229 error "Unable to find proxy_id";
2233 $cmd = "pbl $proxy_id";
2235 $msh->send ("$cmd\n");
2244 error "Timed out looking for moshell prompt", 1;
2250 } # createPCScannerLogs
2252 ############################################################################
2254 # collectRanTVLLogs: Collect rantvl logs
2256 # Parms: $logPath: Path to logfiles
2258 # Returns: 0 if successful - 1 if unsuccessful
2260 ############################################################################
2261 sub collectRanTVLLogs ($) {
2262 my ($self, $logpath) = @_;
2264 return unless ($self->{collectRantvl});
2266 my ($status, @lines);
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);
2277 if ($self->{unitType} eq "rnc") {
2278 # Create PC Scanner logs
2279 $status = $self->createPCScannerLogs ($DUTHost);
2281 unless ($status == 0) {
2282 warning "Unable to create PCScannerLogs" if $status > 0;
2286 # Move files to testlogs
2287 my $from = "~" . RANUSER . "/moshell_logfiles/logs_moshell/pmfiles/$DUTHost.gddsi.com/pm";
2288 my $to = "$logpath/PCScannerLogs";
2290 # Create the remote directory
2291 my $cmd = "mkdir -p $to; chmod g+w $to";
2293 ($status, @lines) = Execute ($cmd);
2297 error ("Unable to execute $cmd\n" . join ("\n", @lines), 1)
2301 $cmd = "scp -qrp " . RANUSER . "@" . RANHOST . ":$from/* $to";
2303 ($status, @lines) = Execute $cmd;
2307 error ("Unable to execute $cmd\n" . join ("\n", @lines), 1)
2310 $status = $self->{msh}->exec ("rm -rf $from/*");
2311 @lines = $self->{msh}->lines;
2313 error ("Unable to execute $cmd\n" . join ("\n", @lines), 1)
2316 push @{$self->{tarfiles}}, {
2317 type => "PCScanner",
2318 tarfile => "PCScannerLogs.tgz",
2325 my $from = RANTVL_LOGBASE . "/$self->{saveTo}";
2326 my $to = "$logpath/Rantvl";
2328 eval { mkpath $to };
2330 error "Unable to mkpath $to\n$@", 1 if $@;
2333 if ($self->{rantvlStartTime}) {
2334 use POSIX qw (ceil);
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";
2341 my ($status, @lines) = Execute $cmd;
2345 error ("Unable to execute $cmd\n" . join "\n", @lines) if $status != 0;
2349 my $cmd = "scp -rpq " . RANUSER . "\@" . RANHOST . ":$from/* $to";
2351 ($status, @lines) = Execute $cmd;
2355 return $status if $status;
2360 $cmd = "ssh " . RANUSER . "\@" . RANHOST . " rm -rf $from";
2362 ($status, @lines) = Execute $cmd;
2366 return $status if $status;
2370 push @{$self->{tarfiles}}, {
2372 tarfile => "RANTVLLogs.tgz",
2378 } # collectRanTVLLogs
2380 ############################################################################
2382 # collectLogfiles: Saves the logfiles for an EAST test run
2386 # Returns: 0 if successful - 1 if unsuccessful
2388 ############################################################################
2389 sub collectLogFiles (;$$) {
2390 my ($self, $testErrors, $checkin_on_error) = @_;
2392 return 0 unless $self->{collectLogFiles};
2395 $checkin_on_error ||= 1;
2397 $self->{saveTo} = "." unless $self->{saveTo};
2399 my $viewPath = "$ENV{MNT_DIR}/snapshot_views/$self->{userdir}/$self->{view}";
2401 # Copy relevant logs from
2402 my $eastLogBase = "$ENV{MNT_DIR}/$ENV{EAST_REL}/DUT/$self->{unitType}$self->{unitNbr}/data/logs";
2405 my $logpath = LOGBASE . "/$self->{saveTo}";
2407 verbose "logpath=$logpath";
2409 eval { mkpath "$logpath/EASTLogs" };
2411 error "Unable to mkpath $logpath/EASTLogs\n$@", 1 if $@;
2413 verbose "Collecting logfiles";
2415 foreach ("Server_Logs", "regression", "load") {
2416 next unless -e "$eastLogBase/$_";
2418 my $cmd = "cp -rp $eastLogBase/$_ $logpath/EASTLogs";
2420 my ($status, @lines) = Execute $cmd;
2424 error "Unable to copy $eastLogBase/$_ -> $logpath/EASTLogs", 1 if $status != 0;
2427 # We always save EAST logs
2428 push @{$self->{tarfiles}}, {
2430 tarfile => "EASTLogs.tgz",
2431 path => "$logpath/EASTLogs",
2435 my $status = $self->collectRanTVLLogs ($logpath);
2437 return $status if $status;
2439 verbose "All logfiles collected";
2441 # Report logfiles created
2443 display "Logfiles created this run:";
2445 my $cmd = "find " . LOGBASE . "/$self->{saveTo}";
2447 print $_ foreach (`$cmd`);
2450 $self->fixUpLogs if $self->{collectRantvl};
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;
2460 # if $checkin_on_error is not defined set it to false
2461 if ( !defined $checkin_on_error) {
2462 $checkin_on_error = "0";
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) ";
2469 my $response = <STDIN>;
2471 return 1 unless $response =~ /y/i;
2474 verbose_nolf "Checking in tar files for run for record"
2475 if scalar @{$self->{tarfiles}} > 0;
2477 foreach (@{$self->{tarfiles}}) {
2478 my $to = "$viewPath/vobs";
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";
2489 error "Unknown tarfile type: $$_{type}";
2493 $to .= "/$self->{testCaseID}";
2495 # Create testcaseID directory if necessary
2498 # Will create element if necessary
2499 _checkOutElement "$to/$$_{tarfile}";
2501 # Remove either old tarfile or empty container. We're about to fill it.
2502 my ($status, @lines) = Execute "rm -f $to/$$_{tarfile}";
2506 error "Unable to remove old tarfile", 1
2507 unless $status == 0;
2509 _makeTar "$to/$$_{tarfile}", $$_{path}, $$_{files};
2511 # Check in the element
2512 _checkInElement "$to/$$_{tarfile}";
2518 if scalar @{$self->{tarfiles}} > 0;
2520 verbose_nolf "Capturing baselines.";
2522 # We put baselines into here
2523 my $to = "$viewPath/vobs/rantest_build3_log/$self->{testCaseID}/baselines.readme";
2525 _checkOutElement $to;
2527 # Remove either old file or empty container. We're about to fill it.
2530 ($status, @lines) = Execute "rm -f $to";
2534 error "Unable to remove baseline.readme", 1
2535 unless $status == 0;
2537 $self->makeBaselinesReadme ($to);
2539 # Check in the element
2540 _checkInElement $to;
2544 $self->{collectLogFiles} = 0;
2553 Nethawk::East - East Object Model module
2557 Version 1.0 - January 17, 2008
2561 Encapsulates the East Simulator as an object. Methods are provided to
2562 connect, configure and run tests on an East Simulator.
2568 $e = new Nethawk::East;
2572 =head2 new (<parms>)
2574 Construct a new East object. The following OO style arguments are
2583 Name of host to connect through. Default: raneast
2587 Username to connect as. Default $USER
2591 Password to use. Default passwordless.
2595 If set then the East object will emit debugging information
2599 =head2 validTestType (type)
2601 Return a status indicating if the passed in test type is valid (and an
2602 error message if not)
2608 Type of test requested
2612 List contains a status (0 = valid test type, 1 = invalid test type)
2613 and an optional error message.
2619 Determines if the unit of type type is in use.
2623 =item Returns undef if not in use or an error message if in use
2627 =head2 viewExists (view)
2629 Determines if the view exists on the remote host
2639 1 if view exists - 0 otherwise
2643 =head2 testExists (type, name)
2645 Determines if the named test exists for that test type
2651 Specifies what type of test to check
2655 Specifies the name of the test
2657 =item Returns 1 if test exists - 0 otherwise
2661 =head2 getLogFile ()
2663 Returns the log in an array
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).
2676 =head2 testResult (name)
2678 Checks the test's logfile to determine the result
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
2695 =head2 shell (script, opts)
2697 Execute a shell script returning the results.
2709 Additional options passed to script
2713 $status of shell exeuction and @lines of output
2727 Rantvl command to execute
2731 $pid of rantvl process and a message
2735 =head2 rendezvous (phrase, timeout)
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
2750 Phrase to search for
2754 How long to time out waiting for the rendezvous
2758 undef if rendezvous was successful - error message otherwise.
2764 Checks to see if you're connected to EAST
2772 undef if connected - error message otherwise
2776 =head2 connect (view, unitType, unitNbr, tm500, nms)
2778 Connects to the remote East machine
2786 View name to set to to run the the test
2790 Type of unit (rbs, rnc or east)
2798 Name of tm500 view (if any)
2802 Name of nms view (if any)
2806 Undefined if connection was successful or error message if not
2810 =head2 exec (class, name, timeout)
2818 Specifies which class of test. Must be one of:
2821 pool RegressionLoadRunner
2823 ts RegressionTSRunner
2827 Name of the test. Currently this is the filename for the test.
2831 (Optional) Timeout value for this command
2833 =item returns status of remotely executed test.
2837 =head2 disconnect ()
2847 =head2 setCollectLogFiles (collectLogFiles)
2849 Sets CollectLogFiles to notate that we need to collect log files
2855 =item collectLogFiles
2857 Boolean indictating where or not to collect log files
2861 Old collectLogFiles setting
2867 Sets TestCaseID for later use by collectLogFiles
2881 =head2 setSaveTo (path)
2883 Sets saveTo for later use by collectLogFiles
2891 Path to save things to
2915 =head2 getTimeout ()
2917 Returns the timeout value for the remote execution object (if
2928 Timeout value for remote execution object, if connected, or undefined.
2930 =head2 collectLogFiles ()
2932 Saves the logfiles for an EAST test run
2942 0 if successful - 1 if unsuccessful
2946 =head2 setTimeout (timeout)
2948 Sets timeout value for remote execution object for all subsequent
2961 Old timeout value (if previously connected)
2967 =head1 KNOWN DEFECTS
2983 =item Andrew@DeFaria.com (Original Author)
2985 =item Gantry York, gantry.york@gdc4s.com (Maintainer)
2989 =head1 LICENSE & COPYRIGHT
2991 Copyright (c) 2008 General Dynamics, Inc. All Rights Reserved.