-
Notifications
You must be signed in to change notification settings - Fork 25
/
lf_gui_cmd.pl
executable file
·241 lines (209 loc) · 6 KB
/
lf_gui_cmd.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
#!/usr/bin/perl -w
# This program is used to stress test the LANforge system, and may be used as
# an example for others who wish to automate LANforge tests.
# Written by Candela Technologies Inc.
# Updated by: [email protected]
#
#
use strict;
use warnings;
use diagnostics;
use Carp;
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
$SIG{ __WARN__ } = sub { Carp::confess( @_ ) };
# Un-buffer output
$| = 1;
use Net::Telnet ();
use Getopt::Long;
my $lfmgr_host = "localhost";
my $lfmgr_port = 3990;
# Default values for ye ole cmd-line args.
my $port = "";
my $cmd = "";
my $ttype = ""; # Test type
my $tname = "lfgui-test";
my $scenario = "";
my $tconfig = ""; # test config
my $rpt_dest = "";
my $show_help = 0;
my $verbosity = -1;
my @modifiers_key = ();
my @modifiers_val = ();
########################################################################
# Nothing to configure below here, most likely.
########################################################################
my $usage = qq($0 [--manager { hostname or address of LANforge GUI machine } ]
[--port {port name} ] # cli-socket port default 3990
# careful, your cli-socket might be 3390!
[--ttype {test instance type} ]
# likely types: "cv", "WiFi Capacity", "Port Bringup", "Port Reset"
[--scenario {scenario name} ]
# Apply and build the scenario.
[--tname {test instance name} ]
[--tconfig {test configuration name, use defaults if not specified} ]
[--rpt_dest {Copy report to destination once it is complete} ]
[--cmd { command to send to the GUI } ]
[--verbosity { report verbosity 1 - 11 } ]
[--modifier "
Example:
lf_gui_cmd.pl --manager localhost --port 3990 --ttype TR-398 --tname mytest --tconfig comxim --rpt_dest /var/www/html/lf_reports
lf_gui_cmd.pl --manager localhost --port 3990 --cmd \"help\"
lf_gui_cmd.pl --manager localhost --port 3990 --scenario 64sta
);
if (@ARGV < 2) {
print "$usage\n";
exit 0;
}
GetOptions (
'help|h' => \$show_help,
'manager|mgr|m=s' => \$lfmgr_host,
'modifier_key=s' => \@modifiers_key,
'modifier_val=s' => \@modifiers_val,
'ttype=s' => \$ttype,
'tname=s' => \$tname,
'scenario=s' => \$scenario,
'tconfig=s' => \$tconfig,
'rpt_dest=s' => \$rpt_dest,
'port=s' => \$port,
'cmd|c=s' => \$cmd,
'verbosity|v=i' => \$verbosity,
) || die("$usage");
if ($show_help) {
print $usage;
exit 0;
}
my $lnk = @modifiers_key;
my $lnv = @modifiers_val;
if ($lnk != $lnv) {
print("ERROR: You must specify the same amount of modifers-key and modifiers-val entries.\n");
exit(3);
}
if ((defined $port) && ($port > 0)) {
$lfmgr_port = $port;
}
# Open connection to the LANforge server.
my $t = new Net::Telnet(Prompt => '/lfgui\# /',
Timeout => 20);
$t->open( Host => $lfmgr_host,
Port => $lfmgr_port,
Timeout => 10);
$t->waitfor("/lfgui\# /");
if ($cmd ne "") {
print doCmd("$cmd");
}
if ($scenario ne "") {
print doCmd("cv apply '$scenario'");
print doCmd("cv build");
sleep(3);
while (1) {
my $rslt = doCmd("cv is_built");
print "Result-built -:$rslt:-\n";
if ($rslt =~ /NO/) {
sleep(3);
}
else {
last;
}
}
}
if ($ttype ne "") {
# Try several times in case system is currently busy cleaning up or similar.
my $i;
my $rslt;
for ($i = 0; $i<60; $i++) {
$rslt = doCmd("cv create '$ttype' '$tname'");
print $rslt;
if ($rslt =~ /BUSY/) {
sleep(1);
}
else {
last;
}
}
if ($tconfig ne "") {
print doCmd("cv load '$tname' '$tconfig'");
}
if ($verbosity >= 1) {
print doCmd("cv set '$tname' 'VERBOSITY' '$verbosity'");
}
print doCmd("cv set '$tname' auto_save 1");
for ($i = 0; $i<@modifiers_key; $i++) {
my $k = $modifiers_key[$i];
my $v = $modifiers_val[$i];
print doCmd("cv set '$tname' '$k' '$v'");
}
$rslt = doCmd("cv click '$tname' 'Start'");
print $rslt;
if ($rslt =~ /Could not find instance/) {
exit(1);
}
while (1) {
my $rslt = doCmd("cv get '$tname' 'Report Location:'");
#print "Result-:$rslt:-\n";
if ($rslt =~ /^\s*Report Location:::(.*)/) {
my $loc = $1;
if ($loc eq "") {
# Wait longer
sleep(3);
}
else {
# Copy some place it can be seen easily?
print("LANforge GUI test complete, rpt-dest: $rpt_dest location: $loc\n");
if ($rpt_dest ne "") {
if ($lfmgr_host eq "localhost" || $lfmgr_host eq "127.0.0.1") {
# Must be on the local system
my $cp = "cp -ar $loc $rpt_dest";
print "Copy test results: $cp\n";
system($cp);
}
else {
# Must be on remote system, try scp to get it.
my $cp = "scp -r lanforge\@$lfmgr_host:$loc $rpt_dest";
print "Secure Copy test results: $cp\n";
system($cp);
}
}
last;
}
}
else {
sleep(3);
}
}
# Clean up our instance. This can take a while.
print doCmd("cv delete '$tname'");
while (1) {
my $rslt = doCmd("cv exists '$tname'");
print "Result-exists -:$rslt:-\n";
if ($rslt =~ /YES/) {
sleep(3);
}
else {
last;
}
}
# Wait a bit more, CV will likey be rebuilt now.
sleep(5);
while (1) {
my $rslt = doCmd("cv is_built");
print "Result-built -:$rslt:-\n";
if ($rslt =~ /NO/) {
sleep(3);
}
else {
print("Chamber-View is (re)built, exiting.\n");
last;
}
}
}
exit(0);
sub doCmd {
my $cmd = shift;
print ">>>Sending:$cmd\n";
$t->print($cmd);
my @rslt = $t->waitfor('/lfgui\#/');
if ($rslt[@rslt-1] eq "lfgui\#") {
$rslt[@rslt-1] = "";
}
return join("\n", @rslt);
}