mirror of
https://github.com/Telecominfraproject/wlan-lanforge-scripts.git
synced 2025-10-30 10:22:34 +00:00
72712ff548
These scripts will now be publicly available in a git repo for easier shared development and change tracking.
395 lines
11 KiB
Perl
Executable File
395 lines
11 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# IMIX Zero Loss Throughput Test
|
|
# Uses a binary search algorithm to determine the throughput at which
|
|
# zero packet loss occurs for a given theoretical throughput rate
|
|
# and max allowable latency.
|
|
#
|
|
# USAGE:
|
|
# perl lf_zlt_binary.pl lf_host theoretical_rate max_latency
|
|
# binary_search_attempts endpoint_duration test_loops
|
|
#
|
|
# Example: perl lf_zlt_binary.pl 192.168.100.192 10000000 200 9 10 1
|
|
|
|
|
|
# Un-buffer output
|
|
$| = 1;
|
|
|
|
use strict;
|
|
|
|
use Net::Telnet ();
|
|
use LANforge::Port;
|
|
use LANforge::Utils;
|
|
use LANforge::Endpoint;
|
|
|
|
my $lfmgr_host = "$ARGV[0]"; #localhost or IP
|
|
my $lfmgr_port = 4001;
|
|
|
|
my $shelf = 1;
|
|
|
|
# The LANforge resources
|
|
my $lf1 = 1;
|
|
my $lf2 = 1;
|
|
|
|
# Port pairs. These are the ports that should be talking to each other.
|
|
# Ie, lf1_ports talks to lf2_ports.
|
|
my @lf1_ports = (6);
|
|
my @lf2_ports = (7);
|
|
|
|
my @lf1_port_ips = ("172.1.1.6");
|
|
my @lf2_port_ips = ("172.1.1.7");
|
|
|
|
my @lf1_port_gws = ("172.1.1.1");
|
|
my @lf2_port_gws = ("172.1.1.1");
|
|
|
|
# IMIX Type Definition for UDP
|
|
# Packet sizes are in bytes of UDP payload
|
|
my @cx_types = ("lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp");
|
|
my @min_pkt_szs = (22, 86, 214, 470, 982, 1238, 1458, 1472);
|
|
my @max_pkt_szs = (22, 86, 214, 470, 982, 1238, 1458, 1472);
|
|
|
|
# Network Under Test Maximum Theoretical Throughput
|
|
my $min_rate = $ARGV[1]; # a rate such as 1544000
|
|
my $max_rate = $ARGV[1];
|
|
|
|
# Maximum Latency in miliseconds, allowed before adjusting rate down
|
|
my $max_latency = $ARGV[2]; # in milliseconds
|
|
|
|
my $test_mgr = "zlt_tm";
|
|
|
|
my $binary_search_attempts = $ARGV[3]; # number of attempts to find zlt for a given pkt size
|
|
my $pause_sec = 10; # seconds for endpoints to update
|
|
my $endp_duration = $ARGV[4]; # seconds endpoints are allowed to run, can affect results
|
|
my $loop_max = $ARGV[5]; # number of times the entire test will be run
|
|
my $report_timer = 1000;
|
|
my @endp_drops = ();
|
|
|
|
if (@ARGV != 6) {
|
|
print("USAGE: perl lf_zlt_binary.pl lf_host theoretical_rate max_latency ");
|
|
print("binary_search_attempts endpoint_duration test_loops\n");
|
|
print("Example: perl lf_zlt_binary.pl 192.168.100.192 10000000 200 ");
|
|
print("9 10 1\n");
|
|
exit 1;
|
|
}
|
|
|
|
########################################################################
|
|
# Nothing to configure below here, most likely.
|
|
########################################################################
|
|
|
|
my @endpoint_names = (); #will be added to as they are created
|
|
my @cx_names = ();
|
|
|
|
# Open connection to the LANforge server.
|
|
|
|
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/');
|
|
|
|
my $timeout = 60;
|
|
|
|
$t->open(Host => $lfmgr_host,
|
|
Port => $lfmgr_port,
|
|
Timeout => $timeout);
|
|
|
|
$t->waitfor("/btbits\>\>/");
|
|
|
|
# Configure our utils.
|
|
my $utils = new LANforge::Utils();
|
|
$utils->telnet($t); # Set our telnet object.
|
|
$utils->cli_send_silent(0); # Do show input to CLI
|
|
$utils->cli_rcv_silent(0); # Repress output from CLI ??
|
|
|
|
|
|
my $dt = "";
|
|
|
|
my $loop = 0;
|
|
for ($loop = 0; $loop<$loop_max; $loop++) {
|
|
$dt = `date`;
|
|
chomp($dt);
|
|
print "\n\n***** Starting loop: $loop at: $dt *****\n\n";
|
|
|
|
@endpoint_names = ();
|
|
@cx_names = ();
|
|
|
|
initToDefaults();
|
|
|
|
# Now, add back the test manager we will be using
|
|
doCmd("add_tm $test_mgr");
|
|
doCmd("tm_register $test_mgr default"); #Add default user
|
|
doCmd("tm_register $test_mgr default_gui"); #Add default GUI user
|
|
|
|
|
|
# Add some IP addresses to the ports
|
|
initIpAddresses();
|
|
|
|
# Add our endpoints
|
|
addCrossConnects();
|
|
|
|
print "Loop $loop: Done adding CXs.\n";
|
|
print "Pause $pause_sec seconds for ports to update.\n";
|
|
sleep($pause_sec);
|
|
|
|
# Start Cross-Connects
|
|
for (my $q=0; $q<@cx_names; $q++) {
|
|
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
|
doCmd($cmd);
|
|
|
|
my @next_adj = (int($max_rate / 2), int($max_rate / 2));
|
|
my @current_rate = ($max_rate, $max_rate);
|
|
my $last_current_rate = 0;
|
|
my @new_rate = (0,0);
|
|
my $adj_count = 0;
|
|
my $p1 = $q+$q;
|
|
my $p2 = $p1+1;
|
|
|
|
|
|
for ($adj_count=0; $adj_count < $binary_search_attempts; $adj_count++) {
|
|
|
|
doCmd("clear_endp_counters");
|
|
print "sleep $endp_duration seconds\n";
|
|
sleep($endp_duration);
|
|
|
|
for (my $p=$p1; $p<=$p2; $p++) {
|
|
my $endp1 = new LANforge::Endpoint();
|
|
$utils->updateEndpoint($endp1, $endpoint_names[$p]);
|
|
my $en1 = $endp1->rx_dropped_pkts();
|
|
my $en2 = $endp1->port_id();
|
|
my $en3 = $endp1->real_rx_rate();
|
|
my $lat = $endp1->avg_latency();
|
|
|
|
my $i = $p-$p1;
|
|
if ( $en1 != 0 || $lat > $max_latency ) {
|
|
print "Drops! en1 is $en1 : en2 is $en2 : Real RX Rate is: $en3 : Latency: $lat\n";
|
|
$new_rate[$i] = $current_rate[$i] - $next_adj[$i];
|
|
}
|
|
elsif ( $current_rate[$i] < $max_rate ) {
|
|
print "No Drops! en1 is $en1 : en2 is $en2 : Real RX Rate is: $en3 : Latency: $lat\n";
|
|
$last_current_rate = $current_rate[$i];
|
|
$new_rate[$i] = $current_rate[$i] + $next_adj[$i];
|
|
}
|
|
else {
|
|
print "Max Rate of $max_rate bps is too high for $min_pkt_szs[$q] byte packet size.\n";
|
|
$adj_count = $binary_search_attempts;
|
|
last;
|
|
}
|
|
|
|
$next_adj[$i] = int($next_adj[$i] / 2);
|
|
$current_rate[$i] = $new_rate[$i];
|
|
|
|
} #for $endpoint_names
|
|
|
|
# set both endpoints to zero rate to quiesce
|
|
my $cmd = "add_endp " . $endpoint_names[$p1] . " $shelf $lf1 " . " NA lf_udp " .
|
|
" -1 NO 0 0 NA NA NA NA ";
|
|
doCmd($cmd);
|
|
$cmd = "add_endp " . $endpoint_names[$p2] . " $shelf $lf1 " . " NA lf_udp " .
|
|
" -1 NO 0 0 NA NA NA NA ";
|
|
doCmd($cmd);
|
|
sleep(3);
|
|
|
|
# set both endpoints to new rate
|
|
$cmd = "add_endp " . $endpoint_names[$p1] . " $shelf $lf1 " . " NA lf_udp " .
|
|
" -1 NO " . $new_rate[0] . " " . $new_rate[0] . " NA NA NA NA ";
|
|
doCmd($cmd);
|
|
$cmd = "add_endp " . $endpoint_names[$p2] . " $shelf $lf1 " . " NA lf_udp " .
|
|
" -1 NO " . $new_rate[1] . " " . $new_rate[1] . " NA NA NA NA ";
|
|
doCmd($cmd);
|
|
} #for $adj_count
|
|
|
|
doCmd("set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED");
|
|
doCmd("clear_cx_counters");
|
|
doCmd("clear_port_counters");
|
|
print "\n\n*********************************************************\n";
|
|
print "Theoretical Throughput: $min_rate bps.\n";
|
|
print "Zero-Loss Throughput: $last_current_rate bps for $min_pkt_szs[$q] byte packets.\n\n";
|
|
sleep(10);
|
|
|
|
} #for cross-connects
|
|
} #for $loop_max
|
|
|
|
$dt = `date`;
|
|
chomp($dt);
|
|
print "Done at: $dt\n\n";
|
|
exit(0);
|
|
|
|
|
|
sub initToDefaults {
|
|
# Clean up database if stuff exists
|
|
|
|
doCmd("rm_cx $test_mgr all");
|
|
doCmd("rm_endp YES_ALL");
|
|
doCmd("rm_test_mgr $test_mgr");
|
|
|
|
initPortsToDefault();
|
|
|
|
}#initToDefaults
|
|
|
|
|
|
|
|
doCmd("probe_ports");
|
|
|
|
# Wait untill we discover all the ports...
|
|
|
|
my $q=0;
|
|
for ($q = 0; $q<@lf1_ports; $q++) {
|
|
my $p1 = new LANforge::Port();
|
|
$utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$q]);
|
|
my $pname = $p1->{dev};
|
|
|
|
my $p2 = new LANforge::Port();
|
|
my $pname2;
|
|
if ($lf2 ne "") {
|
|
$utils->updatePort($p2, $shelf, $lf2, $lf2_ports[$q]);
|
|
$pname2 = $p2->{dev};
|
|
}
|
|
}
|
|
|
|
|
|
|
|
# Wait untill the system can update a port..
|
|
sub throttleCard {
|
|
my $s = shift;
|
|
my $c = shift;
|
|
my $p1 = new LANforge::Port();
|
|
$utils->updatePort($p1, $s, $c, 1);
|
|
}#throttle
|
|
|
|
sub initPortsToDefault {
|
|
clearMacVlanPorts($shelf, $lf1);
|
|
if ($lf2 ne "") {
|
|
clearMacVlanPorts($shelf, $lf2);
|
|
}
|
|
|
|
throttleCard($shelf, $lf1);
|
|
|
|
if ($lf2 ne "") {
|
|
throttleCard($shelf, $lf2);
|
|
}
|
|
|
|
# Set all ports we are messing with to known state.
|
|
my $i = 0;
|
|
for ($i = 0; $i<@lf1_ports; $i++) {
|
|
my $tmp = $lf1_ports[$i];
|
|
my $tmp2 = $lf2_ports[$i];
|
|
doCmd("set_port $shelf $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
|
if ($lf2 ne "") {
|
|
doCmd("set_port $shelf $lf2 $tmp2 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
|
}
|
|
}
|
|
}
|
|
|
|
sub clearMacVlanPorts {
|
|
my $s = shift;
|
|
my $c = shift;
|
|
|
|
my $i;
|
|
my $found_one = 1;
|
|
my @ports = ();
|
|
while ($found_one) {
|
|
$found_one = 0;
|
|
doCmd("probe_ports");
|
|
# Clear out any existing MAC-VLAN ports.
|
|
$utils->error("");
|
|
@ports = $utils->getPortListing($s, $c);
|
|
my $mx = @ports;
|
|
print "Found $mx ports for resource: $shelf.$lf1\n";
|
|
|
|
if (($mx == 0) || ($utils->error() =~ /Timed out/g)) {
|
|
# System is too backlogged to answer, wait a bit
|
|
print " Will try listing ports again in a few seconds...system is backlogged now!\n";
|
|
sleep(5);
|
|
$found_one = 1;
|
|
next;
|
|
}
|
|
|
|
my $throttle = 0;
|
|
my $wait_for_phantom = 0;
|
|
for ($i = 0; $i<$mx; $i++) {
|
|
if ($ports[$i]->isMacVlan()) {
|
|
if ($ports[$i]->isPhantom()) {
|
|
# Wait a bit..hopefully it will go away.
|
|
if ($wait_for_phantom++ < 20) {
|
|
print "Sleeping a bit, found a phantom port.";
|
|
sleep(5);
|
|
doCmd("probe_ports");
|
|
$found_one = 1;
|
|
}
|
|
}
|
|
else {
|
|
doCmd($ports[$i]->getDeleteCmd());
|
|
$found_one = 1;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub initIpAddresses {
|
|
# Set all ports we are messing with to known state.
|
|
my $i = 0;
|
|
for ($i = 0; $i<@lf1_ports; $i++) {
|
|
my $tmp = $lf1_ports[$i];
|
|
my $tmp2 = $lf2_ports[$i];
|
|
my $cmd = "set_port $shelf $lf1 $tmp " . $lf1_port_ips[$i] . " 255.255.255.0 " .
|
|
$lf1_port_gws[$i] . " NA NA NA";
|
|
doCmd($cmd);
|
|
$cmd = "set_port $shelf $lf2 $tmp2 " . $lf2_port_ips[$i] . " 255.255.255.0 " . $lf2_port_gws[$i] . " NA NA NA";
|
|
doCmd($cmd);
|
|
}
|
|
}
|
|
|
|
sub addCrossConnects {
|
|
my $ep = 0;
|
|
my $cx = 0;
|
|
my $i = 0;
|
|
for ($i = 0; $i<@cx_types; $i++) {
|
|
my $j = 0;
|
|
for ($j = 0; $j<@lf1_ports; $j++) {
|
|
my $burst = "NO";
|
|
my $szrnd = "NO";
|
|
my $pattern = "increasing";
|
|
|
|
my $ep1 = "endp-${ep}-TX";
|
|
$ep++;
|
|
my $ep2 = "endp-${ep}-RX";
|
|
$ep++;
|
|
|
|
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
|
|
|
my $cmd = "add_endp $ep1 $shelf $lf1 " . $lf1_ports[$j] . " " . @cx_types[$i] .
|
|
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i]
|
|
. " " . $max_pkt_szs[$i] . " $pattern ";
|
|
doCmd($cmd);
|
|
|
|
$cmd = "add_endp $ep2 $shelf $lf2 " . $lf2_ports[$j] . " " . @cx_types[$i] .
|
|
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i]
|
|
. " " . $max_pkt_szs[$i] . " $pattern ";
|
|
doCmd($cmd);
|
|
|
|
# Now, add the cross-connects
|
|
my $cx_name = "cx-${cx}";
|
|
$cmd = "add_cx $cx_name $test_mgr $ep1 $ep2";
|
|
doCmd($cmd);
|
|
doCmd("set_cx_report_timer $test_mgr $cx_name $report_timer");
|
|
|
|
$cx++;
|
|
|
|
@cx_names = (@cx_names, $cx_name);
|
|
|
|
}#for all ports
|
|
}#for all endpoint types
|
|
}#addCrossConnects
|
|
|
|
|
|
sub doCmd {
|
|
my $cmd = shift;
|
|
|
|
print ">>> $cmd\n";
|
|
|
|
$t->print($cmd);
|
|
my @rslt = $t->waitfor(Match => '/ \>\>RSLT:(.*)/',
|
|
Timeout => $timeout);
|
|
|
|
print "**************\n @rslt ................\n\n";
|
|
#sleep(1);
|
|
}
|