-
Notifications
You must be signed in to change notification settings - Fork 25
/
lf_cycle_wanlinks.pl
executable file
·52 lines (41 loc) · 1.22 KB
/
lf_cycle_wanlinks.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
#!/usr/bin/perl
# 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.
# Load different databases, turn on/off packet capturing.
use strict;
# Un-buffer output
$| = 1;
my $i = 0;
my $nm = "VRWL-1.1.000";
my $im = "./lf_icemod.pl --quiet=2";
my $cap_for = 10;
while (1) {
print "Doing round: $i\n";
printAndExec("$im --load db1");
printAndExec("$im --cx $nm --state running");
save_captures();
printAndExec("$im --load db2");
printAndExec("$im --cx $nm --state running");
save_captures();
$i++;
}
sub save_captures {
my $i;
for ($i = 0; $i<5; $i++) {
printAndExec("$im --endp $nm-A --pcap /tmp/endp-a");
printAndExec("$im --endp $nm-B --pcap /tmp/endp-b");
sleep($cap_for);
printAndExec("$im --endp $nm-A --pcap off");
printAndExec("$im --endp $nm-B --pcap off");
printAndExec("rm -fr /tmp/endp-a/");
printAndExec("rm -fr /tmp/endp-b/");
}
}
sub printAndExec {
my $cmd = $_[0];
print "$cmd\n";
# NOTE: If you use the single back-ticks here, it will hang, probably some
# signal problem...never figured out why really (ERESTARTSYS) was the error
# that perl hung on... --Ben
system("$cmd");
}