use File::Basename;
use Cwd;
use XML::Simple;
use Data::Dumper;
use Sys::Hostname;
use Tk;
use Tk::DialogBox;
use Tk::ColorEditor;
use Tk::BrowseEntry;
use Tk::LabEntry;
use Tk::Pane;
use threads;
use threads::shared;
use Thread::Semaphore;
use Thread::Queue;
use strict;
use warnings;
$^W++; # Turn on warnings
my $running : shared = 1;
my $xs = new XML::Simple(keeproot=>1, forcearray=>1);
my $SYSTEMJOB = $xs->XMLin("<systemlist></systemlist>");
my $sourcepath = dirname(Cwd::abs_path(__FILE__)); #Where am I located
+ at?
unless ($sourcepath =~ m/\\$/) {
$sourcepath .= "\\";
}
my $reportpath = $sourcepath."Report\\";
my $ver = "6.0";
my @config_options = ("none");
my $CLI = "pathtocommand";
#make sure report folder exists
unless (-d $reportpath) {
mkdir $reportpath or die "failed to create report directory [$repo
+rtpath]\n";
}
#retrive license options
my $hardware_details_file = "hardware_details.xml";
my $hardwarexml;
open( FILE, "< $hardware_details_file" );
while ( my $line = <FILE> ) {
$hardwarexml .= $line;
}
close( FILE );
#build license options hash
my %hw_lic_options;
my $hardware = $xs->XMLin($hardwarexml);
foreach my $product (@{$hardware->{hardwarelist}->[0]->{product}}) {
my $mb_dmi = $product->{motherboard}->[0];
push (@{$hw_lic_options{$mb_dmi}}, "none");
foreach my $global (@{$hardware->{hardwarelist}->[0]->{license}->[
+0]->{option}}) {
push (@{$hw_lic_options{$mb_dmi}}, $global->{name}->[0]);
}
foreach my $config (@{$product->{config}}) {
my $cfg_name = $config->{name}->[0];
foreach my $lic (@{$config->{license}->[0]->{option}}) {
push (@{$hw_lic_options{$mb_dmi}}, $lic->{name}->[0]);
}
}
}
#create threads
#queues
my $discovered = Thread::Queue->new(); #new discovered systems
my $addsys = Thread::Queue->new(); #systems to be added to the GUI
my $test_start = Thread::Queue->new(); #tests to be executed
my $test_done = Thread::Queue->new(); #return data from test threads
my $rmsys = Thread::Queue->new(); #systems marked to be removed once t
+hey are no longer discovered
#semaphores
my $writelog = Thread::Semaphore->new(); #sequencal log writing
my $datavalidationlimit = 31; #reduce by 1, easy to add 1 to limit bel
+ow. Data validation tests require 2 locks while less intensive worker
+s only require 1 allowing systems to proceed while blocking intensive
+ processes
my $preformance = Thread::Semaphore->new($datavalidationlimit+1); #IO
+meter lock, limits datavalidation but allows IO meter to run without
+interferance.
my $iometerpreference = Thread::Semaphore->new(); #Allow IO Meter to b
+lock grabbing locks from other processes
#workers
threads->create("discovery", "192.168.0", "172.16", "10.0")->detach();
+ #find new systems, push them to formsystemlist
threads->create("formsystemlist")->detach(); #dequeue Discovery
threads->create("executejob")->detach(); #dequeue test_start
#user interface
testControl();
MainLoop();
$running = 0;
exit 0;
#THREADS
sub executejob {
#$SIG{__DIE__} = sub{ tcrash(threads->tid()); };
while ($running) {
#START AND DETACH TEST
while ($test_start->pending() > 0) {
my $system = $test_start->dequeue();
if ($system->{state}->[0] eq "running") { #this blocks fin
+ished tests
if ($system->{job}->[0]->{status}->[0] eq "ready") {
$system->{job}->[0]->{status}->[0] = "running";
$system->{job}->[0]->{nextjob}->[0] =~ m/(\d+):(\d
++)/;
my $test = $1;
my $iteration = $2;
my $testname = $system->{job}->[0]->{step}->[$test
+];
threads->create(\&{$testname}, $system)->detach();
+ #test
} else {
logLine("Test received but job not ready.");
logLine(Dumper $system);
}
}
}
}
}
sub formsystemlist {
#$SIG{__DIE__} = sub{ tcrash(threads->tid()); };
while (my $ip = $discovered->dequeue() and $running) {
my $passwd = "password";
my $license = "none";
my $tag = "";
my $config = "unknown";
my $raidtype = "unknown";
my $serial = "unknown";
my $servicekey = "unknown";
my $hardware = "unknown";
my $cap = 0; #sum of drives capacity
my $e = 0; #jbod count
my $can = "unknown"; #SBB left or right
my $mbInfo = "unknown";
my $software = "unknown";
my $itxvar = "unknown"; #oldest value. Updated by actual syste
+m
my $peerip = "unknown";
#create XML structure
my $sys = "<system>\n";
if ($mbInfo =~ m/X8DTS/) {
$sys .= "<alias>0</alias>\n";
$sys .= "<peer>\n";
$sys .= "<ip>$peerip</ip>\n";
$sys .= "<ip>0</ip>\n";
$sys .= "<alias>0</alias>\n";
$sys .= "<volume></volume>\n";
$sys .= "</peer>\n";
}
$sys .= "<ip>$ip</ip>\n";
$sys .= "<ip>0</ip>\n";
$sys .= "<hardware>$hardware</hardware>\n";
$sys .= "<volume></volume>\n";
$sys .= "<status>proceed</status>\n";
$sys .= "<state>stopped</state>\n";
$sys .= "<reportpath>$reportpath</reportpath>\n";
$sys .= "<health>unknown</health>\n";
$sys .= "<events>unknown</events>\n";
$sys .= "<serial>". int(rand(99999999999999)+100000000000000)
+."</serial>\n";
$sys .= "<servicekey>". int(rand(99999999999999999999999999))
+."</servicekey>\n";
$sys .= "<createtime>".time."</createtime>\n"; #not needed?
$sys .= "<filename>unknown</filename>\n";
$sys .= "<reasonforfailure>unknown</reasonforfailure>\n";
$sys .= "<password>$passwd</password>\n";
$sys .= "<license>\n";
$sys .= "<option>$license</option>\n";
$sys .= "<result>unknown</result>\n";
$sys .= "<tag>$tag</tag>\n";
$sys .= "<capacity>$cap</capacity>\n";
$sys .= "<jbods>$e</jbods>\n";
$sys .= "<ITXVAR>$itxvar</ITXVAR>\n";
$sys .= "</license>\n";
$sys .= "<raidtype>$raidtype</raidtype>\n";
$sys .= "<customerConfig>$config</customerConfig>\n";
$sys .= "<customerConfig>unknown</customerConfig>\n";
$sys .= "<job>\n";
$sys .= "<step>configure</step>\n";
$sys .= "<step>beyonddit</step>\n";
$sys .= "<step>iometer</step>\n";
$sys .= "<step>finalReportAnalysis</step>\n";
$sys .= "<step>SetLicense</step>\n";
$sys .= "<step>ConfigureForCustomer</step>\n";
$sys .= "<step>EmailResults</step>\n";
$sys .= "<nextjob>0:0</nextjob>\n";
$sys .= "<status>ready</status>\n";
$sys .= "<datavalidationiterations>24</datavalidationiteration
+s>\n";
$sys .= "<datavalidationruntime>3600</datavalidationruntime>\n
+";
$sys .= "</job>\n";
$sys .= "<gui>\n";
$sys .= "<progress>Not Running</progress>\n";
$sys .= "</gui>\n";
$sys .= "</system>";
$addsys->enqueue($sys);
}
}
sub discovery {
#$SIG{__DIE__} = sub{ tcrash(threads->tid()); };
my @notest = @_;
my @myaddress;
my $interval = 5; #seconds
my $pingtimeout = 50; #milliseconds
my $skip = 0;
my $ip = "";
my $mask = "";
foreach my $line (qx"ipconfig /all") {
chomp($line);
#log IP
if ($line =~ m/ip address.+: (\d+\.\d+\.\d+\.\d+)/i) {
$ip = $1;
} elsif ($line =~ m/IPv4 address.+: (\d+\.\d+\.\d+\.\d+)/i) {
$ip = $1;
}
#log mask
if ($line =~ m/Subnet Mask.+: (\d+\.\d+\.\d+\.\d+)/i) {
$mask = $1;
}
#push ip and mask
if ($ip ne "" and $mask ne "") {
push(@myaddress, "$ip,$mask");
$ip = "";
$mask = "";
}
}
#remove ips to interfaces which need to be excluded
for (my $n = 0; $n < @myaddress; $n++) {
my ($lip, $lmask) = split(",",$myaddress[$n]);
foreach my $addr (@notest) {
if ($lip =~ m/$addr/) {
#printLog("Will not check for clients on interface $li
+p");
splice(@myaddress, $n, 1);
$n--;
last;
}
}
}
#find systems on each accepted interface
while ($running) {
my $client = int(rand(255)).".".int(rand(255)).".".int(rand(25
+5)).".".int(rand(255));
$discovered->enqueue($client);
sleep $interval;
}
}
#GUI
sub testControl {
my %colors = (
title_bar => '#243e8a',
title_txt => '#ffffff',
header_bar => '#6e88d5',
header_txt => '#000000',
sys_even_bg => '#aeaeae',
sys_even_txt => '#000000',
sys_even_but_txt => '#ffffff',
sys_even_but_bg => '#777777',
sys_odd_bg => '#cecece',
sys_odd_txt => '#000000',
sys_odd_but_txt => '#ffffff',
sys_odd_but_bg => '#999999',
);
my $mainwindow = MainWindow->new();
$mainwindow->geometry( "1300x600" );
$mainwindow->title("DIAG Test Control");
$mainwindow->configure(-background=>$colors{title_bar});
$mainwindow->protocol('WM_DELETE_WINDOW',sub{$mainwindow->messageB
+ox(-message=>"Window cannot be closed this way.", -title=>"Disabled")
+;return;});
$mainwindow->Label(-text=>"DIAG Test Control [ver: $ver]", -backgr
+ound=>$colors{title_bar}, -foreground=>$colors{title_txt}, -font=>['c
+ourier', '14', 'bold'])->pack(-side => 'top');
my $lic_grid = $mainwindow->Scrolled('Pane', -background=>$colors{
+header_bar}, -foreground=>$colors{header_txt}, -scrollbars=>'osoe', -
+padx=>'10', -sticky => 'n')->pack(-side => 'top', -expand=>1, -fill=>
+"both");
my $size = 10;
$lic_grid->Label(-text=>"IP Address", -background=>$colors{header_
+bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->gri
+d(-row=>1, -column=>0, -sticky=>"nsew");
$lic_grid->Label(-text=>"Serial Number", -background=>$colors{head
+er_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->
+grid(-row=>1, -column=>1, -sticky=>"nsew");
$lic_grid->Label(-text=>"License", -background=>$colors{header_bar
+}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid(-
+row=>1, -column=>2, -sticky=>"nsew");
$lic_grid->Label(-text=>"Configuration", -background=>$colors{head
+er_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->
+grid(-row=>1, -column=>3, -sticky=>"nsew");
$lic_grid->Label(-text=>"Blink", -background=>$colors{header_bar},
+ -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid(-ro
+w=>1, -column=>4, -sticky=>"nsew");
$lic_grid->Label(-text=>"Data Validation\nIterations", -background
+=>$colors{header_bar}, -foreground=>$colors{header_txt}, -font=>[-siz
+e => $size])->grid(-row=>1, -column=>5, -columnspan=>3, -sticky=>"nse
+w");
$lic_grid->Label(-text=>"Data Validation Run Time", -background=>$
+colors{header_bar}, -foreground=>$colors{header_txt}, -font=>[-size =
+> $size])->grid(-row=>1, -column=>8, -columnspan=>9, -sticky=>"nsew")
+;
$lic_grid->Label(-text=>"Test Time", -background=>$colors{header_b
+ar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid
+(-row=>1, -column=>17, -sticky=>"nsew");
$lic_grid->Label(-text=>"System\nStatus", -background=>$colors{hea
+der_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])-
+>grid(-row=>1, -column=>18, -sticky=>"nsew");
$lic_grid->Label(-text=>"System\nState", -background=>$colors{head
+er_bar}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->
+grid(-row=>1, -column=>19, -sticky=>"nsew");
$lic_grid->Label(-text=>"Controls", -background=>$colors{header_ba
+r}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid(
+-row=>1, -column=>20, -columnspan=>2, -sticky=>"nsew");
$lic_grid->Label(-text=>"Progress", -background=>$colors{header_ba
+r}, -foreground=>$colors{header_txt}, -font=>[-size => $size])->grid(
+-row=>1, -column=>22, -sticky=>"nsew");
my $loop_collect = $mainwindow->repeat(1000, sub {
#PROCESS COMPLETED TEST RESULTS
while ($test_done->pending() > 0) {
#print "Getting results of test. Have [".$test_done->pendi
+ng()."] to process.\n";
my $results = $test_done->dequeue();
for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[
+0]->{system}}; $count++) {
my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->
+[$count];
if ($system->{servicekey}->[0] eq $results->{serviceke
+y}->[0]) {
#receive results
if ($results->{status}->[0] !~ m/fail/i) {
#stop/pause
if ($system->{state}->[0] eq "stopping") { #ch
+eck from GUI updated global
$results->{state}->[0] = "stop";
$results->{job}->[0]->{nextjob}->[0] = "0:
+0";
$results->{status}->[0] = "proceed";
$results->{gui}->[0]->{progress}->[0] = "s
+topped";
} elsif ($system->{state}->[0] eq "pausing") {
+ #check from GUI updated global
$results->{state}->[0] = "pause";
} elsif ($system->{state}->[0] eq "quitting")
+{ #check from quit updated global
if ($results->{status}->[0] ne "failure")
+{
$results->{status}->[0] = "failure";
$results->{reasonforfailure}->[0] = "m
+anual termenation";
$results->{job}->[0]->{nextjob}->[0] =
+ @{$results->{job}->[0]->{step}}.":0";
}
}
#set next test
my ($test, $iteration) = split(":", $results->
+{job}->[0]->{nextjob}->[0]);
if (defined $results->{job}->[0]->{step}->[$te
+st]) {
if ($results->{job}->[0]->{step}->[$test]
+eq "domatrixnano" or $results->{job}->[0]->{step}->[$test] eq "beyond
+dit") {
$iteration++;
if ($iteration > $results->{job}->[0]-
+>{datavalidationiterations}->[0]) {
$test++;
$iteration=0;
}
} else {
$test++;
$iteration=0;
}
}
if ($test >= @{$results->{job}->[0]->{step}})
+{
#print "DONE\n";
if ($system->{state}->[0] eq "quitting") {
$results->{state}->[0] = "terminated";
$results->{job}->[0]->{status}->[0] =
+"terminated";
} else {
$results->{state}->[0] = "complete";
$results->{job}->[0]->{status}->[0] =
+"ready";
$results->{job}->[0]->{nextjob}->[0] =
+ "0:0";
}
$results->{gui}->[0]->{progress}->[0] = "F
+inished";
} else {
#print "NEXT\n";
$results->{job}->[0]->{nextjob}->[0] = "$t
+est:$iteration";
$results->{job}->[0]->{status}->[0] = "rea
+dy";
$results->{job}->[0]->{nextjob}->[0] =~ m/
+(\d+):(\d+)/;
$results->{gui}->[0]->{progress}->[0] = $r
+esults->{job}->[0]->{step}->[$1]." on iteration [$2]";
}
} else {
print "set complete from fail\n";
$results->{job}->[0]->{state}->[0] = "complete
+";
}
leaf_copy($results, $system);
$test_start->enqueue($system); #let the thread dec
+ided if it needs to run or not.
last;
}
}
}
});
my $loop_addsys = $mainwindow->repeat(1000, sub{
ADD: while ($addsys->pending() > 0) {
if (defined $SYSTEMJOB->{systemlist}->[0]->{system}) {
if (@{$SYSTEMJOB->{systemlist}->[0]->{system}} > 25) {
+ #Reserve some DATA IPs for DIAG controller
$addsys->dequeue();
$mainwindow->update();
}
}
#ADD NEW SYSTEM TO GUI
my @test_cfg_options;
my $newsys = $xs->XMLin($addsys->dequeue());
#does this system already exist?
foreach my $sys (@{$SYSTEMJOB->{systemlist}->[0]->{system}
+}) {
#if ($sys->{ip}->[0] eq $newsys->{system}->[0]->{ip}->
+[0] or $sys->{servicekey}->[0] eq $newsys->{system}->[0]->{servicekey
+}->[0]) {
if ($sys->{ip}->[0] eq $newsys->{system}->[0]->{ip}->[
+0]) {
$mainwindow->update();
next ADD;
}
}
push(@{$SYSTEMJOB->{systemlist}->[0]->{system}}, $newsys->
+{system}->[0]);
my $systemid = @{$SYSTEMJOB->{systemlist}->[0]->{system}}
+- 1;
my $row_offset = 2;
my $row = $systemid + $row_offset;
my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$sy
+stemid];
$system->{ip}->[1] = find_free_ip();
if (defined $system->{peer}->[0]) {
$system->{alias}->[0] = find_free_ip();
$system->{peer}->[0]->{ip}->[1] = find_free_ip();
$system->{peer}->[0]->{alias}->[0] = find_free_ip();
}
my $nicetime = convert_time($system->{job}->[0]->{datavali
+dationiterations}->[0] * $system->{job}->[0]->{datavalidationruntime}
+->[0]);
my $bgcolor=$colors{sys_odd_bg};
my $txtcolor=$colors{sys_odd_txt};
my $buttxtcolor=$colors{sys_odd_but_txt};
my $butbgcolor=$colors{sys_odd_but_bg};
if ($row % 2 == 0) {
$bgcolor=$colors{sys_even_bg};
$txtcolor=$colors{sys_even_txt};
$buttxtcolor=$colors{sys_even_but_txt};
$butbgcolor=$colors{sys_even_but_bg};
}
$lic_grid->Label(-text=>$system->{ip}->[0], -background=>$
+bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -column=>0, -stick
+y=>"nsew");
push(@test_cfg_options, $lic_grid->Entry(-textvariable=>\$
+system->{serial}->[0], -background=>"white", -foreground=>$txtcolor,
+-width=>16, -highlightthickness=>2, -highlightcolor=>'blue')->grid(-r
+ow=>$row, -column=>1, -sticky=>"nsew"));
$lic_grid->Button(-state=>"disabled", -text=>"Set License"
+, -background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>
+4, -command=>[\&LicenseOptions, $system->{license}->[0]])->grid(-row=
+>$row, -column=>2, -sticky=>"nsew");
$lic_grid->Optionmenu(-state=>"disabled", -variable=>\$sys
+tem->{customerConfig}->[0], -background=>$butbgcolor, -foreground=>$b
+uttxtcolor, -relief=>'raised', -borderwidth=>4, -options=>\@config_op
+tions)->grid(-row=>$row, -column=>3, -sticky=>"nsew");
my $but_blink = $lic_grid->Button(-text=>"Blink Unit", -ba
+ckground=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4)->g
+rid(-row=>$row, -column=>4, -sticky=>"nsew");
if ($system->{raidtype}->[0] =~ m/none/i) {
$but_blink->configure(-state => 'disabled');
}
$lic_grid->Label(-textvariable=>\$system->{job}->[0]->{dat
+avalidationiterations}->[0], -background=>$bgcolor, -foreground=>$txt
+color, -width => 3)->grid(-row=>$row, -column=>5, -sticky=>"nsew");
push(@test_cfg_options, $lic_grid->Button(-text => "+", -b
+ackground=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, -
+command => sub{$system->{job}->[0]->{datavalidationiterations}->[0]++
+;$nicetime = convert_time($system->{job}->[0]->{datavalidationiterati
+ons}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})->gr
+id(-row=>$row, -column=>6, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "-", -b
+ackground=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, -
+command => sub{$system->{job}->[0]->{datavalidationiterations}->[0]--
+;$nicetime = convert_time($system->{job}->[0]->{datavalidationiterati
+ons}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})->gr
+id(-row=>$row, -column=>7, -sticky=>"nsew"));
$lic_grid->Label(-textvariable=>\$system->{job}->[0]->{dat
+avalidationruntime}->[0], -background=>$bgcolor, -foreground=>$txtcol
+or, -width=>8)->grid(-row=>$row, -column=>8, -sticky=>"nsew");
push(@test_cfg_options, $lic_grid->Button(-text => "+1D",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=8
+6400;$nicetime = convert_time($system->{job}->[0]->{datavalidationite
+rations}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})
+->grid(-row=>$row, -column=>9, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "-1D",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=8
+6400;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$sys
+tem->{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = conve
+rt_time($system->{job}->[0]->{datavalidationiterations}->[0] * $syste
+m->{job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -co
+lumn=>10, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "+1H",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=3
+600;$nicetime = convert_time($system->{job}->[0]->{datavalidationiter
+ations}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})-
+>grid(-row=>$row, -column=>11, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "-1H",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=3
+600;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$syst
+em->{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = conver
+t_time($system->{job}->[0]->{datavalidationiterations}->[0] * $system
+->{job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -col
+umn=>12, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "+5M",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=3
+00;$nicetime = convert_time($system->{job}->[0]->{datavalidationitera
+tions}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})->
+grid(-row=>$row, -column=>13, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "-5M",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=3
+00;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$syste
+m->{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = convert
+_time($system->{job}->[0]->{datavalidationiterations}->[0] * $system-
+>{job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -colu
+mn=>14, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "+5S",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]+=5
+;$nicetime = convert_time($system->{job}->[0]->{datavalidationiterati
+ons}->[0] * $system->{job}->[0]->{datavalidationruntime}->[0]);})->gr
+id(-row=>$row, -column=>15, -sticky=>"nsew"));
push(@test_cfg_options, $lic_grid->Button(-text => "-5S",
+-background=>$butbgcolor, -foreground=>$buttxtcolor, -borderwidth=>4,
+ -command => sub{$system->{job}->[0]->{datavalidationruntime}->[0]-=5
+;if ($system->{job}->[0]->{datavalidationruntime}->[0] < 0) {$system-
+>{job}->[0]->{datavalidationruntime}->[0] = 0;};$nicetime = convert_t
+ime($system->{job}->[0]->{datavalidationiterations}->[0] * $system->{
+job}->[0]->{datavalidationruntime}->[0]);})->grid(-row=>$row, -column
+=>16, -sticky=>"nsew"));
$lic_grid->Label(-textvariable=>\$nicetime ,-background=>$
+bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -column=>17, -stic
+ky=>"nsew");
$lic_grid->Label(-textvariable=>\$system->{status}->[0], -
+background=>$bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -colu
+mn=>18, -sticky=>"nsew");
$lic_grid->Label(-textvariable=>\$system->{state}->[0], -b
+ackground=>$bgcolor, -foreground=>$txtcolor)->grid(-row=>$row, -colum
+n=>19, -sticky=>"nsew");
my $but_ctl_1 = $lic_grid->Button(-text=>"Start", -backgro
+und=>$bgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, -foregroun
+d=>"black", -background=>"green", -activeforeground=>"green", -active
+background=>"black")->grid(-row=>$row, -column=>20, -sticky=>"nsew");
my $but_ctl_2 = $lic_grid->Button(-text=>"Remove", -backgr
+ound=>$bgcolor, -foreground=>$buttxtcolor, -borderwidth=>4, -foregrou
+nd=>"black", -background=>"orange", -activeforeground=>"orange", -act
+ivebackground=>"black")->grid(-row=>$row, -column=>21, -sticky=>"nsew
+");
$lic_grid->Label(-textvariable=>\$system->{gui}->[0]->{pro
+gress}->[0], -background=>$bgcolor, -foreground=>$txtcolor, -width =>
+ 40)->grid(-row=>$row, -column=>22, -sticky=>"nsew");
$but_ctl_1->configure(-command=>[sub{
my $system = $_[0];
my $state = $$system->{state}->[0];
if ($state eq "stopped" or $state eq "completed") {
#start
my @buttoncolor=("red","yellow");
#check test options
my $valid = 1;
if ($$system->{job}->[0]->{datavalidationiteration
+s}->[0] * $$system->{job}->[0]->{datavalidationruntime}->[0] == 0) {
$valid = 0;
$mainwindow->messageBox(-type=>"Ok", -title=>"
+Test Configuration ERROR", -message=>"Please check your data validati
+on paramaters and ensure test length is above zero", -icon=>"error");
}
if ($$system->{license}->[0]->{option}->[0] ne "no
+ne" and $$system->{license}->[0]->{option}->[0] ne "walgreens" and $$
+system->{license}->[0]->{option}->[0] ne "lenovo") {
if ($$system->{license}->[0]->{tag}->[0] eq ""
+) {
$valid = 0;
$mainwindow->messageBox(-type=>"Ok", -titl
+e=>"License Configuration ERROR", -message=>"License option not set t
+o vaild config. Option [".$$system->{license}->[0]->{option}->[0]."]
+with tag [".$$system->{license}->[0]->{tag}->[0]."]", -icon=>"error")
+;
}
}
if (length($$system->{serial}->[0]) ne 15) {
$valid = 0;
$mainwindow->messageBox(-type=>"Ok", -title=>"
+Serial Number ERROR", -message=>"Serial number must be 15 charaters",
+ -icon=>"error");
}
if ($valid == 1) {
$$system->{state}->[0]="running";
foreach my $button (@test_cfg_options) {
$button->configure(-state=>"disabled");
}
$but_ctl_1->configure(-text=>"Stop", -foregrou
+nd=>"black", -background=>$buttoncolor[0], -activeforeground=>$button
+color[0], -activebackground=>"black");
$but_ctl_2->configure(-state=>"normal", -text=
+>"Pause", -foreground=>"black", -background=>$buttoncolor[1], -active
+foreground=>$buttoncolor[1], -activebackground=>"black");
$$system->{job}->[0]->{nextjob}->[0] =~ m/(\d+
+):(\d+)/;
$$system->{gui}->[0]->{progress}->[0] = $$syst
+em->{job}->[0]->{step}->[$1]." on iteration [$2]";
$test_start->enqueue($$system);
}
} elsif ($state eq "paused") {
#stop
my @buttoncolor=("green","yellow");
$$system->{state}->[0]="stopped";
$$system->{job}->[0]->{nextjob}->[0] = "0:0";
$$system->{status}->[0] = "proceed";
$$system->{gui}->[0]->{progress}->[0] = "stopped";
foreach my $button (@test_cfg_options) {
$button->configure(-state=>"normal");
}
$but_ctl_1->configure(-state=>"normal", -text=>"St
+art", -foreground=>"black", -background=>$buttoncolor[0], -activefore
+ground=>$buttoncolor[0], -activebackground=>"black");
$but_ctl_2->configure(-state=>"disabled", -text=>"
+Pause",-foreground=>"black", -background=>$buttoncolor[1], -activefor
+eground=>$buttoncolor[1], -activebackground=>"black");
} elsif ($state eq "running" or $state eq "pausing") {
#stop
$mainwindow->messageBox(-message=>"Please wait for
+ the system to fully stop before making changes to the test paramater
+s.", -title=>"Please Wait");
my @buttoncolor=("green","yellow");
$$system->{state}->[0]="stopping";
$but_ctl_1->configure(-state=>"disabled", -text=>"
+Start", -foreground=>"black", -background=>$buttoncolor[0], -activefo
+reground=>$buttoncolor[0], -activebackground=>"black");
$but_ctl_2->configure(-state=>"disabled", -text=>"
+Pause",-foreground=>"black", -background=>$buttoncolor[1], -activefor
+eground=>$buttoncolor[1], -activebackground=>"black");
}
},(\$system)]);
$but_ctl_2->configure(-command=>[sub{
my $system = $_[0];
my $row_offset = $_[1];
my $state = $$system->{state}->[0];
if ($state eq "running") {
#pause
my @buttoncolor=("red","green");
$$system->{state}->[0]="pausing";
$but_ctl_1->configure(-text=>"Stop", -foreground=>
+"black", -background=>$buttoncolor[0], -activeforeground=>$buttoncolo
+r[0], -activebackground=>"black");
$but_ctl_2->configure(-state=>"disabled", -text=>"
+Resume", -foreground=>"black", -background=>$buttoncolor[1], -activef
+oreground=>$buttoncolor[1], -activebackground=>"black");
} elsif ($state eq "paused") {
#resume
my @buttoncolor=("red","yellow");
$$system->{state}->[0]="running";
foreach my $button (@test_cfg_options) {
$button->configure(-state=>"disabled");
}
$but_ctl_1->configure(-text=>"Stop", -foreground=>
+"black", -background=>$buttoncolor[0], -activeforeground=>$buttoncolo
+r[0], -activebackground=>"black");
$but_ctl_2->configure(-text=>"Pause", -foreground=
+>"black", -background=>$buttoncolor[1], -activeforeground=>$buttoncol
+or[1], -activebackground=>"black");
$test_start->enqueue($$system);
} elsif ($state eq "new" or $state eq "stopped" or $st
+ate eq "completed") {
#remove
for (my $s = 0; $s < @{$SYSTEMJOB->{systemlist}->[
+0]->{system}}; $s++) {
if ($$system->{servicekey}->[0] eq $SYSTEMJOB-
+>{systemlist}->[0]->{system}->[$s]->{servicekey}->[0]) {
splice($SYSTEMJOB->{systemlist}->[0]->{sys
+tem}, $s, 1);
my $row = $s+$row_offset;
my @widgets = $lic_grid->Subwidget('pane')
+->gridSlaves(-row=>$row);
foreach my $widget (@widgets) {
$widget->gridForget();
}
my ($cols, $rows) = $lic_grid->Subwidget('
+pane')->gridSize;
for ($row; $row < $rows; $row++) {
my $nextrow = $row + 1;
my @widgets = $lic_grid->Subwidget('pa
+ne')->gridSlaves(-row=>$nextrow);
foreach my $widget (@widgets) {
$widget->grid(-row=>$row);
my $bgcolor=$colors{sys_odd_bg};
my $txtcolor=$colors{sys_odd_txt};
my $buttxtcolor=$colors{sys_odd_bu
+t_txt};
my $butbgcolor=$colors{sys_odd_but
+_bg};
if ($row % 2 == 0) {
$bgcolor=$colors{sys_even_bg};
$txtcolor=$colors{sys_even_txt
+};
$buttxtcolor=$colors{sys_even_
+but_txt};
$butbgcolor=$colors{sys_even_b
+ut_bg};
}
#Button, Label, Optionmenu, Entry
if ($widget->class() eq "Button" o
+r $widget->class() eq "Optionmenu") {
my @commandcolors = ("green",
+"yellow", "red", "orange");
unless ($widget->cget('-backgr
+ound') ~~ @commandcolors) {
$widget->configure(-backgr
+ound=>$butbgcolor, -foreground=>$buttxtcolor);
}
} elsif ($widget->class() eq "Entr
+y") {
$widget->configure(-background
+=>"white", -foreground=>$txtcolor);
} else {
$widget->configure(-background
+=>$bgcolor, -foreground=>$txtcolor);
}
}
}
}
}
}
},(\$system, $row_offset)]);
$mainwindow->repeat(3000, sub{
if ($system->{state}->[0] eq "complete") {
#print "COMPLETE\n";
$system->{state}->[0] = "completed";
my @buttoncolor=("green","orange");
$system->{job}->[0]->{nextjob}->[0] = "0:0";
$system->{status}->[0] = "proceed";
foreach my $button (@test_cfg_options) {
$button->configure(-state=>"normal");
}
$but_ctl_1->configure(-state=>"normal", -text=>"St
+art", -foreground=>"black", -background=>$buttoncolor[0], -activefore
+ground=>$buttoncolor[0], -activebackground=>"black");
$but_ctl_2->configure(-state=>"normal", -text=>"Re
+move",-foreground=>"black", -background=>$buttoncolor[1], -activefore
+ground=>$buttoncolor[1], -activebackground=>"black");
} elsif ($system->{state}->[0] eq "stop") {
#print "STOPPED\n";
$system->{state}->[0] = "stopped";
my @buttoncolor=("green","orange");
foreach my $button (@test_cfg_options) {
$button->configure(-state=>"normal");
}
$but_ctl_1->configure(-state=>"normal", -text=>"St
+art", -foreground=>"black", -background=>$buttoncolor[0], -activefore
+ground=>$buttoncolor[0], -activebackground=>"black");
$but_ctl_2->configure(-state=>"normal", -text=>"Re
+move",-foreground=>"black", -background=>$buttoncolor[1], -activefore
+ground=>$buttoncolor[1], -activebackground=>"black");
$system->{gui}->[0]->{progress}->[0] = "Not Runnin
+g";
} elsif ($system->{state}->[0] eq "pause") {
#print "PAUSED\n";
$system->{state}->[0] = "paused";
my @buttoncolor=("red","green");
foreach my $button (@test_cfg_options) {
$button->configure(-state=>"normal");
}
$but_ctl_1->configure(-state=>"normal", -text=>"St
+op", -foreground=>"black", -background=>$buttoncolor[0], -activeforeg
+round=>$buttoncolor[0], -activebackground=>"black");
$but_ctl_2->configure(-state=>"normal", -text=>"Re
+sume",-foreground=>"black", -background=>$buttoncolor[1], -activefore
+ground=>$buttoncolor[1], -activebackground=>"black");
}
});
}#end while
});
my $exitb = $mainwindow->Button(-text=>"Finished", -background=>"l
+ight grey", -foreground=>"black", -borderwidth=>4, -font=>[-weight =>
+ "bold"])->pack(-side => 'top', -pady=>4);
$exitb->configure(-command=>[sub{
if ($mainwindow->messageBox(-default=>"No", -type=>"YesNo", -t
+itle=>"Confirm quit", -message=>"Please confirm manually terminating
+all tests and quiting DIAG", -icon=>"warning") eq "Yes") {
$_[0]->configure(-state=>"disabled");
quit($mainwindow);
}
}, $exitb]);
$mainwindow->state('zoomed');
}
#SUBS
sub convert_time ($) {
my $time = $_[0];
my $days = int($time / 86400);
$time -= ($days * 86400);
my $hours = int($time / 3600);
$time -= ($hours * 3600);
my $minutes = int($time / 60);
$time -= ($hours * 60);
my $seconds = $time % 60;
$days = $days .'d';
$hours = $hours .'h';
$minutes = $minutes . 'm';
return "$days $hours $minutes ${seconds}s";
}
sub find_free_ip () {
for (my $ip = 2; $ip < 255; $ip++) { #0.1 is controller
my $used = 0;
for (my $s = 0; $s < @{$SYSTEMJOB->{systemlist}->[0]->{system}
+}; $s++) {
my $addr = $SYSTEMJOB->{systemlist}->[0]->{system}->[$s]->
+{ip}->[1];
my $alias = -1;
if (defined $SYSTEMJOB->{systemlist}->[0]->{system}->[$s]-
+>{alias}) {
$alias = $SYSTEMJOB->{systemlist}->[0]->{system}->[$s]
+->{alias}->[0];
}
if ($addr =~ m/\d{1,3}\.\d{1,3}\.\d{1,3}\.(\d{1,3})/) {
$addr = $1;
}
if ($alias =~ m/\d{1,3}\.\d{1,3}\.\d{1,3}\.(\d{1,3})/) {
$alias = $1;
}
if ($ip == $addr or $ip == $alias) {
$used = 1;
last;
}
}
if ($used == 0) {
return "192.168.0.".$ip;
}
}
return "OUT";
}
sub leaf_copy ($$) {
if (ref $_[0] eq 'HASH') {
$_[1]||={};
for my $key (keys %{$_[0]}){
if (ref $_[0]->{$key}) {
leaf_copy($_[0]->{$key}, $_[1]->{$key});
} else {
$_[1]->{$key} = $_[0]->{$key};
}
}
} elsif (ref $_[0] eq 'ARRAY') {
$_[1]||=[];
for my $i (0..$#{$_[0]}){
if (ref $_[0]->[$i]) {
leaf_copy($_[0]->[$i], $_[1]->[$i]);
} else {
$_[1]->[$i] = $_[0]->[$i];
}
}
}
}
sub tcrash {
debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3]);
my $tid = $_[0];
my $thr = threads->object($tid);
my $error;
if ($thr-error()) {
$error = " due to error ". $thr->error();
}
print "Thread ". (caller(1))[3] ." died at ". (caller(0))[2] ."$er
+ror\n";
$running = 0;
}
sub quit($) {
debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3]);
$running = 0;
my $systemcount = @{$SYSTEMJOB->{systemlist}->[0]->{system}};
my $allfin = 0;
while ($allfin == 0) {
$allfin = 1;
for (my $i = 0; $i < $systemcount; $i++) {
my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$i]
+;
if ($system->{state}->[0] ne "stopped" and $system->{state
+}->[0] ne "terminated" and $system->{state}->[0] ne "complete") {
$allfin = 0;
if ($system->{state}->[0] ne "quiting") {
$system->{state}->[0] = "quiting";
}
}
if ($system->{state}->[0] eq "terminated") {
$system->{state}->[0] = "stopped";
cleanupconfig($system); #can only run one test
}
}
$_[0]->update();
if ($allfin == 1) {
sleep 5;
}
}
$_[0]->destroy; #mainwindow
}
sub debugLogFunctionNameLineNum {
#Print sub header and caller info
#debugLogFunctionNameLineNum((caller(0))[2],(caller(1))[3]);
my ($callerline, $caller) = @_;
unless ($caller) {
$caller = "MAIN";
}
if ($caller =~ m/eval/) {
$caller = "Tk call";
$callerline = "Unknown";
}
my $LineNumber = (caller(0))[2];
my $FunctionName = (caller(1))[3];
my $time = localtime time;
unless ($FunctionName) {
$FunctionName = "MAIN";
}
print "$FunctionName, $LineNumber: Called from [$caller] at [$call
+erline].\n";
}
sub logLine {
my ($text) =@_;
chomp($text);
my ($package, $filename, $line) = caller;
my $FunctionName = (caller(1))[3];
my $time = localtime time;
$writelog->down();
my $header = "$filename, $FunctionName, $line, $time";
print "$header: $text\n"; #only for testing
#open (LOG, ">>log.txt");
#print LOG "$header: $text\n";
#close (LOG);
$writelog->up();
}
sub printLog {
my ($text) =@_;
chomp($text);
my ($package, $filename, $line) = caller;
my $FunctionName = (caller(1))[3];
my $time = localtime time;
$writelog->down();
my $header = "$filename, $FunctionName, $line, $time";
print "$header: $text\n";
#open (LOG, ">>log.txt");
#print LOG "$header: $text\n";
#close (LOG);
$writelog->up();
}
#TESTS
sub configure {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = int(rand(10))+1;
$iometerpreference->down();
$iometerpreference->up();
$preformance->down();
logLine("[$subroutine] [".$system->{ip}->[0]."]");
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up();
$test_done->enqueue($system);
}
sub domatrixnano {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = int(rand(10))+1;
$iometerpreference->down();
$iometerpreference->up();
$preformance->down(2);
logLine("[$subroutine] [".$system->{ip}->[0]."]");
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up(2);
$test_done->enqueue($system);
}
sub beyonddit {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = int(rand(3))+1;
$iometerpreference->down();
$iometerpreference->up();
$preformance->down(2);
logLine("[$subroutine] [".$system->{ip}->[0]."]");
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up(2);
$test_done->enqueue($system);
}
sub iometer {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = 20;
$iometerpreference->down(); #only IOmeter holds this lock down whi
+le waiting to get limitation lock
$preformance->down($datavalidationlimit); #stop all other IO
$iometerpreference->up();
#IO meter with no other IO.
logLine("[$subroutine] [".$system->{ip}->[0]."]");
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up($datavalidationlimit);
$test_done->enqueue($system);
}
sub finalReportAnalysis {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = 20;
$iometerpreference->down();
$iometerpreference->up();
$preformance->down();
print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n";
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up();
$test_done->enqueue($system);
}
sub SetLicense {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = 40;
$iometerpreference->down();
$iometerpreference->up();
$preformance->down();
print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n";
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up();
$test_done->enqueue($system);
}
sub ConfigureForCustomer {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = 40;
$iometerpreference->down();
$iometerpreference->up();
$preformance->down();
print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n";
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up();
$test_done->enqueue($system);
}
sub EmailResults {
my $subroutine = (caller(0))[3];
my $system = $_[0];
my $testtime = 40;
$iometerpreference->down();
$iometerpreference->up();
$preformance->down();
print "[$subroutine] [".$system->{state}->[0]."] for $testtime\n";
sleep $testtime;
print "[$subroutine] complete\n";
$preformance->up();
$test_done->enqueue($system);
}