mirror of
https://github.com/Telecominfraproject/wlan-lanforge-scripts.git
synced 2025-10-28 17:32:35 +00:00
Add scripts from the tools directory in the private Candela repo.
These scripts will now be publicly available in a git repo for easier shared development and change tracking.
This commit is contained in:
Ben Greear
158
associate_loop.sh
Executable file
158
associate_loop.sh
Executable file
@@ -0,0 +1,158 @@
|
||||
#!/bin/bash
|
||||
##### ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### #####
|
||||
## ##
|
||||
## Use this script to associate stations between SSIDs A and B ##
|
||||
## ##
|
||||
## Install this script in /home/lanforge ##
|
||||
## Usage: ./associate_loop -m localhost -r 1 -a SSIDA -b SSIDB -n 10 -i 5 ##
|
||||
## -w wiphy0 -s sta1,sta2,sta3,sta4,sta5,sta6,sta7,sta8,sta9,sta10 ##
|
||||
## ##
|
||||
## ##
|
||||
## ##
|
||||
## ##
|
||||
##### ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### #####
|
||||
Q='"'
|
||||
A="'"
|
||||
#set -e
|
||||
#set -x
|
||||
usage="$0 -m localhost -r 1 -w wiphy0 -s sta1,sta2...<max> -a SSIDA -b SSIDB -n <seconds> -i <iterations>
|
||||
-m: manager ip address
|
||||
-r: resourse id
|
||||
-w: radio name for stations
|
||||
-s: station list, comma separated (no spaces)
|
||||
-a: first ssid
|
||||
-b: second ssid
|
||||
-n: naptime in seconds
|
||||
-i: iteration to loop
|
||||
|
||||
Associate one station (sta1) for 1 second, 10 iterations:
|
||||
$0 -m localhost -r 1 -w wiphy0 -s sta1,wlan1 -a testap1 -b testap2 -n 1 -i 10
|
||||
|
||||
Associate ten stations (sta105..sta109) for 5 seconds, indefinitely:
|
||||
stations=\`seq -f 'sta%g' -s, 105 109\`
|
||||
$0 -m 192.168.101.1 -r 2 -w wiphy1 -s \$stations -a testap1 -b testab2 -n 5 -i 0
|
||||
|
||||
Hit control-c to stop.
|
||||
"
|
||||
modscript=""
|
||||
if [ -f "lf_firemod" ]; then
|
||||
modscript="./lf_firemod.pl"
|
||||
elif [ -f "/home/lanforge/scripts/lf_firemod.pl" ]; then
|
||||
modscript="/home/lanforge/scripts/lf_firemod.pl"
|
||||
fi
|
||||
cd /home/lanforge/scripts
|
||||
|
||||
[ -z "$modscript" ] && {
|
||||
echo "script [$modscript] not present, please use this script from /home/lanforge or /home/lanforge/scripts"
|
||||
exit 1
|
||||
}
|
||||
|
||||
infinite=0
|
||||
while getopts ":a:b:i:m:n:r:s:w:" opt ; do
|
||||
case $opt in
|
||||
a) SSIDA="$OPTARG" ;;
|
||||
b) SSIDB="$OPTARG" ;;
|
||||
i) iterations="$OPTARG" ;;
|
||||
m) manager="$OPTARG" ;;
|
||||
n) naptime="$OPTARG" ;;
|
||||
r) resource="$OPTARG" ;;
|
||||
s) stations="$OPTARG" ;;
|
||||
w) wiphy="$OPTARG" ;;
|
||||
esac
|
||||
done
|
||||
[ -z "$stations" ] && {
|
||||
echo "-s: stations, requires {begin,...end} for stations;"
|
||||
echo "$usage"
|
||||
exit 1
|
||||
}
|
||||
|
||||
sta_start=0
|
||||
sta_end=0;
|
||||
IFS="," sta_hunks=($stations);
|
||||
unset IFS
|
||||
#if [ ${#sta_hunks[@]} -gt 1 ] ; then
|
||||
# sta_start=${sta_hunks[0]}
|
||||
# sta_end=${sta_hunks[1]}
|
||||
#else
|
||||
# sta_start=${sta_hunks[0]}
|
||||
# sta_end=${sta_hunks[0]}
|
||||
#fi
|
||||
|
||||
[ -z "$naptime" ] && {
|
||||
echo "-n: naptime required: seconds between changing ssids"
|
||||
echo "$usage"
|
||||
exit 1
|
||||
}
|
||||
|
||||
[ -z "$iterations" ] && {
|
||||
echo "-i: iterations to switch ssids"
|
||||
echo "$usage"
|
||||
exit 1
|
||||
}
|
||||
|
||||
[ $iterations -lt 0 ] && {
|
||||
echo "-i: positive number of iterations only, please"
|
||||
exit 1;
|
||||
}
|
||||
|
||||
[ $iterations -eq 0 ] && {
|
||||
echo "Infinite iterations selected."
|
||||
infinite=1;
|
||||
}
|
||||
|
||||
[ -z "$SSIDB" ] && {
|
||||
echo "-b: SSID B required"
|
||||
echo "$usage"
|
||||
exit 1
|
||||
}
|
||||
|
||||
[ -z "$SSIDA" ] && {
|
||||
echo "-a: SSID A required"
|
||||
echo "$usage"
|
||||
exit 1
|
||||
}
|
||||
|
||||
[ -z "$resource" ] && {
|
||||
echo "-r: resource number for radio owning the station to modify"
|
||||
echo "$usage"
|
||||
exit 1
|
||||
}
|
||||
|
||||
[ -z "$wiphy" ] && {
|
||||
echo "-w: wiphy radio owning the station"
|
||||
echo "$usage"
|
||||
exit 1;
|
||||
}
|
||||
|
||||
[ -z "$manager" ] && {
|
||||
echo "-m: ip address of LANforge manager "
|
||||
echo "$usage"
|
||||
exit 1;
|
||||
}
|
||||
use_ssid=0 # 0 := a, 1 := b
|
||||
while [ $infinite == 1 -o $iterations -ge 0 ] ; do
|
||||
for sta in "${sta_hunks[@]}"; do
|
||||
if [ $use_ssid == 0 ]; then
|
||||
newssid=$SSIDA
|
||||
else
|
||||
newssid=$SSIDB
|
||||
fi
|
||||
[ -z "$wiphy" ] && {
|
||||
echo "radio unconfigured, error."
|
||||
exit 1
|
||||
}
|
||||
clicmd="add_sta 1 $resource $wiphy $sta NA $newssid"
|
||||
$modscript --quiet yes --mgr $manager --resource $resource --action do_cmd --cmd "$clicmd"
|
||||
sleep 0.05
|
||||
done
|
||||
|
||||
if [ $use_ssid = 1 ]; then
|
||||
use_ssid=0;
|
||||
else
|
||||
use_ssid=1;
|
||||
fi
|
||||
iterations=$(($iterations - 1))
|
||||
sleep $naptime
|
||||
done
|
||||
|
||||
#eof
|
||||
364
attenuator_series.pl
Executable file
364
attenuator_series.pl
Executable file
@@ -0,0 +1,364 @@
|
||||
#!/usr/bin/perl
|
||||
##
|
||||
## Reads a CSV of attenuator settings and plays them back
|
||||
## Remember that 300 is deci-dB; eg 300: sets a channel to 30.0 dB
|
||||
##
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
use Carp;
|
||||
$SIG{__DIE__} = sub{Carp::confess(@_)};
|
||||
use Getopt::Long;
|
||||
use Net::Telnet;
|
||||
use Time::HiRes qw(usleep);
|
||||
use LANforge::Utils;
|
||||
use LANforge::csv qw();
|
||||
$| = 1;
|
||||
|
||||
our $usage = qq($0: replay a csv file of attenuator values
|
||||
--mgr|m LANforge manager host
|
||||
--file|f CSV file
|
||||
--delay|d Override of %delay variable, milliseconds between applying rows
|
||||
--loop|l Repeat indefinitely
|
||||
--channel|c Override of channels variable, eg: 1.2.3.1,2.3.4.3
|
||||
--minimum|min|i Set minimum attenuation value (not lower than zero)
|
||||
--maximum|max|x Set maximum attenuation value (not higher than 955)
|
||||
--dry_run|dryrun|dry|n Do not apply attenuation, just parse file, ignore nap times
|
||||
|
||||
Example that works on localhost manager:
|
||||
$0 --file values.csv
|
||||
|
||||
Example that overrides delay to 1600, overrides channels and runs once:
|
||||
$0 --mgr 192.168.101.1 --file values.csv --delay 1600 --channel 1.1.3.1,1.1.3.2,1.1.3.3
|
||||
|
||||
Example that overrides delay to 600ms, loops forever, and overrides min and max attenuation
|
||||
$0 -m 192.168.101.1 -f values.csv -d 600 -l -min 10 -max 900
|
||||
|
||||
File Format:
|
||||
# < comment lines are ignored
|
||||
# 60 milliseconds between rows
|
||||
delay,60
|
||||
# Directives: DELAY,delay and naptime are equivalent
|
||||
# Sets minimum and maximum attenuation for all channels
|
||||
min,10
|
||||
max,900
|
||||
# Directives: MINIMUM,MAXIMUM,MIN,MAX,minimum,min,maximum and max are allowed
|
||||
|
||||
# The next line defines column B as attenuator channel 1.1.13.1
|
||||
# and column C as attenuator channel 2.1.25.1. Remember that
|
||||
# attennuator channels are values (shelf).(resource).(serialno).(channel)
|
||||
# and channels are presently values {1, 2, 3, 4}.
|
||||
channels,1.1.13.1,2.1.25.1
|
||||
# Directives: CHANNELS,channels are equivalent
|
||||
|
||||
# Attenuation values are in deci-dBm, resolution of 5ddB:
|
||||
# The next line sets 1.1.13.1 to 36.5dB, 2.1.25.1 to 30.0dB:
|
||||
attenuate,365,300
|
||||
# Directives: ATTENUATE,attenuate, "", and _ are equivalent.
|
||||
|
||||
# The next line leaves 1.1.13.1 alone, sets 2.1.25.1 to 31.0dB,
|
||||
# _ is an abbreviation for attenuate
|
||||
_,NA,+10
|
||||
# The next line leaves 1.1.13.1 alone, sets 2.1.25.1 to 30.5dB,
|
||||
# Blank first column is an abbreviation for attenuate
|
||||
,NA,-5
|
||||
|
||||
# Only some basic CSV formulas are interpretable, and only operate
|
||||
# on the previous values of the attenuator; the next line sets
|
||||
# sets 1.1.13.1 to 36.0dB, sets 2.1.25.1 to 31.0dB
|
||||
,=B6-5,=C6+5
|
||||
|
||||
# does nothing for a period
|
||||
_,_,NA,,
|
||||
|
||||
# does nothing for 35ms
|
||||
sleep,35
|
||||
# Directives: SLEEP,sleep, and nap are equivalent
|
||||
);
|
||||
|
||||
|
||||
our $csvfile = undef;
|
||||
our $delay = -1;
|
||||
our $delay_override = -1;
|
||||
our $do_loop = 0;
|
||||
our @channels = (); # in order list of channels
|
||||
our %last_atten = (); # a map of last-known values
|
||||
our $channel_override= undef;
|
||||
our $quiet = "yes";
|
||||
our $line = 0; # line number
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
our $dryrun = 0;
|
||||
our $min_atten = 0;
|
||||
our $max_atten = 995;
|
||||
|
||||
GetOptions (
|
||||
'manager|mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port|port|p=i' => \$::lfmgr_port,
|
||||
'file|f=s' => \$::csvfile,
|
||||
'delay|d=i' => \$::delay_override,
|
||||
'loop|l' => \$::do_loop,
|
||||
'channels|c' => \$::channel_override,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'dry_run|dry|n' => \$::dryrun,
|
||||
'minimum|min|mn|i=i' => \$::min_atten,
|
||||
'maximum|max|mx|x=i' => \$::max_atten,
|
||||
) || die("$::usage");
|
||||
|
||||
die("Please specify a manager address;\n$::usage")
|
||||
if (!defined $::lfmgr_host || "$::lfmgr_host" eq "");
|
||||
|
||||
die("Please specify a csv file;\n$::usage")
|
||||
if (!defined $::csvfile || "$::csvfile" eq "");
|
||||
|
||||
die("Unable to find csv file: $::csvfile")
|
||||
unless(-f $::csvfile );
|
||||
|
||||
our $cfile=new LANforge::csv();
|
||||
$::cfile->readFile($::csvfile);
|
||||
|
||||
if ($::cfile->numRows < 1) {
|
||||
die( "empty file, nothing to do");
|
||||
}
|
||||
|
||||
if ($::quiet eq "1" ) {
|
||||
$::quiet = "yes";
|
||||
}
|
||||
elsif ($::quiet eq "0" ) {
|
||||
$::quiet = "no";
|
||||
}
|
||||
|
||||
if (defined $::channel_override && "$::channel_override" != "") {
|
||||
for my $c ( split(/,/, $::channel_override)) {
|
||||
push(@::channels, $c);
|
||||
$::last_atten{$c} = 0;
|
||||
}
|
||||
}
|
||||
|
||||
die("Minimum attenuation must be between [0-954]")
|
||||
if ($::min_atten > 994 || $::min_atten < 0);
|
||||
die("Maximum attenuation must be between [1-995]")
|
||||
if ($::max_atten > 995 || $::max_atten < 1);
|
||||
die("Minimum attenuation must be less than maximum attenuation")
|
||||
if ($::max_atten <= $::min_atten);
|
||||
|
||||
sub lastAtten {
|
||||
my $arg = shift;
|
||||
die ("lastAtten: called without argument")
|
||||
if (! defined $arg || "$arg" eq "");
|
||||
if ($arg =~ /^\d+$/) {
|
||||
if (!defined($::channels[$arg])) {
|
||||
warn "Channels: ".join(', ', @::channels);
|
||||
die ("no channel recorded at position $arg");
|
||||
}
|
||||
die ("no channel [$::channels[$arg]]")
|
||||
if (!defined $::last_atten{$::channels[$arg]});
|
||||
|
||||
return $::last_atten{$::channels[$arg]};
|
||||
}
|
||||
elsif ($arg =~ /^\d+\.\d+\.\d+\.\d+$/) {
|
||||
die ("no channel [$::channels[$arg]]")
|
||||
if (!defined $::last_atten{$::channels[$arg]});
|
||||
|
||||
return $::last_atten{$arg};
|
||||
}
|
||||
die ("lastAtten: What is channel $arg?");
|
||||
}
|
||||
|
||||
sub attenuate {
|
||||
my $channel = shift;
|
||||
my $value = shift;
|
||||
|
||||
die("attenuate: no line number")
|
||||
if (!defined $::line || "$::line" eq "");
|
||||
die("attenuate: $::line: no channel")
|
||||
if (!defined $channel || "$channel" eq "");
|
||||
|
||||
return if (!defined $value || "$value" eq "");
|
||||
return if (lc($value) =~ /^(na|_)$/);
|
||||
return if (lc($value) =~ /^\s*[!;\#]/);
|
||||
|
||||
my ($shelf, $resource, $serno, $chan) = split(/\./, $channel);
|
||||
#print "shelf:$shelf, r:$resource, ser:$serno, ch:$chan\n";
|
||||
die( "[$::line] attenuate: shelf misconfigured:[$channel][$value]")
|
||||
if ($shelf != 1);
|
||||
|
||||
die( "[$::line] attenuate: resource misconfigured:[$channel][$value]")
|
||||
if ($resource < 1);
|
||||
|
||||
die( "[$::line] attenuate: serial number misconfigured:[$channel][$value]")
|
||||
if ($serno < 1);
|
||||
|
||||
die( "[$::line] attenuate: channel misconfigured:[$channel][$value]")
|
||||
if ($chan < 0 || $chan > 4);
|
||||
|
||||
my $prev_value = $::last_atten{$channel};
|
||||
if ($value =~ /^[-+]/) {
|
||||
die("[$::line] attenuate: no previous value set for $channel")
|
||||
if (! defined $prev_value);
|
||||
|
||||
$value = $prev_value + (0+$value);
|
||||
#warn "VALUE MATH[$value] ";
|
||||
}
|
||||
|
||||
if ($value > $::max_atten) {
|
||||
warn("[$::line] attenuate: value cannot be higher than $::max_atten")
|
||||
unless($::quiet eq "yes");
|
||||
$value = $::max_atten;
|
||||
}
|
||||
|
||||
if ($value < $::min_atten) {
|
||||
warn("[$::line] attenuate: value cannot be lower than $::min_atten")
|
||||
unless($::quiet eq "yes");
|
||||
$value = $::min_atten;
|
||||
}
|
||||
|
||||
$::last_atten{$channel} = $value;
|
||||
$::utils->doAsyncCmd("set_atten $shelf $resource $serno $chan $value")
|
||||
unless (defined $::dryrun && $::dryrun);
|
||||
|
||||
print "$::line: set_atten $shelf.$resource.$serno.$chan $value\n"
|
||||
if ($::quiet ne "yes" || $::dryrun);
|
||||
}
|
||||
##
|
||||
## M A I N
|
||||
##
|
||||
|
||||
# connect to manager
|
||||
|
||||
our $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 60);
|
||||
$t->open(Host => $::lfmgr_host,
|
||||
Port => $::lfmgr_port,
|
||||
Timeout => 10);
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
our $utils = new LANforge::Utils();
|
||||
$::utils->telnet($t); # Set our telnet object.
|
||||
if ($::quiet eq "yes") {
|
||||
$::utils->cli_send_silent(1); # Do show input to CLI
|
||||
$::utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(0); # Do show input to CLI
|
||||
$::utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
|
||||
if (defined $::delay_override && $::delay_override != -1 && $::delay_override < 1000) {
|
||||
warn("$0: --delay is in milliseconds, values less than 1000 (1 second) might be meaningless");
|
||||
sleep 2;
|
||||
}
|
||||
die ("$0: --delay of zero or less is not permitted.")
|
||||
if (defined $::delay_override && $::delay_override != -1 && $::delay_override <= 0);
|
||||
|
||||
$::delay = $::delay_override if (defined $::delay_override && $::delay_override > 0);
|
||||
|
||||
my $loop_count = 0;
|
||||
while ($loop_count == 0 || $::do_loop) {
|
||||
$loop_count++;
|
||||
for (my $rownum = 0; $rownum < $::cfile->numRows(); $rownum++) {
|
||||
$::line = $rownum+1;
|
||||
my $ra_row = $::cfile->getRow($rownum);
|
||||
|
||||
next if (@{$ra_row} == 0); # empty row
|
||||
|
||||
if (lc($ra_row->[0]) =~ /^(delay|naptime)$/) {
|
||||
next if (defined $::delay_override && $::delay_override != -1);
|
||||
|
||||
$::delay = 0 + $ra_row->[1];
|
||||
die ("$line: delay of zero or less is not permitted")
|
||||
if ($::delay <= 0);
|
||||
next;
|
||||
}
|
||||
|
||||
if (lc($ra_row->[0]) =~ /^channels$/ && (!defined $::channel_override)) {
|
||||
my @tempchannels = @$ra_row;
|
||||
shift @tempchannels;
|
||||
%::last_atten= ();
|
||||
for my $c (@tempchannels) {
|
||||
push(@::channels, $c);
|
||||
$::last_atten{$c} = -1;
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
if (lc($ra_row->[0]) =~ /^(sleep|nap)$/) {
|
||||
if (!defined $ra_row->[1] || (0 + $ra_row->[1]) < 1) {
|
||||
die("$line: sleep value needs to be 1ms or greater");
|
||||
}
|
||||
usleep($ra_row->[1] *1000) unless ($::dryrun);
|
||||
next;
|
||||
}
|
||||
|
||||
if (lc($ra_row->[0]) =~ /^(attenuate|_)$/ || $ra_row->[0] eq "") {
|
||||
#print "\n";
|
||||
my $col = 1;
|
||||
foreach my $ch (@::channels) {
|
||||
my $value = "NA";
|
||||
my $data = $::cfile->getCell($col, $rownum, "na");
|
||||
#print "DATA($col,$::line)[$data] ";
|
||||
|
||||
if (!defined $data || "$data" eq "" ) {
|
||||
$col++;
|
||||
next;
|
||||
}
|
||||
if (lc($data) =~ /^(na|_)$/ || $data =~ /^\s*\#.*$/) {
|
||||
#warn ("skipping data[$data] at $col,$::line");
|
||||
$col++;
|
||||
next;
|
||||
}
|
||||
if ($data =~ /^\d+$/) {
|
||||
$value = 0 + $data;
|
||||
}
|
||||
elsif ($data =~ /^=[B-Z]\d+[+-]\d+$/i) { # we have a formula
|
||||
my ($acol,$arow,$delta) = $data =~ /^=([B-Z])(\d+)([+-]\d+)$/i;
|
||||
$acol = ord(uc($acol)) - 65;
|
||||
my $pval = $::cfile->getCell($acol, $arow-1, 0);
|
||||
if (!defined $pval) {
|
||||
$pval = lastAtten($col-1);# $::last_atten{$::channels[$col]};
|
||||
warn("Failed to find valid references at cell[$col,$::line], using previous attenuation:".$pval);
|
||||
}
|
||||
if ( $pval !~ /^\d+$/) {
|
||||
$value = lastAtten($col-1);# $::last_atten{$::channels[$col]};
|
||||
die("Failed to find valid references at cell[$col,$::line]:".$value)
|
||||
if ( ! defined $value);
|
||||
|
||||
#$value = $value + (0+$delta);
|
||||
warn "Substituting [$value]: cell[$col,$::line] refers to cell[$acol,$arow] with non absolute value:$pval";
|
||||
}
|
||||
else {
|
||||
$value = $pval + (0 + $delta);
|
||||
}
|
||||
#print "acol[$acol] arow[$arow] delta[$delta] pval[$pval] value[$value]\n";
|
||||
}
|
||||
elsif ($data =~ /^\@?[+]+\d+$/ ) { # add relative
|
||||
my ($delta) = $data =~ /^\@?[+]+(\d+)$/;
|
||||
my $pval = lastAtten($col-1); #$::last_atten{$::channels[$col]};
|
||||
$value = $pval + (0 + $delta);
|
||||
}
|
||||
elsif ( $data =~ /^\@?[-]+\d+$/ ) { # subtract relative
|
||||
my ($delta) = $data =~ /^\@?[-]+(\d+)$/;
|
||||
my $pval = lastAtten($col-1); #$::last_atten{$::channels[$col]};
|
||||
$value = $pval + (-1 * (0 + $delta));
|
||||
}
|
||||
else {
|
||||
warn "Unknown directive[$data] ";
|
||||
$col++;
|
||||
next;
|
||||
}
|
||||
attenuate($ch, "$value");
|
||||
$col++;
|
||||
}
|
||||
|
||||
die("Step delay not set correctly[$::delay]")
|
||||
if (!defined $::delay || "$::delay" eq "" || (0+$::delay) < 1);
|
||||
|
||||
usleep($::delay * 1000) unless ($::dryrun);
|
||||
next
|
||||
}
|
||||
die("$::line: unknown directive[".$ra_row->[0]);
|
||||
}
|
||||
}
|
||||
|
||||
## eof
|
||||
61
brent_showport.sh
Executable file
61
brent_showport.sh
Executable file
@@ -0,0 +1,61 @@
|
||||
#!/bin/bash
|
||||
|
||||
mgr="192.168.100.86"
|
||||
|
||||
./lf_portmod.pl --manager $mgr --load port-regression > /dev/null
|
||||
sleep 10s
|
||||
|
||||
for x in vap0 sta0 eth1#0 eth1 eth1.1 rddVR0 br0
|
||||
do
|
||||
#Test MAC
|
||||
port_output=`./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --show_port MAC`
|
||||
answer=${port_output:5}
|
||||
# echo "MAC exists: $x $answer
|
||||
if [ -z "$answer" ]; then
|
||||
echo "Failed to find MAC address for $x."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
#Test port UP
|
||||
port_output=`./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --show_port Current`
|
||||
answer=${port_output:9:2}
|
||||
# echo "DB UP: $x $answer"
|
||||
if [ $answer != "UP" ]; then
|
||||
echo "Failed, port $x is down after loading DB."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
#Test port UP after reset
|
||||
./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --cmd reset > /dev/null
|
||||
sleep 2s
|
||||
port_output=`./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --show_port Current`
|
||||
answer=${port_output:9:2}
|
||||
# echo "UP after reset: $x $answer"
|
||||
if [ $answer != "UP" ]; then
|
||||
echo "Failed, port $x is down after resetting."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
#Test DOWN after ifdown
|
||||
./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --set_ifstate down
|
||||
port_output=`./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --show_port Current`
|
||||
answer=${port_output:9:4}
|
||||
# echo "DOWN after ifdown: $x $answer"
|
||||
if [ $answer != "DOWN" ]; then
|
||||
echo "Failed, port $x is still up after ifdown."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
#Test UP after ifup
|
||||
./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --set_ifstate up
|
||||
sleep 5s
|
||||
port_output=`./lf_portmod.pl --quiet 1 --manager $mgr --card 2 --port_name $x --show_port Current`
|
||||
answer=${port_output:9:2}
|
||||
# echo "UP after ifup: $x $answer"
|
||||
if [ $answer != "UP" ]; then
|
||||
echo "Failed, port $x is still down after ifup."
|
||||
exit 1
|
||||
fi
|
||||
done
|
||||
|
||||
echo "Test passed."
|
||||
101
create-mounts.sh
Executable file
101
create-mounts.sh
Executable file
@@ -0,0 +1,101 @@
|
||||
#!/bin/bash
|
||||
#set -x
|
||||
|
||||
CIFS_USERNAME="lanforge"
|
||||
CIFS_PASSWORD="lanforge"
|
||||
NFS_SRV="192.168.100.3"
|
||||
NFS_PATH="/mnt/d2"
|
||||
CIFS_SRV="192.168.100.3"
|
||||
CIF_PATH="/mnt/d2"
|
||||
LOCAL_MOUNT_PATH="/mnt"
|
||||
NFS_OPTS=""
|
||||
|
||||
if [ $# -lt 4 ]; then
|
||||
echo "Usage: `basename $0` NFS|CIFS <ethN> <first_mvlan> <last_mvlan> <server server-path local-mnt-path>"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
|
||||
IF=$2
|
||||
MV_START=$3
|
||||
MV_STOP=$4
|
||||
if [ ! -z "$5" ]
|
||||
then
|
||||
NFS_SRV=$5
|
||||
CIFS_SRV=$5
|
||||
fi
|
||||
|
||||
if [ ! -z "$6" ]
|
||||
then
|
||||
NFS_PATH=$6
|
||||
CIFS_PATH=$6
|
||||
fi
|
||||
|
||||
if [ ! -z "$7" ]
|
||||
then
|
||||
LOCAL_MOUNT_PATH=$7
|
||||
fi
|
||||
|
||||
if [ $1 = "CIFS" ]; then
|
||||
LOCAL_PATH="$LOCAL_MOUNT_PATH/cifs_${IF}#"
|
||||
CIFS_OPTS="username=$CIFS_USERNAME,password=$CIFS_PASSWORD,$CIFS_OPTS"
|
||||
else
|
||||
LOCAL_PATH="$LOCAL_MOUNT_PATH/nfs_${IF}#"
|
||||
fi
|
||||
|
||||
LIP=clientaddr
|
||||
if uname -a | grep 2.6.20
|
||||
then
|
||||
LIP=local_ip
|
||||
fi
|
||||
|
||||
for ((m=MV_START; m <= MV_STOP ; m++))
|
||||
do
|
||||
if [ `ifconfig $IF#$m > /dev/null 2>&1; echo $?` -eq "1" ]; then
|
||||
echo "*** MISSING INTERFACE: $IF#$m"
|
||||
echo
|
||||
elif [ `ifconfig $IF#$m | grep "inet addr" > /dev/null; echo $?` -eq "1" ]; then
|
||||
echo "*** MISSING IP ADDRESS ON INTERFACE: $IF#$m"
|
||||
else
|
||||
if [ ! -d "$LOCAL_PATH$m" ]; then
|
||||
echo "mkdir -p $LOCAL_PATH$m"
|
||||
mkdir -p $LOCAL_PATH$m
|
||||
fi
|
||||
IPADDR=`ifconfig $IF#$m | grep "inet addr" | awk -F":" '{ print $2}' |\
|
||||
awk '{ print $1}'`
|
||||
# Ping seems to fail sometimes..probably file-server is under too much load or something
|
||||
# so try the ping up to 5 times.
|
||||
for ((q=0;q<5;q+=1))
|
||||
do
|
||||
if [ `ping -c 1 -w 1 -I $IPADDR $NFS_SRV > /dev/null; echo $?` -eq "0" ]; then
|
||||
q=10; # done
|
||||
if [ $1 = "CIFS" ]; then
|
||||
echo "mount -t cifs -o local_ip=$IPADDR,$CIFS_OPTS //$CIFS_SRV$CIFS_PATH $LOCAL_PATH$m"
|
||||
if [ `mount -t cifs -o local_ip=$IPADDR,$CIFS_OPTS //$CIFS_SRV$CIFS_PATH $LOCAL_PATH$m >\
|
||||
/dev/null; echo $?` -ne "0" ]; then
|
||||
echo
|
||||
fi
|
||||
else
|
||||
echo "mount -t nfs -o $LIP=$IPADDR,$NFS_OPTS $NFS_SRV:$NFS_PATH $LOCAL_PATH$m"
|
||||
if [ `mount -t nfs -o $LIP=$IPADDR,$NFS_OPTS $NFS_SRV:$NFS_PATH $LOCAL_PATH$m >\
|
||||
/dev/null; echo $?` -ne "0" ]; then
|
||||
echo
|
||||
fi
|
||||
fi
|
||||
else
|
||||
echo "*** UNABLE TO PING: $NFS_SRV FROM: $IF#$m, $IPADDR"
|
||||
fi
|
||||
done
|
||||
fi
|
||||
done
|
||||
echo "********************************************"
|
||||
if [ $1 = "CIFS" ]; then
|
||||
echo "Total number of mounts according to 'mount': `mount | grep "$CIFS_SRV$CIFS_PATH" |\
|
||||
grep "$LOCAL_PATH" | grep "type cifs" |\
|
||||
wc | awk '{ print $1 }'`"
|
||||
else
|
||||
echo "Total number of NFS mounts according to 'mount': `mount | grep "$NFS_SRV:$NFS_PATH" |\
|
||||
grep "$LOCAL_PATH" | grep -i "type $1" | grep "$LIP=" | grep "addr=$NFS_SRV" |\
|
||||
wc | awk '{ print $1 }'`"
|
||||
echo
|
||||
fi
|
||||
68
fanctl_lf0312.pl
Executable file
68
fanctl_lf0312.pl
Executable file
@@ -0,0 +1,68 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
|
||||
$|=1;
|
||||
package main;
|
||||
our $fan_util = "/usr/local/bin/f81866_fan";
|
||||
if ( ! -x $fan_util ) {
|
||||
die "f81866_fan utility $fan_util not found\n";
|
||||
}
|
||||
|
||||
my @sensor_lines_a = `sensors`;
|
||||
chomp(@sensor_lines_a);
|
||||
my @sensor_lines_b = grep ! /^\s*$/, @sensor_lines_a;
|
||||
@sensor_lines_a = grep ! /^(Physical id|Core|coretemp|Adapter: ISA adapter)/, @sensor_lines_b;
|
||||
|
||||
#print ("Found: ".join("\n", @sensor_lines_a));
|
||||
my $found_a10k = 0;
|
||||
my $temp = 0;
|
||||
my $maxtemp = 0;
|
||||
for my $line (@sensor_lines_a) {
|
||||
if ($line =~ /^ath10k_hwmon-pci.*/) {
|
||||
#print "found a10k! $line\n";
|
||||
$found_a10k = 1;
|
||||
}
|
||||
if ($found_a10k && $line =~ /temp1:\s+([^ ]+).*$/) {
|
||||
#print "found a10k: $line\n";
|
||||
if ($1 ne "N/A") {
|
||||
($temp) = $line =~ /[+](\d+\.\d+)/;
|
||||
if (defined $temp && $temp > 40.0) {
|
||||
$maxtemp = $temp if ($temp > $maxtemp);
|
||||
#print "temp($temp) maxtemp($maxtemp)\n";
|
||||
}
|
||||
$temp = 0;
|
||||
}
|
||||
$found_a10k = 0;
|
||||
}
|
||||
}
|
||||
|
||||
my $duty = 0;
|
||||
if ($maxtemp < 40) {
|
||||
$duty = 0;
|
||||
}
|
||||
elsif ($maxtemp < 50) {
|
||||
$duty = 50;
|
||||
}
|
||||
elsif ($maxtemp < 56) {
|
||||
$duty = 55;
|
||||
}
|
||||
elsif ($maxtemp < 60) {
|
||||
$duty = 60;
|
||||
}
|
||||
elsif ($maxtemp < 70) {
|
||||
$duty = 70;
|
||||
}
|
||||
elsif ($maxtemp < 80) {
|
||||
$duty = 80;
|
||||
}
|
||||
elsif ($maxtemp >= 80) {
|
||||
$duty = 100;
|
||||
}
|
||||
|
||||
#print "[$maxtemp]C -> duty[$duty]\n";
|
||||
system("/usr/bin/logger -t fanctl_lf0312 'temp:$maxtemp C, duty:$duty'");
|
||||
exec("$fan_util $duty");
|
||||
|
||||
#
|
||||
105
ftp-upload.pl
Executable file
105
ftp-upload.pl
Executable file
@@ -0,0 +1,105 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
|
||||
##
|
||||
## Use this script to collect and upload station data
|
||||
## to an FTP host.
|
||||
##
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Getopt::Long;
|
||||
use Socket;
|
||||
use Cwd;
|
||||
use Net::FTP;
|
||||
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
|
||||
$| = 1;
|
||||
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
|
||||
our $def_user = 'anonymous';
|
||||
our $def_pass = 'anonymous';
|
||||
our $def_srcdir = Cwd::getcwd();
|
||||
our $def_destdir = '/WIN7_LanForge_Data/';
|
||||
our $def_ftphost = "192.168.1.222";
|
||||
our @file_list = ();
|
||||
our $verbose = 0;
|
||||
our $debug = 0;
|
||||
our $username = $def_user;
|
||||
our $password = $def_pass;
|
||||
our $ftp_host = $def_ftphost;
|
||||
our $srcdir = $def_srcdir;
|
||||
our $destdir = $def_destdir;
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
|
||||
our $usage = "\n$0:
|
||||
--user username [$def_user]
|
||||
--passwd password [$def_pass]
|
||||
--srcdir sourcedir [$def_srcdir]
|
||||
--host host [$def_ftphost]
|
||||
--destdir destdir [$def_destdir]
|
||||
--verbose=1 [$verbose]
|
||||
--debug=1 [$debug]
|
||||
-- file1 file2 ... fileN # use -- to start a list of files or globs on cmdline
|
||||
";
|
||||
|
||||
GetOptions (
|
||||
'user|u=s' => \$::username,
|
||||
'passwd|p=s' => \$::password,
|
||||
'host|h=s' => \$::ftp_host,
|
||||
'srcdir|s=s' => \$::srcdir,
|
||||
'destdir|t=s' => \$::destdir,
|
||||
'verbose|v=n' => \$::verbose,
|
||||
'debug|d=n' => \$::debug
|
||||
) || die($usage);
|
||||
|
||||
die "Cannot open $srcdir " if ( ! -e $srcdir );
|
||||
|
||||
if (@ARGV > 0) {
|
||||
# we were passed -- file1 file2 ... fileN on commandline
|
||||
print "Checking files listed on command line...\n" if ($verbose);
|
||||
for my $filename (@ARGV) {
|
||||
if ($filename =~ /(\*|\?|\{\n)/) {
|
||||
my @expanded = glob("$srcdir/$filename");
|
||||
for my $filename2 (@expanded) {
|
||||
if ( -e $filename2 ) {
|
||||
push(@file_list, $filename2);
|
||||
}
|
||||
else {
|
||||
print STDERR "File $filename2 not found\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( -e "$srcdir/$filename" ) {
|
||||
push(@file_list, "$srcdir/$filename");
|
||||
}
|
||||
else {
|
||||
print STDERR "File $srcdir/$filename not found\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# we were just given a directory
|
||||
print "Looking for 'sta*.csv' files in $srcdir...\n" if ($verbose);
|
||||
@file_list = glob("$srcdir/sta*.csv");
|
||||
}
|
||||
|
||||
die "No CSV files present in $srcdir" if (@file_list < 1);
|
||||
my $ftp_server = Net::FTP->new($ftp_host,
|
||||
Debug=>$debug,
|
||||
Timeout=>15,
|
||||
Port=>21,
|
||||
Passive=>0)
|
||||
or die "Can't open $ftp_host\n";
|
||||
|
||||
$ftp_server->login($username, $password) or die "Can't log $username in\n";
|
||||
$ftp_server->cwd($destdir) or die "Unable to cd to $destdir\n";
|
||||
|
||||
for my $filename (@file_list) {
|
||||
print "uploading $filename\n" if ($verbose);
|
||||
$ftp_server->put($filename) or die "Unable to upload $filename\n";
|
||||
}
|
||||
##
|
||||
## eof
|
||||
##
|
||||
460
imix.pl
Executable file
460
imix.pl
Executable file
@@ -0,0 +1,460 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
# IMIX Throughput Test
|
||||
#
|
||||
# Uses a binary search algorithm to determine the maximum throughput at which
|
||||
# a specified percent packet loss occurs and a maximum latency is allowed
|
||||
# for a given theoretical throughput rate at different packet sizes suggested
|
||||
# by IMIX literature.
|
||||
#
|
||||
# USAGE: perl imix.pl lf_host port-1 port-2 theoretical_rate max_latency
|
||||
# max_drop_percentage binary_search_attempts endpoint_duration test_loops
|
||||
#
|
||||
# Example: perl imix.pl 192.168.100.192 1 2 10000000 200 10 9 10 1
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use LANforge::Endpoint;
|
||||
|
||||
my $script_name = "imix.pl";
|
||||
|
||||
my $lfmgr_host = undef;
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $test_mgr = "imix_tm";
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
# This sets up connections between 2 LANforge machines
|
||||
my $lf1 = 1; # Minor Resource EID.
|
||||
my $lf2 = 1; # Set to "" or same as $lf1 if we have no second machine. For second machine set
|
||||
# to second Resource minor EID to create mac-vlans on it.
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# i.e. the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
# EIDs or aliases can be used.
|
||||
# Port pairs must match on each shelf - will enhance to allow any pair on each shelf.
|
||||
#my @lf1_ports = (1); #, 2, 3);
|
||||
#my @lf2_ports = (2); #, 2, 3);
|
||||
my @lf1_ports = ("eth2"); #, "eth0");
|
||||
my @lf2_ports = ("eth3"); #, "eth1");
|
||||
|
||||
my @lf1_port_ips = ("172.1.1.100");
|
||||
my @lf2_port_ips = ("172.1.1.101");
|
||||
|
||||
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);
|
||||
my @tput_rates = ( 1000000, 4000000, 12000000, 45000000,155000000,155000000,155000000,155000000);
|
||||
|
||||
my $tput = 1544000; # Network/Device Under Test Maximum Theoretical Throughput in bps.
|
||||
|
||||
my $max_latency = 1; # Maximum Latency in miliseconds, allowed before adjusting rate down.
|
||||
my $drop_percent = 0.0001; # Maximum Drop-Percentage allowed before adjusting rate down.
|
||||
|
||||
my $binary_search_attempts = 9; # Number of attempts to find throughput for a given pkt size and $drop_percent.
|
||||
my $endp_wait_for_update = 10; # Seconds allowed for endpoints to update.
|
||||
my $endp_duration = 30; # Seconds endpoints are allowed to run which can affect results.
|
||||
my $loop_max = 1; # Number of times the entire test will be run
|
||||
|
||||
|
||||
my @endp_drops = ();
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
# Parse cmd-line args
|
||||
my $i;
|
||||
for ($i = 0; $i<@ARGV; $i++) {
|
||||
my $var = $ARGV[$i];
|
||||
if ($var =~ m/(\S+)=(.*)/) {
|
||||
my $arg = $1;
|
||||
my $val = $2;
|
||||
handleCmdLineArg($arg, $val);
|
||||
}
|
||||
else {
|
||||
handleCmdLineArg($var);
|
||||
}
|
||||
}
|
||||
|
||||
if ($lfmgr_host == undef) {
|
||||
print "\nYou must define a LANforge Manager!!!\n\n"
|
||||
. "For example:\n"
|
||||
. "./$script_name mgr=locahost\n"
|
||||
. "OR\n"
|
||||
. "./$script_name mgr=192.168.1.101\n\n";
|
||||
printHelp();
|
||||
exit (1);
|
||||
}
|
||||
|
||||
|
||||
my $min_rate = $tput;
|
||||
my $max_rate = $min_rate;
|
||||
|
||||
my $report_timer = 1000; # Report timer for endpoints.
|
||||
|
||||
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 $endp_wait_for_update seconds for endpoints to update.\n";
|
||||
sleep($endp_wait_for_update);
|
||||
|
||||
# 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,0);
|
||||
my @new_rate = (0,0);
|
||||
my $flag = 0;
|
||||
my $best_rate = 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");
|
||||
doCmd("clear_cx_counters");
|
||||
print "Adjustment Period: $adj_count\n";
|
||||
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_drop_seq();
|
||||
my $en2 = $endp1->port_id();
|
||||
my $en3 = $endp1->real_rx_rate();
|
||||
my $lat = $endp1->avg_latency();
|
||||
|
||||
my $i = $p-$p1;
|
||||
if ( $en1 > $drop_percent || $lat > $max_latency ) {
|
||||
print "RATE DOWN: Percent Dropped is $en1 : Port 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 "RATE UP: Percent Dropped is $en1 : Port is $en2 : Real RX Rate is: $en3 : Latency: $lat\n";
|
||||
$last_current_rate[$i] = $current_rate[$i];
|
||||
$new_rate[$i] = $current_rate[$i] + $next_adj[$i];
|
||||
}
|
||||
else {
|
||||
# packet size is too small for this LF system to generate at this rate
|
||||
# TO DO: make an imix script that uses armageddon instead of user-space UDP
|
||||
$best_rate = $en3;
|
||||
$flag = 1;
|
||||
$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(5);
|
||||
|
||||
# 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");
|
||||
|
||||
if ( $flag != 1 ) {
|
||||
print "\n\n*********************************************************\n";
|
||||
print "Theoretical Throughput: $max_rate bps.\n";
|
||||
print "IMIX Packet Size: $min_pkt_szs[$q] byte payload.\n";
|
||||
print "Loss and Latency Allowance: $drop_percent % drops and $max_latency ms latency.\n";
|
||||
print "Measured Throughput on Endpoint 1: $last_current_rate[0] bps.\n";
|
||||
print "Measured Throughput on Endpoint 2: $last_current_rate[1] bps.\n\n";
|
||||
sleep(10);
|
||||
}
|
||||
else {
|
||||
print "\n\nMax Rate of $max_rate bps is too high for $min_pkt_szs[$q] byte packet size.\n";
|
||||
print "At $min_pkt_szs[$q] byte packet size, the best user-space rate is: $best_rate bps.\n\n";
|
||||
}
|
||||
} #for cross-connects
|
||||
} #for $loop_max
|
||||
|
||||
initPortsToDefault();
|
||||
|
||||
$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
|
||||
|
||||
# Wait until 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 card: $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;
|
||||
for ($i = 0; $i<$mx; $i++) {
|
||||
if ($ports[$i]->isMacVlan()) {
|
||||
doCmd($ports[$i]->getDeleteCmd());
|
||||
} #fi isMacVlan
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
sub printHelp {
|
||||
print "\n"
|
||||
. "USAGE: mgr=[ip-of-mgr] lf1=X lf2=Y\n"
|
||||
. " lf1_ports=[\"1 2 3\"|\"eth2 eth3\"] lf2_ports=[\"4 5 6\"|\"eth4 eth5\"]\n"
|
||||
. " rate=1544000 (bps) max_delay=1 (ms) max_drop=0.0001 (%) search_tries=9\n"
|
||||
. " ep_wait=10 (s) ep_run=30 (s) imix_loops=1\n"
|
||||
. "\n";
|
||||
|
||||
}
|
||||
|
||||
sub handleCmdLineArg {
|
||||
my $arg = $_[0];
|
||||
my $val = $_[1];
|
||||
|
||||
if ($arg eq "mgr") {
|
||||
$lfmgr_host = $val;
|
||||
}
|
||||
elsif ($arg eq "lf1") {
|
||||
$lf1 = $val;
|
||||
}
|
||||
elsif ($arg eq "lf2") {
|
||||
$lf2 = $val;
|
||||
}
|
||||
elsif ($arg eq "lf1_ports") {
|
||||
@lf1_ports = split(/ /, $val);
|
||||
}
|
||||
elsif ($arg eq "lf2_ports") {
|
||||
@lf2_ports = split(/ /, $val);
|
||||
}
|
||||
elsif ($arg eq "rate") {
|
||||
$tput = $val;
|
||||
}
|
||||
elsif ($arg eq "max_delay") {
|
||||
$max_latency = $val;
|
||||
}
|
||||
elsif ($arg eq "max_drop") {
|
||||
$drop_percent = $val;
|
||||
}
|
||||
elsif ($arg eq "search_tries") {
|
||||
$binary_search_attempts = $val;
|
||||
}
|
||||
elsif ($arg eq "ep_wait") {
|
||||
$endp_wait_for_update = $val;
|
||||
}
|
||||
elsif ($arg eq "ep_run") {
|
||||
$endp_duration = $val;
|
||||
}
|
||||
elsif ($arg eq "imix_loops") {
|
||||
$loop_max = $val;
|
||||
}
|
||||
else {
|
||||
printHelp();
|
||||
exit(1);
|
||||
}
|
||||
} # handleCmdLineArg
|
||||
1659
lf_associate_ap.pl
Executable file
1659
lf_associate_ap.pl
Executable file
File diff suppressed because it is too large
Load Diff
129
lf_attenmod.pl
Executable file
129
lf_attenmod.pl
Executable file
@@ -0,0 +1,129 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
# This program is used to modify the LANforge attenuator (through
|
||||
# the LANforge manager/server processes.
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Udated by:
|
||||
#
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Utils;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
|
||||
|
||||
my $resource = 1;
|
||||
my $quiet = "yes";
|
||||
my $atten_serno = "";
|
||||
my $atten_idx = "";
|
||||
my $atten_val = "";
|
||||
my $action = "show_atten";
|
||||
my $do_cmd = "NA";
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
|
||||
my $fail_msg = "";
|
||||
my $manual_check = 0;
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $usage = "$0 --action { show_atten | set_atten | do_cmd } ]
|
||||
[--mgr {host-name | IP}]
|
||||
[--mgr_port {ip port}]
|
||||
[--cmd {lf-cli-command text}]
|
||||
[--atten_serno {serial-num}]
|
||||
[--atten_idx { attenuator-module-index | all}]
|
||||
[--atten_val {0-950 dDbm}]
|
||||
[--quiet { yes | no }]
|
||||
|
||||
Example:
|
||||
$0 --mgr 192.168.100.138 --action set_atten --atten_serno 3 --atten_idx all --atten_val 550\n";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'atten_serno|s=s' => \$atten_serno,
|
||||
'atten_idx|i=s' => \$atten_idx,
|
||||
'atten_val|v=s' => \$atten_val,
|
||||
'action|a=s' => \$action,
|
||||
'cmd|c=s' => \$do_cmd,
|
||||
'mgr|m=s' => \$lfmgr_host,
|
||||
'mgr_port|p=i' => \$lfmgr_port,
|
||||
'resource|r=i' => \$resource,
|
||||
'quiet|q=s' => \$quiet,
|
||||
|
||||
) || (print($usage) && exit(1));
|
||||
|
||||
|
||||
if ($do_cmd ne "NA") {
|
||||
$action = "do_cmd";
|
||||
}
|
||||
|
||||
if (!(($action eq "show_atten") ||
|
||||
($action eq "set_atten") ||
|
||||
($action eq "do_cmd"))) {
|
||||
die("Invalid action: $action\n$usage\n");
|
||||
}
|
||||
|
||||
if ($action eq "set_atten") {
|
||||
if ((length($atten_serno) == 0) ||
|
||||
(length($atten_val) == 0) ||
|
||||
(length($atten_idx) == 0)) {
|
||||
print "ERROR: Must specify atten_serno, atten_idx, and atten_val when setting attenuator.\n";
|
||||
die("$usage");
|
||||
}
|
||||
}
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
# Configure our utils.
|
||||
my $utils = new LANforge::Utils();
|
||||
$utils->telnet($t); # Set our telnet object.
|
||||
if ($quiet eq "yes") {
|
||||
$utils->cli_send_silent(1); # Do show input to CLI
|
||||
$utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$utils->cli_send_silent(0); # Do show input to CLI
|
||||
$utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
if ($action eq "show_atten") {
|
||||
print $utils->doAsyncCmd("show_atten $shelf_num $resource $atten_serno");
|
||||
}
|
||||
elsif ($action eq "set_atten") {
|
||||
print $utils->doAsyncCmd("set_atten $shelf_num $resource $atten_serno $atten_idx $atten_val") . "\n";
|
||||
}
|
||||
elsif ($action eq "do_cmd") {
|
||||
print $utils->doAsyncCmd("$do_cmd") . "\n";
|
||||
}
|
||||
else {
|
||||
die("Unknown action: $action\n$usage\n");
|
||||
}
|
||||
|
||||
exit(0);
|
||||
259
lf_auto_wifi_cap.pl
Executable file
259
lf_auto_wifi_cap.pl
Executable file
@@ -0,0 +1,259 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
# This program is used to automatically run LANforge-GUI WiFi Capacity tests.
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Udated by:
|
||||
#
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
use lib '/home/lanforge/scripts';
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
use Cwd;
|
||||
|
||||
use constant NA => "NA";
|
||||
use constant NL => "\n";
|
||||
use constant shelf_num => 1;
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
our $use_existing_sta = 0;
|
||||
our $resource = 1;
|
||||
our $quiet = "yes";
|
||||
our $radio = ""; # wiphy0
|
||||
our $ssid = "my-ssid";
|
||||
our $num_sta = 64;
|
||||
our $speed_ul = 0;
|
||||
our $ul_ps_rate = 0;
|
||||
our $speed_dl = 100000000;
|
||||
our $dl_ps_rate = 0;
|
||||
our $endp_type = "mix";
|
||||
our $percent_tcp = 50;
|
||||
our $first_ip = "DHCP";
|
||||
our $upstream = "eth1";
|
||||
our $increment = 5;
|
||||
our $duration = 30;
|
||||
our $test_name = "lanforge-wifi-capacity-test";
|
||||
|
||||
our $fail_msg = "";
|
||||
our $manual_check = 0;
|
||||
our $gui_host = "127.0.0.1";
|
||||
our $gui_port = 7777;
|
||||
our $lfmgr_host = "127.0.0.1";
|
||||
our $lfmgr_port = 4001;
|
||||
our @test_text = ();
|
||||
our $use_pdu_mix = "false";
|
||||
our $pdu_percent = "pps";
|
||||
our @pdu_mix = ();
|
||||
our $multicon = -1;
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
our $usage = "$0
|
||||
[--mgr {host-name | IP}]
|
||||
[--mgr_port {ip port}]
|
||||
[--resource {number}]
|
||||
[--gui_host {LANforge gui_host (127.0.0.1)}]
|
||||
[--gui_port {LANforge gui_port (7777)}]
|
||||
[--radio {name,name2,..}] example: wiphy0,wiphy1
|
||||
[--speed_dl {speed in bps}]
|
||||
[--dl_ps_rate {(0) total download rate, 1 download rate per station}]
|
||||
[--speed_ul {speed in bps}]
|
||||
[--ul_ps_rate {(0) total upload rate, 1 upload rate per station}]
|
||||
[--ssid {ssid}]
|
||||
[--num_sta {num-stations-per-radio}] # For each radio.
|
||||
[--use_existing_sta ] # Assume stations are already properly created and do not re-create.
|
||||
[--upstream {upstream-port-name (eth1)}]
|
||||
[--first_ip {first-ip-addr | DHCP}]
|
||||
[--percent_tcp {percent_tcp for mixed traffic type}]
|
||||
[--increment {station-bringup-increment (5)}]
|
||||
[--duration {bringup-step-duration (30)}]
|
||||
[--endp_type { udp, tcp, mix }
|
||||
[--use_pdu_mix { true | (false) }]
|
||||
[--pdu_percent { bps | (pps) }]
|
||||
[--pdu_mix { pdu-size:%, pdu-size:%, ... }]
|
||||
[--test_name { my-test-name}]
|
||||
[--test_text { my-test<br>over the air<br>funky-hardware-x<br>OS z}]
|
||||
[--multicon { -1: auto, 0 none, 1 new process, 2+ new process + multiple streams}
|
||||
[--quiet { yes | no }]
|
||||
|
||||
Example:
|
||||
|
||||
./lf_auto_wifi_cap.pl --mgr ben-ota-1 --resource 2 --radio wiphy0 --speed_dl 500000000 --ssid Lede-ventana --num_sta 64 --upstream eth1 --first_ip DHCP --percent_tcp 50 --increment 1,5,10,20,30,40,50,64 --duration 15 --endp_type mix --test_name ventana-mix-dl --test_text \"Ventana LEDE, WLE900VX<br>over-the-air to LANforge station system 5 feet away<br>LAN to WiFi traffic path\" --multicon 1
|
||||
|
||||
";
|
||||
|
||||
my $i = 0;
|
||||
my $help = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port=i' => \$::lfmgr_port,
|
||||
'gui_host=s' => \$::gui_host,
|
||||
'gui_port=i' => \$::gui_port,
|
||||
'resource=i' => \$::resource,
|
||||
'radio=s' => \$::radio,
|
||||
'speed_ul=i' => \$::speed_ul,
|
||||
'ul_ps_rate=i' => \$::ul_ps_rate,
|
||||
'speed_dl=i' => \$::speed_dl,
|
||||
'dl_ps_rate=i' => \$::dl_ps_rate,
|
||||
'ssid=s' => \$::ssid,
|
||||
'num_sta=i' => \$::num_sta,
|
||||
'use_existing_sta' => \$::use_existing_sta,
|
||||
'upstream=s' => \$::upstream,
|
||||
'first_ip=s' => \$::first_ip,
|
||||
'percent_tcp=i' => \$::percent_tcp,
|
||||
'increment=s' => \$::increment,
|
||||
'duration=i' => \$::duration,
|
||||
'endp_type=s' => \$::endp_type,
|
||||
'test_name=s' => \$::test_name,
|
||||
'multicon=i' => \$::multicon,
|
||||
'test_text=s' => \$::test_text,
|
||||
'use_pdu_mix=s' => \$::use_pdu_mix,
|
||||
'pdu_percent=s' => \$::pdu_percent,
|
||||
'pdu_mix=s' => \$::pdu_mix,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'help' => \$::help,
|
||||
) || die("$::usage");
|
||||
|
||||
if ($::help) {
|
||||
print $::usage;
|
||||
exit(0);
|
||||
}
|
||||
|
||||
my @radios = split(/,/, $::radio);
|
||||
my $starting_sta = 500;
|
||||
my $first_sta = $starting_sta;
|
||||
|
||||
if (@radios == 0) {
|
||||
print ("No radios specified, doing nothing.\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
if (!$::use_existing_sta) {
|
||||
# Clean ports on these radios.
|
||||
for ($i = 0; $i<@radios; $i++) {
|
||||
my $r = $radios[$i];
|
||||
print "Deleting virtual devices on resource $::resource radio: $r\n";
|
||||
system("./lf_associate_ap.pl --mgr $::lfmgr_host --mgr_port $::lfmgr_port --resource $::resource --action del_all_phy --port_del $r");
|
||||
}
|
||||
}
|
||||
|
||||
# Create/Set stations on these radios.
|
||||
for ($i = 0; $i<@radios; $i++) {
|
||||
my $r = $radios[$i];
|
||||
|
||||
print "Creating/Setting $::num_sta virtual stations on resource $::resource radio: $r\n";
|
||||
system("./lf_associate_ap.pl --mgr $::lfmgr_host --mgr_port $::lfmgr_port --resource $::resource --action add --radio $r --ssid $::ssid --first_sta sta$first_sta --first_ip $::first_ip --num_stations $::num_sta --admin_down_on_add");
|
||||
$first_sta += $::num_sta;
|
||||
}
|
||||
|
||||
my $cwd = cwd();
|
||||
my $wifi_cap_fname = "wifi_auto_cap_" . $$ . ".txt";
|
||||
|
||||
# Create temporary wifi capacity config file.
|
||||
open(CAP, ">$wifi_cap_fname") or die ("Can't open $wifi_cap_fname for writing.\n");
|
||||
|
||||
print CAP "__CFG VERSION 1\n";
|
||||
print CAP "__CFG SEL_PORT 1 $::resource $::upstream\n";
|
||||
|
||||
for ($i = $starting_sta; $i<$first_sta; $i++) {
|
||||
print CAP "__CFG SEL_PORT 1 $::resource sta$i\n";
|
||||
}
|
||||
|
||||
print CAP "__CFG STA_INCREMENT $::increment\n";
|
||||
print CAP "__CFG DURATION " . ($::duration * 1000) . "\n";
|
||||
|
||||
my $proto = 0;
|
||||
if ($endp_type eq "tcp") {
|
||||
$proto = 1;
|
||||
}
|
||||
# 2 is layer-4, this script does not support that currently.
|
||||
elsif ($endp_type eq "mix") {
|
||||
$proto = 3;
|
||||
}
|
||||
print CAP "__CFG PROTOCOL $proto\n";
|
||||
print CAP "__CFG DL_RATE_SEL $::dl_ps_rate\n";
|
||||
print CAP "__CFG DL_RATE $::speed_dl\n";
|
||||
print CAP "__CFG UL_RATE_SEL $::ul_ps_rate\n";
|
||||
print CAP "__CFG UL_RATE $::speed_ul\n";
|
||||
print CAP "__CFG PRCNT_TCP " . ($::percent_tcp * 10000) . "\n";
|
||||
print CAP "__CFG MULTI_CONN $::multicon\n";
|
||||
print CAP "__CFG USE_MIX_PDU $::use_pdu_mix\n";
|
||||
|
||||
my $pps = "false";
|
||||
my $bps = "false";
|
||||
if ($pdu_percent eq "pps") {
|
||||
$pps = "true";
|
||||
}
|
||||
elsif ($pdu_percent eq "bps") {
|
||||
$bps = "true";
|
||||
}
|
||||
print CAP "__CFG PDU_PRCNT_PPS $pps\n";
|
||||
print CAP "__CFG PDU_PRCNT_BPS $bps\n";
|
||||
|
||||
my @pdu_mix_ln = split(/,/, $::pdu_mix);
|
||||
for ($i = 0; $i < @pdu_mix_ln; $i++) {
|
||||
print CAP "__CFG PDU_MIX_LN " . $pdu_mix_ln[$i] . "\n";
|
||||
}
|
||||
|
||||
my @test_texts = split(/<br>/, $::test_text);
|
||||
for ($i = 0; $i < @test_texts; $i++) {
|
||||
print CAP "__CFG NOTES_TEXT_LN " . $test_texts[$i] . "\n";
|
||||
}
|
||||
|
||||
# Things not specified will be left at defaults.
|
||||
|
||||
close(CAP);
|
||||
|
||||
# Send command to GUI to start this test.
|
||||
# Something like: wifi_cap run "ventana-mix-dl" "/tmp/ventana-dl-0003"
|
||||
my $t = new Net::Telnet(Prompt => '/#/',
|
||||
Timeout => 60);
|
||||
$t->open(Host => $::gui_host,
|
||||
Port => $::gui_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/#/");
|
||||
|
||||
my $output_dname = "$::test_name" . "_" . time();
|
||||
my $output_fname = "$cwd/$output_dname";
|
||||
my $cmd = "wifi_cap run \"$cwd/$wifi_cap_fname\" \"$output_fname\"\n";
|
||||
print "Sending GUI command to start the capacity test -:$cmd:-\n";
|
||||
my @rslt = $t->cmd($cmd);
|
||||
$t->close();
|
||||
|
||||
print "GUI result: " . join(@rslt, "\n");
|
||||
|
||||
print "Waiting for test to complete...\n";
|
||||
# Wait until test is done.
|
||||
while (1) {
|
||||
if (-f "$output_fname/index.html") {
|
||||
print "Found $output_fname/index.html, wait one more minute to be sure images are written.\n";
|
||||
last;
|
||||
}
|
||||
sleep(10);
|
||||
}
|
||||
|
||||
# Could still take a bit to complete writing out the images...
|
||||
sleep(60);
|
||||
|
||||
print "Finished, see report at: $output_fname/index.html\n";
|
||||
|
||||
system("tar -cvzf $output_dname.tar.gz $output_dname");
|
||||
|
||||
# Notes on possible LEDE/OpenWRT DUT cleanup
|
||||
# rm /etc/dhcp.leases and reboot to clean leases.
|
||||
|
||||
802
lf_cmc_macvlan.pl
Executable file
802
lf_cmc_macvlan.pl
Executable file
@@ -0,0 +1,802 @@
|
||||
#!/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.
|
||||
|
||||
# This script sets up connections of types:
|
||||
# lf, lf_udp, lf_tcp, custom_ether, custom_udp, and custom_tcp
|
||||
# across 1 real port and manny macvlan ports on 2 machines.
|
||||
# It then continously starts and stops the connections.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
# This sets up connections between 2 LANforge machines
|
||||
#my $lf1 = 1; my $lf2 = 2; my @lf1_ports = (5); my @lf2_ports = (5);
|
||||
|
||||
# This sets up connections between 2 ports of a single machine;
|
||||
my $lf1 = 1; my $lf2 = 1; my @lf1_ports = (2); my @lf2_ports = (3);
|
||||
|
||||
|
||||
my $ip_base = "172.1";
|
||||
my $ip_lsb = 2;
|
||||
my $ip_c = 2;
|
||||
my $msk = "255.255.0.0";
|
||||
my $mac_prefix = "00:0b:6b:30"; # NOTE: For use with CMC unit, this MAC must be within
|
||||
# the range that the CMC unit supports, and the MACs
|
||||
# must match the VSTA MACs in external mode 2.
|
||||
my $mac_prefix2 = "00:00:00:00"; # For second machine.
|
||||
my $mac_lsb = 01; # Starting least-significant byte of the MAC.
|
||||
my $mac_lsb2 = 05; # Starting second least significant byte of the MAC.
|
||||
|
||||
my $num_macvlans = 64;
|
||||
|
||||
|
||||
|
||||
# If zero, will have one of EACH of the cx types on each port.
|
||||
#my $one_cx_per_port = 1;
|
||||
my $one_cx_per_port = 0;
|
||||
|
||||
#my @cx_types = ("", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4");
|
||||
#my @min_pkt_szs = (64, 1, 1, 1, 1, 0);
|
||||
#my @max_pkt_szs = (1514, 12000, 13000, 2048, 2048, 0);
|
||||
|
||||
# Good for testing with CMC 'EE' unit.
|
||||
my @cx_types = ("lf_udp", "lf_tcp", "l4", "voip");
|
||||
my @min_pkt_szs = (1, 1, 0, 0);
|
||||
my @max_pkt_szs = (12000, 13000, 0, 0);
|
||||
|
||||
# Layer-4 only
|
||||
#my @cx_types = ("l4", "l4");
|
||||
#my @min_pkt_szs = (0, 0);
|
||||
#my @max_pkt_szs = (0, 0);
|
||||
|
||||
# VOIP only
|
||||
#my @cx_types = ("voip");
|
||||
#my @min_pkt_szs = (0);
|
||||
#my @max_pkt_szs = (0);
|
||||
|
||||
|
||||
my $peer_to_peer_voip = 1; # Don't register with SIP proxy, but just call peer to peer.
|
||||
my $max_voip = 3; # These are expensive, cannot run too many on most machines/networks.
|
||||
my @src_sound_files = ("media/male_voice_8khz.wav");
|
||||
|
||||
# URL will be acted on from machine $lf1
|
||||
#my $l4_url = "http://172.1.5.75";
|
||||
my $l4_url = "http://www.yahoo.com";
|
||||
|
||||
my $min_rate = 9000;
|
||||
my $max_rate = 12000;
|
||||
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 100;
|
||||
my $run_for_time = 1200; # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Run for XX seconds..then will be stopped again
|
||||
my $report_timer = 5000; # 8 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my @endpoint_names = (); #will be added to as they are created
|
||||
my @cx_names = ();
|
||||
my $cur_voip = 0;
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 45);
|
||||
|
||||
$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";
|
||||
|
||||
initToDefaults();
|
||||
#exit(0);
|
||||
|
||||
# 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
|
||||
|
||||
addMacVlans();
|
||||
|
||||
# Add some IP addresses to the ports
|
||||
initIpAddresses();
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
my $rl = 0;
|
||||
for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
|
||||
}# For some amount of start_stop iterations...
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub addMacVlans {
|
||||
my $i;
|
||||
my $q;
|
||||
|
||||
my $v;
|
||||
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<@lf1_ports; $q++) {
|
||||
my $pnum1 = $lf1_ports[$q];
|
||||
my $pnum2 = $lf2_ports[$q];
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
|
||||
$mac_lsb++;
|
||||
if ($mac_lsb > 255) {
|
||||
$mac_lsb2++;
|
||||
$mac_lsb = 0;
|
||||
}
|
||||
|
||||
my $s2 = $shelf+10;
|
||||
my $c2 = $lf1+10;
|
||||
my $p2 = $pnum1+10;
|
||||
my $mc = sprintf("$mac_prefix:%02x:%02x", $mac_lsb2, $mac_lsb);
|
||||
doCmd("add_mvlan $shelf $lf1 $pnum1 $mc");
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$c2 = $lf2+10;
|
||||
$p2 = $pnum2+10;
|
||||
#$mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
$mc = sprintf("$mac_prefix2:%02x:%02x", $mac_lsb2, $mac_lsb);
|
||||
doCmd("add_mvlan $shelf $lf2 $pnum2 $mc");
|
||||
|
||||
# Throttle ourself so we don't over-run the poor LANforge system.
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $pnum1);
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $pnum2);
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
doCmd("probe_ports");
|
||||
|
||||
# Wait untill we discover all the ports...
|
||||
|
||||
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};
|
||||
}
|
||||
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
while (1) {
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$i");
|
||||
if ($lf2 ne "") {
|
||||
$utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i");
|
||||
}
|
||||
if ($p1->isPhantom() || (($lf2 ne "") && $p2->isPhantom())) {
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}#addMacVlans
|
||||
|
||||
|
||||
# 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++) {
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
my $tmp = $lf1_ports[$i];
|
||||
my $tmp2 = $lf2_ports[$i];
|
||||
my $cmd = "set_port $shelf $lf1 $tmp $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$cmd = "set_port $shelf $lf2 $tmp2 $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
}
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $tmp);
|
||||
my $pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf1 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $tmp2);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf2 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}# If we have an LF-2 defined.
|
||||
}
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
my $ep = 0;
|
||||
my $cx = 0;
|
||||
my $i = 0;
|
||||
|
||||
my $voip_phone = 3000; # Start here and count on up as needed.
|
||||
my $rtp_port = 10000; # Starting RTP port.
|
||||
my $sound_file_idx = 0;
|
||||
|
||||
my @all_ports1 = @lf1_ports;
|
||||
my $j;
|
||||
my $pname;
|
||||
for ($j = 0; $j<@lf1_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports1 = (@all_ports1, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
|
||||
my @all_ports2 = @lf2_ports;
|
||||
if ($lf2 ne "") {
|
||||
for ($j = 0; $j<@lf2_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $lf2_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports2 = (@all_ports2, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "About to start endpoints, all_ports1:\n" . join(" ", @all_ports1) .
|
||||
"\nall_ports2: " . join(" ", @all_ports2) . "\n\n";
|
||||
|
||||
if ($one_cx_per_port) {
|
||||
my $j = 0;
|
||||
my $cxcnt = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
my $i = $cxcnt % @cx_types;
|
||||
$cxcnt++;
|
||||
|
||||
my $cxt = $cx_types[$i];
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "l4e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_l4e-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l4-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);
|
||||
}
|
||||
elsif ($cxt eq "voip") {
|
||||
# Create VOIP endpoint
|
||||
if ($cur_voip < $max_voip) {
|
||||
my $ep1 = "rtpe-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "rtpe-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_voip_endp $ep2 $shelf $lf2 " . $all_ports2[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep2";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_voip_info $ep2 NA 5 60 NA NA NA NA NA NA NA /dev/null 20000";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep2 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep2 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_voip_endp $ep1 $shelf $lf1 " . $all_ports1[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep2";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_voip_info $ep1 NA 5 60 NA NA NA NA NA NA NA /dev/null 20000";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep1 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep1 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep1 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "rtp-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);
|
||||
$cur_voip++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "l3e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "l3e-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l3-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
|
||||
}#one_cx_per_port
|
||||
else {
|
||||
my $j = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
for ($i = 0; $i<@cx_types; $i++) {
|
||||
my $cxt = $cx_types[$i];
|
||||
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "l4e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_l4e-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l4-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);
|
||||
}
|
||||
elsif ($cxt eq "voip") {
|
||||
# Create VOIP endpoint
|
||||
if ($cur_voip < $max_voip) {
|
||||
|
||||
my $ep1 = "RTPE-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "RTPE-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_voip_endp $ep2 $shelf $lf2 " . $all_ports2[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep2";
|
||||
doCmd($cmd);
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
$cmd = "set_voip_info $ep2 NA 5 60 NA NA NA NA NA NA NA /dev/null 20000";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep2 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep2 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
|
||||
my $cmd = "add_voip_endp $ep1 $shelf $lf1 " . $all_ports1[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep2";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_voip_info $ep1 NA 5 60 NA NA NA NA NA NA NA /dev/null 20000";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep1 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep1 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep1 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "rtp-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);
|
||||
$cur_voip++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "l3e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "l3e-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l3-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 cx types
|
||||
}#for each port
|
||||
}# each cx per port
|
||||
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
|
||||
print ">>> $cmd\n";
|
||||
|
||||
$t->print($cmd);
|
||||
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
#sleep(1);
|
||||
}
|
||||
291
lf_create_bcast.pl
Executable file
291
lf_create_bcast.pl
Executable file
@@ -0,0 +1,291 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
use lib '/home/lanforge/scripts';
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
|
||||
our $resource = 1;
|
||||
our $quiet = "yes";
|
||||
our $tx_bps = 512000;
|
||||
our $socket_buf = 512000;
|
||||
our $cx_name = "";
|
||||
our $endp_a = "";
|
||||
our $endp_b = "";
|
||||
our $port_a = "";
|
||||
our $mac_a = "";
|
||||
our $mac_b = "FF FF FF FF FF FF";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
sub logg {
|
||||
return if ($::quiet eq "yes");
|
||||
foreach (@_) {
|
||||
print "* ".$_."\n";
|
||||
}
|
||||
}
|
||||
|
||||
# [--port_b {eth0}]
|
||||
our $port_b = "eth0";
|
||||
|
||||
our $usage = qq($0 ## creates a UDP broadcast connection
|
||||
[--mgr {host-name | IP}]
|
||||
[--mgr_port {ip port}]
|
||||
[--resource {number}]
|
||||
[--quiet { yes | no }]
|
||||
[--cx_name {cx name}]
|
||||
[--tx_bps { transmit bps }]
|
||||
[--port_a {eth1}]
|
||||
[--mac_addr_a {mac address}]
|
||||
[--ip_a {ip addr}]
|
||||
[--netmask {255.255.255.0}]
|
||||
[--dest_ip {ip.255}]
|
||||
[--socket_buf {512000}]
|
||||
[--tx_bps {512000}]
|
||||
|
||||
Examples:
|
||||
# set broadcast endpoint
|
||||
$0 --mgr jedtest \\
|
||||
--resource_a 1 \\
|
||||
--cx_name cx3eth0 \\
|
||||
--port_a eth1 \\
|
||||
--mac_a 00:00:00:32:23:11 \\
|
||||
--ip_a 10.26.1.2 \\
|
||||
--broadcast 10.26.1.255 \\
|
||||
--netmask 255.255.255.0 \\
|
||||
--socket_buf 512000 \\
|
||||
--tx_bps 512000
|
||||
);
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port|p=i' => \$::lfmgr_port,
|
||||
'resource|r=i' => \$::resource,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'cx_name|c=s' => \$::cx_name,
|
||||
'port_a|a=s' => \$::port_a,
|
||||
'mac_addr_a|mac_a=s' => \$::mac_a,
|
||||
'tx_bps=i' => \$::tx_bps,
|
||||
'socket_buf=i' => \$::socket_buf
|
||||
) || die("$::usage");
|
||||
|
||||
sub fmt_cmd {
|
||||
my $rv;
|
||||
my $mod_hunk;
|
||||
for my $hunk (@_) {
|
||||
die("fmt_cmd called with empty space or null argument, bye.") unless(defined $hunk && $hunk ne '');
|
||||
die("rv[${rv}]\n --> fmt_cmd passed an array, bye.") if (ref($hunk) eq 'ARRAY');
|
||||
die("rv[${rv}]\n --> fmt_cmd passed a hash, bye.") if (ref($hunk) eq 'HASH');
|
||||
$mod_hunk = $hunk;
|
||||
$mod_hunk = "0" if ($hunk eq "0" || $hunk eq "+0");
|
||||
|
||||
if( $hunk eq "" ) {
|
||||
#print "hunk[".$hunk."] --> ";
|
||||
$mod_hunk = 'NA';
|
||||
#print "hunk[".$hunk."]\n";
|
||||
#print "fmt_cmd: warning: hunk was blank, now NA. Prev hunks: $rv\n"
|
||||
}
|
||||
$rv .= ( $mod_hunk =~m/ +/) ? "'$mod_hunk' " : "$mod_hunk ";
|
||||
}
|
||||
chomp $rv;
|
||||
print "cmd formatted to: $rv\n" unless($::quiet eq "yes");
|
||||
return $rv;
|
||||
}
|
||||
|
||||
die "please specify --mgr \n$::usage"
|
||||
if ((! defined $::lfmgr_host) || "$::lfmgr_host" eq "");
|
||||
|
||||
die "please specify --resource\n$::usage"
|
||||
if ((! defined $::resource) || "$::resource" eq "");
|
||||
|
||||
die "please specify --mgr_port\n$::usage"
|
||||
if ((! defined $::lfmgr_port) || "$::lfmgr_port" eq "");
|
||||
|
||||
die "please specify --port_a\n$::usage"
|
||||
if ((! defined $::port_a) || "$::port_a" eq "");
|
||||
|
||||
die "please specify --cx_name\n$::usage"
|
||||
if ((! defined $::cx_name) || "$::cx_name" eq "");
|
||||
|
||||
die "please specify --tx_bps\n$::usage"
|
||||
if ((! defined $::cx_name) || "$::cx_name" eq "");
|
||||
|
||||
|
||||
$endp_a = $::cx_name."-A";
|
||||
$endp_b = $::cx_name."-B";
|
||||
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
our $t = new Net::Telnet( Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
$utils->telnet($t); # Set our telnet object.
|
||||
if ($::quiet eq "yes") {
|
||||
$utils->cli_send_silent(1); # Do show input to CLI
|
||||
$utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$utils->cli_send_silent(0); # Do show input to CLI
|
||||
$utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
$resource = 1;
|
||||
$mac_a = "";
|
||||
|
||||
my @lines = split("\n", $::utils->doAsyncCmd(fmt_cmd("nc_show_ports", "1", "$resource", "$port_a")));
|
||||
my @hunks = grep {/MAC/} @lines;
|
||||
if ( @hunks < 1) {
|
||||
die("Unable to get mac addresses for port $port_a");
|
||||
}
|
||||
|
||||
($mac_a) = $hunks[0] =~ /MAC: ([^ ]+)/;
|
||||
$mac_a =~ y/:/ /;
|
||||
|
||||
die "please specify --mac_a since endp_a does not report it"
|
||||
if ((! defined $::mac_a) || "$::mac_a" eq "" || "$::mac_a" =~ /\s*(00[: ]){5}00\s*/);
|
||||
|
||||
#print "MAC is now [$::mac_a]\n";
|
||||
|
||||
my $rx_buf_size=512000; # default is 0, expresses OS min: 64B
|
||||
my $tx_buf_size=512000; # default is 0, expresses OS min: 64B
|
||||
# list of commands
|
||||
our @endp_a_list = (
|
||||
qq(add_endp $endp_a 1 $resource $port_a custom_ether -1 NO $tx_bps 0 NO 64 64 CUSTOM NO 32 0 0),
|
||||
qq(set_endp_flag $endp_a ReplayOverwriteDstMac 1),
|
||||
# this sets the broadcast MAC address
|
||||
qq(set_endp_details $endp_a $rx_buf_size $tx_buf_size 4294967295 0 'ff ff ff ff ff ff' 0 0 0 0 10000 0 NA NA NA 0.0.0.0 0),
|
||||
qq(set_endp_quiesce $endp_a 3),
|
||||
# this sets the source MAC
|
||||
qq(set_endp_addr $endp_a '$mac_a' AUTO 0 0),
|
||||
qq(set_endp_flag $endp_a ReplayLoop 0),
|
||||
qq(set_endp_flag $endp_a EnableTcpNodelay 0),
|
||||
qq(set_endp_flag $endp_a EnableRndSrcIP 0),
|
||||
qq(set_endp_flag $endp_a EnableConcurrentSrcIP 0),
|
||||
qq(set_endp_flag $endp_a EnableLinearSrcIP 0),
|
||||
qq(set_endp_flag $endp_a EnableLinearSrcIPPort 0),
|
||||
qq(set_endp_flag $endp_a QuiesceAfterRange 0),
|
||||
qq(set_endp_flag $endp_a QuiesceAfterDuration 0),
|
||||
# does this require recompilation?
|
||||
qq(set_endp_payload $endp_a CUSTOM ff ff ff ff ff ff 00 90 0b 29 06 f9 08 00 45 00 00 32 53 f5 40 00 40 11 cf 91 0a 1a 01 02 0a 1a 01 ff 00 00 00 00 00 00 e8 9b 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00),
|
||||
qq(set_endp_tos $endp_a DONT-SET 0),
|
||||
qq(set_script $endp_a NA NA NONE 'NA' 0 0),
|
||||
qq(set_endp_proxy $endp_a NO),
|
||||
qq(rm_thresholds $endp_a all),
|
||||
qq(set_endp_report_timer $endp_a 5000),
|
||||
qq(set_endp_flag $endp_a ClearPortOnStart 0),
|
||||
);
|
||||
our @endp_b_list = (
|
||||
# this is how an *unmanaged port* appears to be created
|
||||
qq(add_endp $endp_b 1 0 eth0 custom_ether -1 NO 56000 0 NO 64 64 CUSTOM NO 32 0 0),
|
||||
qq(set_endp_flag $endp_b ReplayOverwriteDstMac 0),
|
||||
# dest mac address
|
||||
qq(set_endp_details $endp_b 0 0 4294967295 0 '$mac_a' 0 0 0 0 10000 0 NA NA NA 0.0.0.0 0),
|
||||
qq(set_endp_quiesce $endp_b 3),
|
||||
qq(set_endp_flag $endp_b unmanaged 1),
|
||||
qq(set_endp_addr $endp_b '00 00 00 00 00 00 ' AUTO 0 0),
|
||||
qq(set_endp_flag $endp_b ReplayLoop 0),
|
||||
qq(set_endp_flag $endp_b EnableTcpNodelay 0),
|
||||
qq(set_endp_flag $endp_b EnableRndSrcIP 0),
|
||||
qq(set_endp_flag $endp_b EnableConcurrentSrcIP 0),
|
||||
qq(set_endp_flag $endp_b EnableLinearSrcIP 0),
|
||||
qq(set_endp_flag $endp_b EnableLinearSrcIPPort 0),
|
||||
qq(set_endp_flag $endp_b QuiesceAfterRange 0),
|
||||
qq(set_endp_flag $endp_b QuiesceAfterDuration 0),
|
||||
qq(set_endp_payload $endp_b CUSTOM 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00),
|
||||
qq(set_endp_tos $endp_b DONT-SET 0),
|
||||
qq(set_script $endp_b NA NA NONE 'NA' 0 0),
|
||||
qq(set_endp_proxy $endp_b NO),
|
||||
qq(rm_thresholds $endp_b all),
|
||||
qq(set_endp_report_timer $endp_b 5000),
|
||||
qq(set_endp_flag $endp_b ClearPortOnStart 0)
|
||||
);
|
||||
|
||||
$::utils->doAsyncCmd( fmt_cmd("rm_cx", "all", $cx_name));
|
||||
sleep(1);
|
||||
$::utils->doAsyncCmd( fmt_cmd("rm_endp", "$endp_a"));
|
||||
$::utils->doAsyncCmd( fmt_cmd("rm_endp", "$endp_b"));
|
||||
sleep(1);
|
||||
my $cmd;
|
||||
logg("creating endp_a:");
|
||||
for $cmd (@endp_a_list) {
|
||||
logg(" ".$cmd."\n");
|
||||
$::utils->doAsyncCmd( $cmd );
|
||||
}
|
||||
logg("creating endp_b");
|
||||
for $cmd (@endp_b_list) {
|
||||
logg(" ".$cmd."\n");
|
||||
$::utils->doAsyncCmd( $cmd );
|
||||
}
|
||||
sleep 1;
|
||||
$::utils->doAsyncCmd(fmt_cmd("add_cx", $cx_name, "default_tm", "$endp_a", "$endp_b"));
|
||||
|
||||
|
||||
########################################################################
|
||||
=pod
|
||||
### REFERENCE OF COMMANDS
|
||||
add_endp $endp_a 1 1 eport_a custom_ether -1 NO 512000 0 NO 64 64 CUSTOM NO 32 0 0
|
||||
set_endp_flag $endp_a ReplayOverwriteDstMac 1
|
||||
set_endp_details $endp_a 0 0 4294967295 0 'ff ff ff ff ff ff ' 0 0 0 0 10000 0 NA NA NA 0.0.0.0 0
|
||||
set_endp_quiesce $endp_a 3
|
||||
set_endp_addr $endp_a '00 90 0b 29 06 f9 ' AUTO 0 0
|
||||
set_endp_flag $endp_a ReplayLoop 0
|
||||
set_endp_flag $endp_a EnableTcpNodelay 0
|
||||
set_endp_flag $endp_a EnableRndSrcIP 0
|
||||
set_endp_flag $endp_a EnableConcurrentSrcIP 0
|
||||
set_endp_flag $endp_a EnableLinearSrcIP 0
|
||||
set_endp_flag $endp_a EnableLinearSrcIPPort 0
|
||||
set_endp_flag $endp_a QuiesceAfterRange 0
|
||||
set_endp_flag $endp_a QuiesceAfterDuration 0
|
||||
set_endp_payload $endp_a CUSTOM ff ff ff ff ff ff 00 90 0b 29 06 f9 08 00 45 00 00 32 53 f5 40 00 40 11 cf 91 0a 1a 01 02 0a 1a 01 ff 00 00 00 00 00 00 e8 9b 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
|
||||
set_endp_tos $endp_a DONT-SET 0
|
||||
set_script $endp_a NA NA NONE 'NA' 0 0
|
||||
set_endp_proxy $endp_a NO
|
||||
rm_thresholds $endp_a all
|
||||
set_endp_report_timer $endp_a 5000
|
||||
set_endp_flag $endp_a ClearPortOnStart 0
|
||||
add_endp $endp_b 1 0 eth0 custom_ether -1 NO 56000 0 NO 64 64 CUSTOM NO 32 0 0
|
||||
set_endp_flag $endp_b ReplayOverwriteDstMac 0
|
||||
set_endp_details $endp_b 0 0 4294967295 0 '00 90 0b 29 06 f9 ' 0 0 0 0 10000 0 NA NA NA 0.0.0.0 0
|
||||
set_endp_quiesce $endp_b 3
|
||||
set_endp_flag $endp_b unmanaged 1
|
||||
set_endp_addr $endp_b '00 00 00 00 00 00 ' AUTO 0 0
|
||||
set_endp_flag $endp_b ReplayLoop 0
|
||||
set_endp_flag $endp_b EnableTcpNodelay 0
|
||||
set_endp_flag $endp_b EnableRndSrcIP 0
|
||||
set_endp_flag $endp_b EnableConcurrentSrcIP 0
|
||||
set_endp_flag $endp_b EnableLinearSrcIP 0
|
||||
set_endp_flag $endp_b EnableLinearSrcIPPort 0
|
||||
set_endp_flag $endp_b QuiesceAfterRange 0
|
||||
set_endp_flag $endp_b QuiesceAfterDuration 0
|
||||
set_endp_payload $endp_b CUSTOM 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
|
||||
set_endp_tos $endp_b DONT-SET 0
|
||||
set_script $endp_b NA NA NONE 'NA' 0 0
|
||||
set_endp_proxy $endp_b NO
|
||||
rm_thresholds $endp_b all
|
||||
set_endp_report_timer $endp_b 5000
|
||||
set_endp_flag $endp_b ClearPortOnStart 0
|
||||
report 'lf_reports' NO NO NO NO
|
||||
=cut
|
||||
|
||||
|
||||
52
lf_cycle_wanlinks.pl
Executable file
52
lf_cycle_wanlinks.pl
Executable file
@@ -0,0 +1,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");
|
||||
}
|
||||
250
lf_endp_script.pl
Executable file
250
lf_endp_script.pl
Executable file
@@ -0,0 +1,250 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
# This program is used to create a hunt-script
|
||||
# used for matrix load emulation on LANforge
|
||||
# (C) Candela Technologies 2015
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
#use Carp;
|
||||
#$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
use lib '/home/lanforge/scripts';
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
|
||||
use constant NA => "NA";
|
||||
use constant NL => "\n";
|
||||
use constant shelf_num => 1;
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
our $resource = 1;
|
||||
our $quiet = "yes";
|
||||
our $endp_name = "";
|
||||
our $action = "";
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
|
||||
our $script_name = undef;
|
||||
our $script_type = "";
|
||||
our $flags = "";
|
||||
our $loops = 0;
|
||||
our $private = "";
|
||||
our $group_action = "ALL";
|
||||
our $log_cli = "unset"; # use ENV{LOG_CLI} elsewhere
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
=pod
|
||||
Below is an example of a set_script for script name bunny
|
||||
set_script hunt-sta-A bunny 4096 ScriptHunt '60000 1000 50000,100000,500000,20,56000,30000,1,100000, 60,128,256,512,1024,1280,1460,1472,1514 60,128,256,512,1024,1280,1460,1472,1514 100,300,400,600,800,955 NONE' ALL 0
|
||||
which should follow this syntax:
|
||||
|
||||
endp: hunt-sta-A
|
||||
name: bunny
|
||||
flags: 4096
|
||||
type: ScriptHunt
|
||||
private: '60000 1000 50000,100000,500000,20,56000,30000,1,100000, 60,128,256,512,1024,1280,1460,1472,1514 60,128,256,512,1024,1280,1460,1472,1514 100,300,400,600,800,955 NONE'
|
||||
group_action: ALL
|
||||
loop_count: 0
|
||||
|
||||
The private syntax is very opaque
|
||||
ScriptHunt syntax is: run_duration pause_duration constraints payload_sizes_a payload_sizes_b attenuations attenuator
|
||||
run_duration 60000
|
||||
pause_duration 1000
|
||||
constraints 50000,100000,500000,20,56000,30000,1,100000,
|
||||
payload_sizes_a 60,128,256,512,1024,1280,1460,1472,1514 60,128,256,512,1024,1280,1460,1472,1514 100,300,400,600,800,955
|
||||
payload_sizes_b NONE
|
||||
attenuations ?
|
||||
attenuator ?
|
||||
=cut
|
||||
|
||||
|
||||
our $usage = qq<$0 ...
|
||||
[--action { set_script|start_cx|quiece_cx|stop_cx|show_report|del_script } ]
|
||||
set_script: configure a cx with script parameters set in script_type, script_flags
|
||||
show_port: show script report for cx
|
||||
del_script: remove script from cx
|
||||
start_cx: start traffic on a connection (thus starting script)
|
||||
quiece_cx: stop transmitting traffic and wait a period before stopping connection recieve
|
||||
stop_cx: stop transmit and recieve immediately
|
||||
# --action start_cx --cx_name bunbun
|
||||
[--mgr {host-name | IP}]
|
||||
[--mgr_port {ip port}]
|
||||
[--resource {number}]
|
||||
[--quiet { yes | no }]
|
||||
[--endp_name {endpoint name}]
|
||||
[--cx_name {endpoint name}]
|
||||
[--script_type {2544|Hunt|WanLink|Atten} ]
|
||||
2544 - RFC 2544 type script
|
||||
Hunt - Hunt for maximum speed with constraints
|
||||
WanLink - iterate thru wanlink settings
|
||||
Atten - use with attenuators
|
||||
[--flags - see LF CLI User Guide script flags for set_port]
|
||||
[--script_name - script name]
|
||||
[--loops - how many time to loop before stopping; (0 is infinite)]
|
||||
[--private - the nested script-type parameters in a single string]
|
||||
[--log_cli {1|filename}]
|
||||
|
||||
Please refer to LANforge CLI Users Guide: http://www.candelatech.com/lfcli_ug.php#set_script
|
||||
|
||||
Examples:
|
||||
# add a script to an endpoint
|
||||
$0 --action set_script --script_type Hunt \\
|
||||
--script_name bunny --endp_name cx3eth0 -loops 1 --flags 4096 \\
|
||||
--private '60000 1000 50000,100000,500000,20,56000,30000,1,100000, 60,128,256,512,1024,1280,1460,1472,1514 60,128,256,512,1024,1280,1460,1472,1514 100,300,400,600,800,955 NONE'
|
||||
|
||||
# start the cx to start the script:
|
||||
$0 --action start_cx --cx_name hunt-sta
|
||||
|
||||
# quiesce the cx
|
||||
$0 --action quiece_cx --cx_name hunt-sta
|
||||
|
||||
# show the report
|
||||
$0 --action show_report --endp_name hunt-sta-A
|
||||
|
||||
# stop the cx
|
||||
$0 --action stop_cx --cx_name hunt-sta
|
||||
|
||||
# remove endpoint script
|
||||
$0 --action del_script --endp_name hunt-sta-A
|
||||
>;
|
||||
|
||||
my $i = 0;
|
||||
my $cmd;
|
||||
die($::usage) if (@ARGV < 2);
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'action|a=s' => \$::action,
|
||||
'mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port|p=i' => \$::lfmgr_port,
|
||||
'resource|r=i' => \$::resource,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'endp_name|e=s' => \$::endp_name,
|
||||
'cx_name|c=s' => \$::cx_name,
|
||||
'script_type|t=s' => \$::script_type,
|
||||
'flags|f=i' => \$::flags,
|
||||
'script_name|n=s' => \$::script_name,
|
||||
'loops|l=i' => \$::loops,
|
||||
'private|b=s' => \$::private,
|
||||
'log_cli=s{0,1}'=> \$log_cli,
|
||||
) || die("$::usage");
|
||||
|
||||
|
||||
die("please specify action\n$usage")
|
||||
if (!defined $::action || $::action eq "");
|
||||
|
||||
if ($::action eq "set_script"
|
||||
|| $::action eq "show_report"
|
||||
|| $::action eq "del_script") {
|
||||
die("please specify endpoint name\n$usage")
|
||||
if (!defined $::endp_name || $::endp_name eq "");
|
||||
}
|
||||
if ($::action eq "set_script"
|
||||
|| $::action eq "del_script") {
|
||||
|
||||
die("please specify script name\n$usage")
|
||||
if (!defined $::script_name || $::script_name eq "");
|
||||
}
|
||||
|
||||
if (defined $log_cli) {
|
||||
if ($log_cli ne "unset") {
|
||||
# here is how we reset the variable if it was used as a flag
|
||||
if ($log_cli eq "") {
|
||||
$ENV{'LOG_CLI'} = 1;
|
||||
}
|
||||
else {
|
||||
$ENV{'LOG_CLI'} = $log_cli;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
our $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
$utils->telnet($t); # Set our telnet object.
|
||||
if ($::quiet eq "yes") {
|
||||
$utils->cli_send_silent(1); # Do show input to CLI
|
||||
$utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$utils->cli_send_silent(0); # Do show input to CLI
|
||||
$utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
$::utils->log_cli("# $0 ".`date "+%Y-%m-%d %H:%M:%S"`);
|
||||
our %script_types = (
|
||||
"2544" => "Script2544",
|
||||
"Atten" => "ScriptAtten",
|
||||
"Hunt" => "ScriptHunt",
|
||||
"Script2544" => "Script2544",
|
||||
"ScriptAtten" => "ScriptAtten",
|
||||
"ScriptHunt" => "ScriptHunt",
|
||||
"ScriptWanLink"=> "ScriptWL",
|
||||
"ScriptWL" => "ScriptWL",
|
||||
"WanLink" => "ScriptWL",
|
||||
);
|
||||
|
||||
if ($::action eq "start_cx"
|
||||
|| $::action eq "stop_cx"
|
||||
|| $::action eq "quiece_cx") {
|
||||
die("Please state cx_name")
|
||||
if ( !defined $::cx_name || $::cx_name eq "" );
|
||||
}
|
||||
|
||||
if ($::action eq "set_script") {
|
||||
my $scr_type = $::script_types{ $::script_type };
|
||||
die("Unknown script type [$::script_type]")
|
||||
if ( !defined $::script_type
|
||||
|| !defined $scr_type
|
||||
|| $::script_type eq ""
|
||||
|| $scr_type eq "" );
|
||||
die("Cannot use blank action.")
|
||||
if (! defined $::private || $::private eq "");
|
||||
|
||||
$cmd = $::utils->fmt_cmd("set_script", $::endp_name, "$::script_name", $::flags, $scr_type, "$::private", $::group_action, $::loops);
|
||||
$::utils->doAsyncCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "show_report") {
|
||||
$cmd = $::utils->fmt_cmd("show_script_results", $::endp_name);
|
||||
$::utils->doAsyncCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "del_script") {
|
||||
$cmd = $::utils->fmt_cmd("set_script", $::endp_name, "$::script_name", "0", "NA", "NONE");
|
||||
$::utils->doAsyncCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "start_cx") {
|
||||
$cmd = $::utils->fmt_cmd("set_cx_state", "ALL", $::cx_name, "RUNNING");
|
||||
$::utils->doAsyncCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "quiece_cx") {
|
||||
$cmd = $::utils->fmt_cmd("set_cx_state", "ALL", $::cx_name, "QUIESCE");
|
||||
$::utils->doAsyncCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "stop_cx") {
|
||||
$cmd = $::utils->fmt_cmd("set_cx_state", "ALL", $::cx_name, "STOPPED");
|
||||
$::utils->doAsyncCmd($cmd);
|
||||
}
|
||||
else {
|
||||
die( "Unknown action.\n$usage");
|
||||
}
|
||||
|
||||
|
||||
|
||||
#eof
|
||||
727
lf_firemod.pl
Executable file
727
lf_firemod.pl
Executable file
@@ -0,0 +1,727 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
# This program is used to create, show, and modify existing connections
|
||||
# and get some basic information from LANforge.
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Udated by:
|
||||
#
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
use Carp;
|
||||
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
|
||||
$SIG{ __WARN__ } = sub { Carp::confess( @_ ) };
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
use lib '/home/lanforge/scripts';
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
|
||||
use constant NA => "NA";
|
||||
use constant NL => "\n";
|
||||
use constant shelf_num => 1;
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
our $resource = 1;
|
||||
our $quiet = "yes";
|
||||
our $endp_name = "";
|
||||
our $endp_cmd = "";
|
||||
our $port_name = "";
|
||||
our $speed = "-1";
|
||||
our $action = "show_port";
|
||||
our $do_cmd = "NA";
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
our $endp_vals = undef;
|
||||
our $ip_port = "-1"; # let lf choose
|
||||
our $multicon = "0"; #no multicon
|
||||
|
||||
# For creating multicast endpoints
|
||||
our $endp_type = undef; #"mc_udp"; this needs to be explicit
|
||||
our $mcast_addr = "224.9.9.9";
|
||||
our $mcast_port = "9999";
|
||||
our $max_speed = "-1";
|
||||
our $rcv_mcast = "YES";
|
||||
our $min_pkt_sz = "-1";
|
||||
our $max_pkt_sz = "-1";
|
||||
our $use_csums = "NO"; # Use LANforge checksums in payload?
|
||||
our $ttl = 32;
|
||||
our $report_timer = 5000;
|
||||
our $tos = "";
|
||||
our $arm_pps = "";
|
||||
our $arm_cpu_id = "NA";
|
||||
# For cross connects
|
||||
our $cx_name = "";
|
||||
our $cx_endps = "";
|
||||
our $list_cx_name = "all";
|
||||
our $test_mgr = "default_tm";
|
||||
our $list_test_mgr = "all";
|
||||
|
||||
our $fail_msg = "";
|
||||
our $manual_check = 0;
|
||||
|
||||
our @known_endp_types = split(',', "lf_udp,lf_udp6,lf_tcp,lf_tcp6,mc_udp,mc_udp6,generic");
|
||||
our @known_tos = split(',', "DONT-SET,LOWDELAY,THROUGHPUT,RELIABILITY,LOWCOST");
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
our $usage = "$0 --action { list_ports | show_port
|
||||
| list_endp | create_endp | create_arm | show_endp | set_endp
|
||||
| do_cmd | start_endp | stop_endp | delete_endp
|
||||
| create_cx | list_cx | show_cx | delete_cx } ]
|
||||
[--endp_vals {key,key,key,key}]
|
||||
# show_endp output can be narrowed with key-value arguments
|
||||
# Examples:
|
||||
# --action show_endp --endp_vals MinTxRate,DestMAC,Avg-Jitter
|
||||
# Not available: Latency,Pkt-Gaps, or rows below steps-failed.
|
||||
# Special Keys:
|
||||
# --endp_vals tx_bps (Tx Bytes)
|
||||
# --endp_vals rx_bps (Rx Bytes)
|
||||
[--mgr {host-name | IP}]
|
||||
[--mgr_port {ip port}]
|
||||
[--cmd {lf-cli-command text}]
|
||||
[--endp_name {name}]
|
||||
[--endp_cmd {generic-endp-command}]
|
||||
[--port_name {name}]
|
||||
[--resource {number}]
|
||||
[--speed {speed in bps}]
|
||||
[--tos { ".join(' | ', @::known_tos)." },{priority}]
|
||||
[--max_speed {speed in bps}]
|
||||
[--quiet { yes | no }]
|
||||
[--endp_type { ".join(' | ', @::known_endp_types)." }]
|
||||
[--mcast_addr {multicast address, for example: 224.4.5.6}]
|
||||
[--mcast_port {multicast port number}]
|
||||
[--min_pkt_sz {minimum payload size in bytes}]
|
||||
[--max_pkt_sz {maximum payload size in bytes}]
|
||||
[--rcv_mcast { yes (receiver) | no (transmitter) }]
|
||||
[--use_csums { yes | no, should we checksum the payload }]
|
||||
[--ttl {time-to-live}]
|
||||
[--report_timer {miliseconds}]
|
||||
[--cx_name {connection name}]
|
||||
[--cx_endps {endp1},{endp2}]
|
||||
[--test_mgr {default_tm|all|other-tm-name}]
|
||||
[--arm_pps {packets per second}]
|
||||
[--ip_port {-1 (let LF choose, AUTO) | 0 (let OS choose, ANY) | specific IP port}]
|
||||
[--multicon {0 (no multi-conn, Normal) | number of connections (TCP only)}]
|
||||
[--log_cli {1|filename}]
|
||||
Example:
|
||||
$0 --action set_endp --endp_name udp1-A --speed 154000
|
||||
|
||||
$0 --action create_endp --endp_name mcast_xmit_1 --speed 154000 \\
|
||||
--endp_type mc_udp --mcast_addr 224.9.9.8 --mcast_port 9998 \\
|
||||
--rcv_mcast NO --port_name eth1 \\
|
||||
--min_pkt_sz 1072 --max_pkt_sz 1472 \\
|
||||
--use_csums NO --ttl 32 \\
|
||||
--quiet no --report_timer 1000
|
||||
|
||||
$0 --action create_endp --endp_name bc1 --speed 256000 \\
|
||||
--endp_type lf_tcp --tos THROUGHPUT,100 --port_name rd0#1
|
||||
|
||||
$0 --action create_endp --endp_name ping1 --port_name sta0 --endp_cmd \"lfping -p deadbeef000 -I sta0 8.8.4.4\"
|
||||
--endp_type generic
|
||||
|
||||
$0 --action list_cx --test_mgr all --cx_name all
|
||||
|
||||
$0 --action create_cx --cx_name L301 \\
|
||||
--cx_endps ep_rd0a,ep_rd1a --report_timer 1000
|
||||
|
||||
$0 --action create_arm --endp_name arm01-A --port_name eth1 \\
|
||||
--arm_pps 80000 --min_pkt_sz 1472 --max_pkt_sz 1514 --tos LOWDELAY,100
|
||||
|
||||
$0 --mgr jedtest --action create_cx --cx_name arm-01 --cx_endps arm01-A,arm01-B
|
||||
|
||||
$0 --mgr localhost --action create_endp --endp_name test1a --speed 10000000 \\
|
||||
--endp_type lf_tcp --port_name eth5 --ip_port 0 --multicon 10
|
||||
|
||||
$0 --mgr localhost --resource 3 --action create_endp --endp_name test1b --speed 0 \\
|
||||
--endp_type lf_tcp --port_name wlan2 --multicon 1
|
||||
|
||||
$0 --mgr localhost --action create_cx --cx_name test1 --cx_endps test1a,test1b
|
||||
";
|
||||
|
||||
my $i = 0;
|
||||
my $cmd;
|
||||
die($::usage) if (@ARGV < 2);
|
||||
my $log_cli = "unset"; # use ENV{LOG_CLI} elsewhere
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'endp_name|e=s' => \$::endp_name,
|
||||
'endp_cmd=s' => \$::endp_cmd,
|
||||
'endp_vals|o=s' => \$::endp_vals,
|
||||
'action|a=s' => \$::action,
|
||||
'cmd|c=s' => \$::do_cmd,
|
||||
'mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port|p=i' => \$::lfmgr_port,
|
||||
'resource|r=i' => \$::resource,
|
||||
'port_name=s' => \$::port_name,
|
||||
'speed|s=i' => \$::speed,
|
||||
'max_speed=s' => \$::speed,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'endp_type=s' => \$::endp_type,
|
||||
'mcast_addr=s' => \$::mcast_addr,
|
||||
'mcast_port=s' => \$::mcast_port,
|
||||
'min_pkt_sz=s' => \$::min_pkt_sz,
|
||||
'max_pkt_sz=s' => \$::max_pkt_sz,
|
||||
'rcv_mcast=s' => \$::rcv_mcast,
|
||||
'use_csums=s' => \$::use_csums,
|
||||
'ttl=i' => \$::ttl,
|
||||
'report_timer=i' => \$::report_timer,
|
||||
'cx_name=s' => \$::cx_name,
|
||||
'cx_endps=s' => \$::cx_endps,
|
||||
'test_mgr=s' => \$::test_mgr,
|
||||
'tos=s' => \$::tos,
|
||||
'arm_pps=i' => \$::arm_pps,
|
||||
'ip_port=i' => \$::ip_port,
|
||||
'multicon=i' => \$::multicon,
|
||||
'log_cli=s{0,1}'=> \$log_cli,
|
||||
) || die("$::usage");
|
||||
|
||||
if ($::quiet eq "0") {
|
||||
$::quiet = "no";
|
||||
}
|
||||
elsif ($::quiet eq "1") {
|
||||
$::quiet = "yes";
|
||||
}
|
||||
|
||||
if (defined $log_cli) {
|
||||
if ($log_cli ne "unset") {
|
||||
# here is how we reset the variable if it was used as a flag
|
||||
if ($log_cli eq "") {
|
||||
$ENV{'LOG_CLI'} = 1;
|
||||
}
|
||||
else {
|
||||
$ENV{'LOG_CLI'} = $log_cli;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($::do_cmd ne "NA") {
|
||||
$::action = "do_cmd";
|
||||
}
|
||||
our @valid_actions = split(/,/, "show_endp,set_endp,start_endp,stop_endp,delete_endp,create_endp,create_arm,"
|
||||
."show_port,do_cmd,list_ports,list_endp,create_cx,list_cx,show_cx,delete_cx" );
|
||||
|
||||
if (! (grep {$_ eq $::action} @::valid_actions )) {
|
||||
die("Invalid action: $::action\n$::usage\n");
|
||||
}
|
||||
our @actions_needing_endp = split(/,/, "set_endp,start_endp,stop_endp,delete_endp,create_endp,create_arm");
|
||||
if (grep {$_ eq $::action} @actions_needing_endp) {
|
||||
if (length($::endp_name) == 0) {
|
||||
print "ERROR: Must specify endp_name.\n";
|
||||
die("$::usage");
|
||||
}
|
||||
}
|
||||
if ($::quiet eq "1" ) {
|
||||
$::quiet = "yes";
|
||||
}
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
# Wait up to 60 seconds when requesting info from LANforge.
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 60);
|
||||
|
||||
$t->open(Host => $::lfmgr_host,
|
||||
Port => $::lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->max_buffer_length(16 * 1024 * 1000); # 16 MB buffer
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
$::utils->telnet($t); # Set our telnet object.
|
||||
if ($::utils->isQuiet()) {
|
||||
if (defined $ENV{'LOG_CLI'} && $ENV{'LOG_CLI'} ne "") {
|
||||
$::utils->cli_send_silent(0);
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(1); # Do not show input to telnet
|
||||
}
|
||||
$::utils->cli_rcv_silent(1); # Repress output from telnet
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(0); # Show input to telnet
|
||||
$::utils->cli_rcv_silent(0); # Show output from telnet
|
||||
}
|
||||
$::utils->log_cli("# $0 ".`date "+%Y-%m-%d %H:%M:%S"`);
|
||||
|
||||
if (grep {$_ eq $::action} split(',', "show_endp,set_endp,create_endp,create_arm,list_endp")) {
|
||||
$::max_speed = $::speed if( $::max_speed eq "-1");
|
||||
if ($::action eq "list_endp") {
|
||||
my @lines = split(NL, $::utils->doAsyncCmd("nc_show_endpoints all"));
|
||||
for my $line (@lines) {
|
||||
if ($line =~ /^([A-Z]\w+)\s+\[(.*?)\]/) {
|
||||
print "$line\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($::action eq "show_endp") {
|
||||
if ((defined $::endp_vals) && ("$::endp_vals" ne "")) {
|
||||
|
||||
my %option_map = ();
|
||||
my $option = '';
|
||||
for $option (split(',', $::endp_vals)) {
|
||||
#print "OPTION[$option]\n";
|
||||
next if( $option =~ /Latency/);
|
||||
next if( $option =~ /Pkt-Gaps/);
|
||||
#next if( $option =~ /\s/);
|
||||
if( $option =~ /rx_pps/ ) { $option = "Rx Pkts"; }
|
||||
if( $option =~ /tx_pps/ ) { $option = "Tx Pkts"; }
|
||||
if( $option =~ /rx_pkts/ ) { $option = "Rx Pkts"; }
|
||||
if( $option =~ /tx_pkts/ ) { $option = "Tx Pkts"; }
|
||||
|
||||
# we don't know if we're armageddon or layer 3
|
||||
if( $option =~ /tx_bytes/ ) {
|
||||
$option_map{ "Tx Bytes" } = '';
|
||||
$option = "Bytes Transmitted";
|
||||
}
|
||||
if( $option =~ /rx_b(ps|ytes)/ ) {
|
||||
$option_map{ "Rx Bytes" } = '';
|
||||
$option = "Bytes Rcvd";
|
||||
}
|
||||
if( $option =~ /tx_packets/) {
|
||||
$option_map{ "Tx Pkts" } = '';
|
||||
$option = "Packets Transmitted";
|
||||
}
|
||||
if( $option =~ /rx_packets/) {
|
||||
$option_map{ "Rx Pkts" } = '';
|
||||
$option = "Packets Rcvd";
|
||||
}
|
||||
|
||||
$option_map{ $option } = '';
|
||||
}
|
||||
# options are reformatted
|
||||
|
||||
my $i;
|
||||
my @lines = split(NL, $::utils->doAsyncCmd("nc_show_endp $endp_name"));
|
||||
for($i=0; $i<@lines; $i++) {
|
||||
$lines[$i] = $lines[$i]." #";
|
||||
}
|
||||
my $matcher = " (".join('|', keys %option_map)."):";
|
||||
my @parts;
|
||||
my @matches = grep( /$matcher/, @lines);
|
||||
my $match;
|
||||
#print "MATCHER $matcher".NL;
|
||||
for my $end_val (split(',', $::endp_vals)) {
|
||||
my $endval_done = 0;
|
||||
for $match (@matches) {
|
||||
last if ($endval_done);
|
||||
#print "\nM: $end_val> $match\n";
|
||||
|
||||
# no value between colon separated tags can be very
|
||||
# confusing to parse, let's force a dumb value in if we find that
|
||||
if ($match =~ /[^ ]+:\s+[^ ]+:/) {
|
||||
$match =~ s/([^ ]+:)\s+([^ ]+:\s+)/$1 "" $2/g;
|
||||
#print "\n M> $match\n";
|
||||
}
|
||||
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
## special cases #
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
if ( $match =~ /Rx (Bytes|Pkts)/ && $end_val =~ /rx_/) {
|
||||
my $value = 0;
|
||||
($option) = ($match =~ /(Rx (Bytes|Pkts))/);
|
||||
#print "Option: $option".NL;
|
||||
@parts = ($match =~ m{ Total: (\d+) +Time: \d+s\s+ Cur: (\d+) +(\d+)\/s \#$});
|
||||
#print "\n RX: ".join(",",@parts)."\n";
|
||||
if ( defined $option_map{ $option } ) {
|
||||
if ($end_val =~ /rx_(bps|pps)/ ) {
|
||||
$value = 0 + $parts[2];
|
||||
}
|
||||
elsif ($end_val =~ /rx_(byte|pkt|packet)s/ ) {
|
||||
$value = 0 + $parts[0];
|
||||
}
|
||||
if ( $option eq "Rx Bytes") {
|
||||
if ($end_val =~ /rx_bps/ ) {
|
||||
$value *= 8;
|
||||
}
|
||||
}
|
||||
#print "\n A end_val[$end_val] option[$option] now ".$value."\n";
|
||||
$option_map{ $option } = $value;
|
||||
$endval_done++;
|
||||
last;
|
||||
}
|
||||
}
|
||||
elsif ( $match =~ /Cx Detected/) {
|
||||
my $value = 0;
|
||||
($option) = ($match =~ /(Cx Detected)/);
|
||||
if ( defined $option_map{ $option } ) {
|
||||
$value = 0 + ($match =~ /:\s+(\d+)/)[0];
|
||||
$option_map{ $option } = $value;
|
||||
$endval_done++;
|
||||
last;
|
||||
}
|
||||
}
|
||||
elsif ( $match =~ /Tx (Bytes|Pkts)/ && $end_val =~ /tx_/) {
|
||||
my $value = 0;
|
||||
($option) = ($match =~ /(Tx (Bytes|Pkts))/);
|
||||
#print "Option: $option".NL;
|
||||
@parts = ($match =~ m{ Total: (\d+) +Time: \d+s\s+ Cur: (\d+) +(\d+)\/s \#$});
|
||||
#print "\n TX: ".join(",",@parts)."\n";
|
||||
if ( defined $option_map{ $option } ) {
|
||||
if ($end_val =~ /tx_(bps|pps)/ ) {
|
||||
$value = 0 + $parts[2];
|
||||
}
|
||||
elsif ($end_val =~ /tx_(byte|pkt|packet)s/ ) {
|
||||
$value = 0 + $parts[0];
|
||||
}
|
||||
if ($option eq "Tx Bytes") {
|
||||
if ($end_val =~ /tx_bps/ ) {
|
||||
$value *= 8;
|
||||
}
|
||||
}
|
||||
#print "\n B end_val[$end_val] option[$option] now ".$value."\n";
|
||||
$option_map{ $option } = $value;
|
||||
$endval_done++;
|
||||
last;
|
||||
}
|
||||
}
|
||||
elsif ( $match =~ / [TR][Xx] (((OOO|Duplicate|Failed) (Bytes|Pkts))|Wrong Dev|CRC Failed|Bit Errors|Dropped)/
|
||||
|| $match =~ /Conn (Established|Timeouts)|TCP Retransmits/) {
|
||||
my $value = 0;
|
||||
($option) = ($match =~ /([TR][Xx] (((OOO|Duplicate|Failed) (Bytes|Pkts))|Wrong Dev|CRC Failed|Bit Errors|Dropped)|Conn (Established|Timeouts)|TCP Retransmits)/);
|
||||
@parts = $match =~ m{ Total: (\d+) +Time: \d+s\s+ Cur: (\d+) +(\d+)\/s \#$};
|
||||
#print "\n TX: ".join(",",@parts)."\n";
|
||||
if ( defined $option_map{ $option } ) {
|
||||
#print "$match\n";
|
||||
$match =~ s/""/ /g;
|
||||
($option_map{ $option }) = $match =~/.*?:\s+(.*?)\s+\#$/;
|
||||
$endval_done++;
|
||||
last;
|
||||
}
|
||||
}
|
||||
elsif ( $match =~ /(Bytes|Packets) (Rcvd|Transmitted)/ ) {
|
||||
($option) = ($match =~ /((Bytes|Packets) (Rcvd|Transmitted))/);
|
||||
@parts = ($match =~ m{ Total: (\d+) +Time: \d+s\s+ Cur: (\d+) +(\d+)\/s \#$});
|
||||
my $value = 0;
|
||||
if ( defined $option_map{ $option } ) {
|
||||
if ($end_val =~ /rx_(bps|pps)/ ) {
|
||||
$value = 0 + $parts[2];
|
||||
}
|
||||
elsif ($end_val =~ /rx_(byte|pkt|packet)s/ ) {
|
||||
$value = 0 + $parts[0];
|
||||
}
|
||||
if ($option eq "Bytes Rcvd") {
|
||||
if ($end_val =~ /rx_bps/ ) {
|
||||
$value *= 8;
|
||||
}
|
||||
}
|
||||
|
||||
#print "\n C end_val[$end_val] option[$option] now ".$value."\n";
|
||||
$option_map{ $option } = $value;
|
||||
$endval_done++;
|
||||
last;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# special case
|
||||
$match =~ s/Shelf: (\d+), /Shelf: $1 /
|
||||
if ($match =~ /^\s*Shelf:/ );
|
||||
|
||||
$match =~ s/(Endpoint|PktsToSend): (\d+) /$1: $2 /
|
||||
if ($match =~ /\s*(Endpoint|PktsToSend):/ );
|
||||
|
||||
if ($match =~ /((Src|Dst)Mac): /) {
|
||||
my ($name1, $mac1) = ( $match =~ /(...Mac): (.*?) /);
|
||||
$mac1 =~ s/ /-/g;
|
||||
$match =~ s/(...Mac): (.. .. .. .. .. ..) /$1: $mac1 /;
|
||||
}
|
||||
if ($match =~ /FileName: .*? SendBadCrc: /) {
|
||||
my $filename1 = '';
|
||||
($filename1) =~ /FileName: (.*?) SendBadCrc.*$/;
|
||||
$filename1 = '""' if ($filename1 =~ /^ *$/);
|
||||
$match =~ s/(FileName): (.*?) (SendBadCrc.*)$/$1: $filename1 $3/;
|
||||
}
|
||||
$match =~ s/CWND: (\d+) /CWND: $1 /
|
||||
if ($match =~/CWND: (\d+) /);
|
||||
# ~specials
|
||||
|
||||
@parts = ($match =~ m/( *[^ ]+):( *\S+ [^ #]*)(?! #|\S+:)/g);
|
||||
for (my $i=0; $i < @parts; $i+=2) {
|
||||
$option = $parts[$i];
|
||||
#print " parts[$option] ";
|
||||
$option =~ s/^\s*(.*)\s*$/$1/;
|
||||
if ( defined $option_map{ $option } ) {
|
||||
my $value = $parts[ $i + 1 ];
|
||||
if ($value =~ /^\s*([^ ]+):\s+/) {
|
||||
$value = "-";
|
||||
}
|
||||
else {
|
||||
$value =~ s/^\s*(.*)\s*$/$1/;
|
||||
}
|
||||
#print "\n D end_val[$end_val] option[$option] now ".$value."\n";
|
||||
$option_map{ $option } = $value;
|
||||
$endval_done++;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
} # ~matches
|
||||
} # ~endp_vals
|
||||
for $option ( sort keys %option_map ) {
|
||||
print $option.": ".$option_map{ $option }.NL;
|
||||
}
|
||||
}
|
||||
else {
|
||||
print $::utils->doAsyncCmd("nc_show_endp $::endp_name");
|
||||
}
|
||||
}
|
||||
elsif ($::action eq "create_arm") {
|
||||
die("Must choose packets per second: --arm_pps\n$::usage")
|
||||
if (! defined $::arm_pps || $::arm_pps eq "");
|
||||
|
||||
$::min_pkt_sz = "1472" if ($::min_pkt_sz eq "-1");
|
||||
$::max_pkt_sz = $::min_pkt_sz if ($::max_pkt_sz eq "-1");
|
||||
my $ip_port = "-1"; # let lf choose
|
||||
$cmd = $::utils->fmt_cmd("add_arm_endp", $::endp_name, shelf_num, $::resource,
|
||||
$::port_name, "arm_udp", $::arm_pps,
|
||||
$::min_pkt_sz, $::max_pkt_sz, $::arm_cpu_id, $::tos);
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_report_timer $::endp_name $::report_timer";
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "create_endp") {
|
||||
die("Must choose endpoint protocol type: --endp_type\n$::usage")
|
||||
if (! defined $::endp_type|| $::endp_type eq "");
|
||||
|
||||
$::endp_type = "lf_tcp" if ($::endp_type eq "tcp");
|
||||
$::endp_type = "lf_udp" if ($::endp_type eq "udp");
|
||||
|
||||
die("Endpoint protocol type --endp_type must be among "
|
||||
.join(', ', @::known_endp_types)."\n".$::usage)
|
||||
if (! grep {$_ eq $::endp_type } @::known_endp_types);
|
||||
|
||||
if ($::endp_type eq "generic") {
|
||||
if ($::endp_cmd eq "") {
|
||||
die("Must specify endp_cmd if creating a generic endpoint.\n");
|
||||
}
|
||||
$cmd = $::utils->fmt_cmd("add_gen_endp", $::endp_name, shelf_num, $::resource,
|
||||
$::port_name, "gen_generic");
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
# Create the dummy
|
||||
#my $dname = "D_" . $::endp_name;
|
||||
#$cmd = $::utils->fmt_cmd("add_gen_endp", $dname, shelf_num, $::resource,
|
||||
# $::port_name, "gen_generic");
|
||||
#$::utils->doCmd($cmd);
|
||||
|
||||
$cmd = "set_gen_cmd " . $::endp_name . " " . $::endp_cmd;
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_report_timer $::endp_name $::report_timer";
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
$::cx_name = "CX_" . $::endp_name;
|
||||
$cmd = "add_cx " . $::cx_name . " " . $::test_mgr . " " . $::endp_name;
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
my $cxonly = NA;
|
||||
$cmd = $::utils->fmt_cmd("set_cx_report_timer", $::test_mgr, $::cx_name, $::report_timer, $cxonly);
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
elsif ($::endp_type eq "mc_udp") {
|
||||
# For instance:
|
||||
# add_endp mcast-xmit-eth1 1 3 eth1 mc_udp 9999 NO 9600 0 NO 1472 1472 INCREASING NO 32 0 0
|
||||
# set_mc_endp mcast-xmit-eth1 32 224.9.9.9 9999 NO
|
||||
# Assume Layer-3 for now
|
||||
|
||||
$cmd = $::utils->fmt_cmd("add_endp", $::endp_name, shelf_num, $::resource,
|
||||
$::port_name, $::endp_type, $::mcast_port, NA,
|
||||
"$::speed", "$::max_speed", NA, $::min_pkt_sz,
|
||||
$::max_pkt_sz, "increasing", $::use_csums, "$::ttl", "0", "0");
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
$cmd = $::utils->fmt_cmd("set_mc_endp", $::endp_name, $::ttl, $::mcast_addr, $::mcast_port, $::rcv_mcast);
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_report_timer $::endp_name $::report_timer";
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
elsif ( grep { $_ eq $::endp_type} split(/,/, "lf_udp,lf_tcp,lf_udp6,lf_tcp6")) {
|
||||
die("Which port is this? --port_name")
|
||||
if (!defined $::port_name || $port_name eq "" || $port_name eq "0" );
|
||||
|
||||
die("Please set port speed: --speed")
|
||||
if ($::speed eq "-1"|| $::speed eq NA);
|
||||
|
||||
if ($::min_pkt_sz =~ /^\s*auto\s*$/i) {
|
||||
$::min_pkt_sz = "-1";
|
||||
}
|
||||
if ($::max_pkt_sz =~ /^\s*same\s*$/i ) {
|
||||
$::max_pkt_sz = "0";
|
||||
}
|
||||
elsif ($::max_pkt_sz =~ /^\s*auto\s*$/i) {
|
||||
$::max_pkt_sz = "-1";
|
||||
}
|
||||
|
||||
# Assume Layer-3 for now
|
||||
my $bursty = NA;
|
||||
my $random_sz = NA;
|
||||
my $payld_pat = "increasing";
|
||||
$::ttl = NA;
|
||||
my $bad_ppm = "0";
|
||||
$cmd = $::utils->fmt_cmd("add_endp", $::endp_name, shelf_num, $::resource,
|
||||
$::port_name, $::endp_type, $::ip_port, $bursty,
|
||||
$::speed, $::max_speed,
|
||||
$random_sz, $::min_pkt_sz, $::max_pkt_sz,
|
||||
$payld_pat, $::use_csums, $::ttl,
|
||||
$bad_ppm, $::multicon);
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_report_timer $::endp_name $::report_timer";
|
||||
$::utils->doCmd($cmd);
|
||||
|
||||
if ($::tos ne "") {
|
||||
my($service, $priority) = split(',', $::tos);
|
||||
$::utils->doCmd($::utils->fmt_cmd("set_endp_tos", $::endp_name, $service, $priority));
|
||||
}
|
||||
}
|
||||
else {
|
||||
die( "ERROR: Endpoint type: $::endp_type is not currently supported.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Set endp
|
||||
if ($speed ne "NA") {
|
||||
# Read the endpoint in...
|
||||
#my $endp1 = new LANforge::Endpoint();
|
||||
#$::utils->updateEndpoint($endp1, $endp_name);
|
||||
|
||||
# Assume Layer-3 for now
|
||||
$cmd = $::utils->fmt_cmd("add_endp", $endp_name, NA, NA, NA, NA, NA, NA, $speed, $max_speed);
|
||||
print("cmd: $cmd\n");
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($::action eq "start_endp") {
|
||||
$cmd = "start_endp $::endp_name";
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "stop_endp") {
|
||||
$cmd = "stop_endp $::endp_name";
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "delete_endp") {
|
||||
$cmd = "rm_endp $::endp_name";
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "show_port") {
|
||||
print $::utils->doAsyncCmd("nc_show_port 1 $::resource $::port_name") . "\n";
|
||||
}
|
||||
elsif ($::action eq "do_cmd") {
|
||||
print $::utils->doAsyncCmd("$::do_cmd") . "\n";
|
||||
}
|
||||
elsif ($::action eq "list_ports") {
|
||||
my @ports = $::utils->getPortListing(shelf_num, $::resource);
|
||||
my $i;
|
||||
for ($i = 0; $i<@ports; $i++) {
|
||||
my $cur = $ports[$i]->cur_flags();
|
||||
#print "cur-flags -:$cur:-\n";
|
||||
|
||||
print $ports[$i]->dev();
|
||||
if ($cur =~ /LINK\-UP/) {
|
||||
print " link=UP";
|
||||
}
|
||||
else {
|
||||
print " link=DOWN";
|
||||
}
|
||||
# Guess speed..need better CLI output API for more precise speed.
|
||||
if ($cur =~ /10G\-FD/) {
|
||||
print " speed=10G";
|
||||
}
|
||||
elsif ($cur =~ /1000\-/) {
|
||||
print " speed=1G";
|
||||
}
|
||||
elsif ($cur =~ /100bt\-/) {
|
||||
print " speed=100M";
|
||||
}
|
||||
elsif ($cur =~ /10bt\-/) {
|
||||
print " speed=10M";
|
||||
}
|
||||
else {
|
||||
print " speed=UNKNOWN";
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
elsif ($::action eq "list_cx") {
|
||||
$::cx_name = $::list_cx_name if ($::cx_name eq "");
|
||||
$::test_mgr = $::list_test_mgr if ($::test_mgr eq "");
|
||||
|
||||
my $cmd = $::utils->fmt_cmd("show_cxe", $::test_mgr, $::cx_name );
|
||||
my @lines = split(NL, $::utils->doAsyncCmd($cmd));
|
||||
my $out = '';
|
||||
my $num_ep = 0;
|
||||
for my $line (@lines) {
|
||||
#print " |||$line\n";
|
||||
if ($line =~ /\s*WAN_LINK CX:\s+([^ ]+)\s+id:.*$/ ) {
|
||||
$out .= "WL $1";
|
||||
}
|
||||
if ($line =~ /^WanLink\s+\[([^ ]+)\] .*$/ ) {
|
||||
$out .= ", wanlink $1";
|
||||
$num_ep++;
|
||||
}
|
||||
if ($line =~ /^\s*(WanLink|LANFORGE.*? CX):\s+([^ ]+) .*$/ ) {
|
||||
$out .= "CX $2";
|
||||
}
|
||||
if ($line =~ /^ARM_.*? CX:\s+([^ ]+) .*$/ ) {
|
||||
$out .= "CX $1";
|
||||
}
|
||||
if ($line =~ /^(Endpoint|ArmEndp) \[([^ \]]+)\].*$/) {
|
||||
$out .= ", endpoint $2";
|
||||
$num_ep++;
|
||||
}
|
||||
if (($line =~ /^ *$/) && ($num_ep >1)) {
|
||||
print "$out\n";
|
||||
$out = '';
|
||||
$num_ep = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($::action eq "show_cx") {
|
||||
# require a cx_name
|
||||
die("Please specify cx_name\n$::usage") if (length($::cx_name) < 1);
|
||||
if (length($::test_mgr) <1) {
|
||||
$::test_mgr = "default_tm";
|
||||
}
|
||||
my $cmd = $::utils->fmt_cmd("show_cxe", $::test_mgr, $::cx_name );
|
||||
print $::utils->doAsyncCmd($cmd)."\n";
|
||||
}
|
||||
elsif ($::action eq "create_cx") {
|
||||
# require cx_name, test_mgr, two endpoints
|
||||
die("Please name your cross connect: --cx_name\n$::usage") if ($::cx_name eq "");
|
||||
die("Please name two endpoints: --cx_endps\n$::usage") if ($::cx_endps eq "");
|
||||
|
||||
my ($end_a, $end_b) = split(/,/, $::cx_endps);
|
||||
die("Specify two endpoints like: eth1,eth2 \n$::usage")
|
||||
if ((length($end_a) < 1) || (length($end_b) < 1));
|
||||
|
||||
my $cmd = $::utils->fmt_cmd("add_cx", $::cx_name, $::test_mgr, $end_a, $end_b);
|
||||
$::utils->doCmd($cmd);
|
||||
my $cxonly = NA;
|
||||
$cmd = $::utils->fmt_cmd("set_cx_report_timer", $::test_mgr, $::cx_name, $::report_timer, $cxonly);
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
elsif ($::action eq "delete_cx") {
|
||||
# require cx_name
|
||||
die("Which test manager?: --test_mgr\n$::usage") if ($::test_mgr eq "");
|
||||
die("Which cross connect? --cx_name\n$::usage") if ($::cx_name eq "");
|
||||
$::utils->doCmd($::utils->fmt_cmd("rm_cx", $::test_mgr, $::cx_name));
|
||||
}
|
||||
else {
|
||||
die("Unknown action: $::action\n$::usage\n");
|
||||
}
|
||||
|
||||
exit(0);
|
||||
375
lf_ice.pl
Executable file
375
lf_ice.pl
Executable file
@@ -0,0 +1,375 @@
|
||||
#!/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.
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Updated by: hkwynn@candelatech.com
|
||||
#
|
||||
#
|
||||
#
|
||||
# Creates a WanLink with 128 WanPaths for performance testing.
|
||||
|
||||
|
||||
use strict;
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
my $lfmgr_host = "192.168.100.152";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $ice_card = 1;
|
||||
|
||||
# The ICE ports, on ice_card
|
||||
my $ice1 = 1;
|
||||
my $ice2 = 2;
|
||||
|
||||
my $test_mgr = "vanilla-ice"; # Couldn't resist!
|
||||
|
||||
my $report_timer = 1000; # XX/1000 seconds
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
my $quiet = "no";
|
||||
my $init_to_dflts = "yes";
|
||||
|
||||
my $latency = 35; # miliseconds
|
||||
my $jitter = 10;
|
||||
my $reorder = 0;
|
||||
my $smoothing_buffer = 20000; # XXk smoothing buffer
|
||||
my $drop_freq = 0;
|
||||
my $dup_freq = 0;
|
||||
my $max_wlrate = 1000000000;
|
||||
my $wl_kmode = 1; # Set to 0 for user-space mode, 1 for kernel mode
|
||||
|
||||
# WanPath related settings.
|
||||
my $max_wp_rate = 10000000;
|
||||
my $wp_ip_base = "172.2.2";
|
||||
my $wp_ip_lcb = 2;
|
||||
my $wp_ip_mask = "255.255.255.255";
|
||||
my $wp_lat = 10;
|
||||
my $wp_jitter = 10;
|
||||
my $wp_extra_buf = 512;
|
||||
my $wp_reord = 0;
|
||||
my $wp_dup = 0;
|
||||
my $wp_drop = 0;
|
||||
|
||||
|
||||
# Dest matches all
|
||||
my $wp_dst = "0.0.0.0";
|
||||
my $wp_dst_mask = "0.0.0.0";
|
||||
|
||||
my $wp_count = 128;
|
||||
|
||||
my $fail_msg = "";
|
||||
my $manual_check = 0;
|
||||
|
||||
my $cmd_log_name = "lf_ice.txt";
|
||||
open(CMD_LOG, ">$cmd_log_name") or die("Can't open $cmd_log_name for writing...\n");
|
||||
print "History of all commands can be found in $cmd_log_name\n";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $usage = "$0 [--quiet {yes | no}]
|
||||
[--init_to_dflts {yes | no}]
|
||||
|
||||
Example:
|
||||
$0 --init_to_dflts yes\n";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'quiet|q=s' => \$quiet,
|
||||
'init_to_dflts|d=s' => \$init_to_dflts,
|
||||
) || die("$usage");
|
||||
|
||||
|
||||
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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
|
||||
# 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
|
||||
if ($quiet eq "yes") {
|
||||
$utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
|
||||
my $dt = "";
|
||||
|
||||
if ($init_to_dflts eq "yes") {
|
||||
initToDefaults();
|
||||
|
||||
# Now, add back the test manager we will be using
|
||||
$utils->doCmd("add_tm $test_mgr");
|
||||
$utils->doCmd("tm_register $test_mgr default"); #Add default user
|
||||
$utils->doCmd("tm_register $test_mgr default_gui"); #Add default GUI user
|
||||
|
||||
setUpPorts();
|
||||
}
|
||||
|
||||
# $utils->doCmd("log_level 63");
|
||||
|
||||
|
||||
# Create the connections we will be manipulating.
|
||||
my $i = 0;
|
||||
my $cmd = "";
|
||||
|
||||
|
||||
my $ep1 = "wan1-A";
|
||||
my $ep2 = "wan1-B";
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Create the two LANforge-ICE endpoints.
|
||||
$cmd = "add_wl_endp $ep1 $shelf_num $ice_card $ice1 $latency $max_wlrate";
|
||||
$utils->doCmd($cmd);
|
||||
$cmd = "set_wanlink_info $ep1 $max_wlrate $latency $jitter $reorder $smoothing_buffer $drop_freq $dup_freq";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
# Create the two LANforge-ICE endpoints.
|
||||
$cmd = "add_wl_endp $ep2 $shelf_num $ice_card $ice2 $latency $max_wlrate";
|
||||
$utils->doCmd($cmd);
|
||||
$cmd = "set_wanlink_info $ep2 $max_wlrate $latency $jitter $reorder $smoothing_buffer $drop_freq $dup_freq";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
$utils->doCmd("set_endp_flag $ep1 KernelMode $wl_kmode");
|
||||
$utils->doCmd("set_endp_flag $ep2 KernelMode $wl_kmode");
|
||||
|
||||
|
||||
|
||||
# Add the ICE cross connect.
|
||||
my $cx_name = "wanlink1";
|
||||
$cmd = "add_cx $cx_name $test_mgr $ep1 $ep2";
|
||||
$utils->doCmd($cmd);
|
||||
$utils->doCmd("set_cx_report_timer $test_mgr $cx_name $report_timer");
|
||||
|
||||
@cx_names = (@cx_names, $cx_name);
|
||||
|
||||
# Add the wanpaths
|
||||
for ($i = 0; $i<$wp_count; $i++) {
|
||||
# Add wanpath with specified source and ANY dest.
|
||||
$cmd = "add_wanpath $ep1 wp$wp_ip_lcb $max_wp_rate $wp_lat $wp_jitter $wp_extra_buf $wp_reord $wp_drop $wp_dup ${wp_ip_base}.$wp_ip_lcb $wp_ip_mask $wp_dst $wp_dst_mask OFF 'NA' YES NO NO NO";
|
||||
$utils->doCmd($cmd);
|
||||
# Add wanpath with specified dest and ANY source.
|
||||
$cmd = "add_wanpath $ep2 wp$wp_ip_lcb $max_wp_rate $wp_lat $wp_jitter $wp_extra_buf $wp_reord $wp_drop $wp_dup 0.0.0.0 0.0.0.0 ${wp_ip_base}.$wp_ip_lcb $wp_ip_mask OFF 'NA' YES NO NO NO";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
$wp_ip_lcb++;
|
||||
}
|
||||
|
||||
|
||||
|
||||
for ($i = 0; $i<@cx_names; $i++) {
|
||||
my $nm = $cx_names[$i];
|
||||
$cmd = "set_cx_state $test_mgr $nm RUNNING";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
|
||||
sleep(24 * 60 * 60); # Run for one day
|
||||
|
||||
# Stop cxs.
|
||||
for ($i = 0; $i<@cx_names; $i++) {
|
||||
my $nm = $cx_names[$i];
|
||||
$cmd = "set_cx_state $test_mgr $nm STOPPED";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
|
||||
exit(0);
|
||||
|
||||
|
||||
sub initToDefaults {
|
||||
# Clean up database if stuff exists
|
||||
|
||||
$utils->doCmd("rm_cx $test_mgr all");
|
||||
$utils->doCmd("rm_endp YES_ALL");
|
||||
$utils->doCmd("rm_test_mgr $test_mgr");
|
||||
|
||||
}#initToDefaults
|
||||
|
||||
|
||||
sub testFailed {
|
||||
my $msg = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
if (defined($should_fail) && ($should_fail eq "YES")) {
|
||||
print "\nGOOD: SUB-TEST FAILED correctly: $msg\n";
|
||||
$fail_msg .= "GOOD (should fail): $msg";
|
||||
}
|
||||
else {
|
||||
print "\nSUB-TEST FAILED: $msg\n";
|
||||
$fail_msg .= $msg;
|
||||
|
||||
if ($manual_check) {
|
||||
#$utils->doCmd("log_level 7");
|
||||
print "Press enter to continue with test: ";
|
||||
<STDIN>;
|
||||
}
|
||||
else {
|
||||
die("FATAL ERROR: $fail_msg\n");
|
||||
}
|
||||
}
|
||||
}#testFailed
|
||||
|
||||
sub setUpPorts {
|
||||
|
||||
# Nothing to do at this point.
|
||||
|
||||
}#setUpPorts
|
||||
|
||||
|
||||
sub setUpPort {
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $ip = shift;
|
||||
my $msk = shift;
|
||||
my $gw = shift;
|
||||
|
||||
my $cmd = "set_port $sn $cn $pn $ip $msk $gw NA NA NA";
|
||||
$utils->doCmd($cmd);
|
||||
my $p1 = new LANforge::Port();
|
||||
# Tell the port what it is so it decodes the right one..
|
||||
$utils->updatePort($p1, $sn, $cn, $pn);
|
||||
# Make sure the values we attempted to set actually worked.
|
||||
verifyPortAttributes($p1, $sn, $cn, $pn, $ip, $msk, $gw);
|
||||
}#setUpPort
|
||||
|
||||
|
||||
sub verifyPortAttributes {
|
||||
my $port = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $ip = shift;
|
||||
my $msk = shift;
|
||||
my $gw = shift;
|
||||
|
||||
my $_sn = $port->shelf_id();
|
||||
my $_cn = $port->card_id();
|
||||
my $_pn = $port->port_id();
|
||||
my $_ipa = $port->ip_addr();
|
||||
|
||||
my $p = $port->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n");
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n");
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n");
|
||||
$_ipa eq $ip or testFailed("$p: IP Address: $_ipa does not match: $ip\n");
|
||||
$port->ip_mask() eq $msk or testFailed("$p: IP Mask: " . $port->ip_mask() . " does not match: $msk\n");
|
||||
$port->ip_gw() eq $gw or testFailed("$p: IP Gateway: " . $port->ip_gw() . " does not match: $gw\n");
|
||||
|
||||
print "$p verified as correct!\n";
|
||||
}#verifyPortAttributes
|
||||
|
||||
|
||||
sub verifyEndpointAttributes {
|
||||
my $endp = shift;
|
||||
my $name = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $type = shift;
|
||||
my $ip_port = shift;
|
||||
my $bursty = shift;
|
||||
my $min_rate = shift;
|
||||
my $max_rate = shift;
|
||||
my $szrnd = shift;
|
||||
my $min_pkt_sz = shift;
|
||||
my $max_pkt_sz = shift;
|
||||
my $pattern = shift;
|
||||
my $using_csum = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
my $_sn = $endp->shelf_id();
|
||||
my $_cn = $endp->card_id();
|
||||
my $_pn = $endp->port_id();
|
||||
|
||||
my $p = $endp->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n", $should_fail);
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n", $should_fail);
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n", $should_fail);
|
||||
$endp->isOfType($type) or testFailed("$p: Type: " . $endp->ep_type() . " does not match: $type\n", $should_fail);
|
||||
if ($ip_port ne -1) {
|
||||
$endp->ip_port() eq $ip_port or testFailed("$p: IP-Port: " . $endp->ip_port() .
|
||||
" does not match: $ip_port\n", $should_fail);
|
||||
}
|
||||
$endp->getBursty() eq $bursty or testFailed("$p: Bursty: " . $endp->getBursty() .
|
||||
" does not match: $bursty\n", $should_fail);
|
||||
|
||||
$endp->min_tx_rate() eq $min_rate or testFailed("$p: Min-Tx-Rate: " . $endp->min_tx_rate() .
|
||||
" does not match: $min_rate\n", $should_fail);
|
||||
$endp->max_tx_rate() eq $max_rate or testFailed("$p: Max-Tx-Rate: " . $endp->max_tx_rate() .
|
||||
" does not match: $max_rate\n", $should_fail);
|
||||
|
||||
if ($endp->isCustom()) {
|
||||
($endp->size_random() eq "NO") or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" but we are CUSTOM!!\n", $should_fail);
|
||||
}
|
||||
else {
|
||||
$endp->size_random() eq $szrnd or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" does not match: $szrnd\n", $should_fail);
|
||||
}
|
||||
|
||||
if (! $endp->isCustom()) {
|
||||
$endp->min_pkt_size() eq $min_pkt_sz or testFailed("$p: Min-Packet-Size: " . $endp->min_pkt_size() .
|
||||
" does not match: $min_pkt_sz\n", $should_fail);
|
||||
$endp->max_pkt_size() eq $max_pkt_sz or testFailed("$p: Max-Packet-Size: " . $endp->max_pkt_size() .
|
||||
" does not match: $max_pkt_sz\n", $should_fail);
|
||||
}
|
||||
$endp->pattern() eq $pattern or testFailed("$p: Pattern: " . $endp->pattern() .
|
||||
" does not match: $pattern\n", $should_fail);
|
||||
$endp->checksum() eq $using_csum or testFailed("$p: Using-Checksum: " . $endp->checksum() .
|
||||
" does not match: $using_csum\n", $should_fail);
|
||||
|
||||
}#verifyEndpointAttributes
|
||||
|
||||
|
||||
sub genRandomHex {
|
||||
my $bytes = shift;
|
||||
|
||||
my @tbl = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f");
|
||||
my $i;
|
||||
my $pld = "";
|
||||
for ($i = 0; $i<$bytes; $i++) {
|
||||
$pld .= $tbl[(rand() * 1000.0) % 16] . $tbl[(rand() * 1000.0) % 16]; #Generate some hex the hard way!
|
||||
if ($i != ($bytes - 1)) {
|
||||
$pld .= " ";
|
||||
}
|
||||
}
|
||||
|
||||
return $pld;
|
||||
}#genRandomHex
|
||||
194
lf_icemod.pl
Executable file
194
lf_icemod.pl
Executable file
@@ -0,0 +1,194 @@
|
||||
#!/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.
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Updated by: greearb@candelatech.com
|
||||
#
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $ice_card = 1;
|
||||
|
||||
# The ICE ports, on ice_card
|
||||
my $ice1 = 1;
|
||||
my $ice2 = 2;
|
||||
|
||||
my $test_mgr = "vanilla-ice"; # Couldn't resist!
|
||||
|
||||
my $report_timer = 1000; # XX/1000 seconds
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
|
||||
my $endp_name = "";
|
||||
my $speed = "";
|
||||
my $drop_pm = "";
|
||||
my $latency = "";
|
||||
my $jitter = "";
|
||||
my $switch = "";
|
||||
my $pcap = "";
|
||||
my $load = "";
|
||||
my $state = "";
|
||||
my $cx = "";
|
||||
my $quiet = 0;
|
||||
|
||||
my $fail_msg = "";
|
||||
my $manual_check = 0;
|
||||
|
||||
my $cmd_log_name = "lf_icemod.txt";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $usage = "$0 --endp_name {name}
|
||||
[--cx {name}]
|
||||
[--speed {speed in bps}]
|
||||
[--drop_pm { 0 - 1000000}]
|
||||
[--latency { 0 - 1000000}]
|
||||
[--switch new_cx_to_run ]
|
||||
[--manager { network address of LANforge manager} ]
|
||||
[--pcap { dir-name | off } ]
|
||||
[--load { db-name } ]
|
||||
[--state { running | switch | quiesce | stopped | deleted } ]
|
||||
|
||||
Example:
|
||||
lf_icemod.pl --manager lanforge1 --endp_name t1-A --speed 154000 --drop_pm 10000 --latency 35
|
||||
lf_icemod.pl --manager 192.168.100.223 --switch t3
|
||||
lf_icemod.pl --state running --cx t3
|
||||
lf_icemod.pl --pcap /tmp/endp-a --endp_name t1-A
|
||||
lf_icemod.pl --load my_db
|
||||
";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'endp_name|e=s' => \$endp_name,
|
||||
'speed|s=i' => \$speed,
|
||||
'cx|c=s' => \$cx,
|
||||
'drop_pm|d=i' => \$drop_pm,
|
||||
'latency|l=i' => \$latency,
|
||||
'jitter|j=i' => \$jitter,
|
||||
'switch|w=s' => \$switch,
|
||||
'manager|m=s' => \$lfmgr_host,
|
||||
'pcap|p=s' => \$pcap,
|
||||
'load|L=s' => \$load,
|
||||
'state|S=s' => \$state,
|
||||
'quiet|q=i' => \$quiet,
|
||||
|
||||
) || die("$usage");
|
||||
|
||||
if (! ($quiet == 0xffff)) {
|
||||
open(CMD_LOG, ">$cmd_log_name") or die("Can't open $cmd_log_name for writing...\n");
|
||||
if (! ($quiet & 0x2)) {
|
||||
print "History of all commands can be found in $cmd_log_name\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
# 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
|
||||
if ($quiet & 0x1) {
|
||||
$utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
# $utils->doCmd("log_level 63");
|
||||
my $cmd;
|
||||
|
||||
if ($load ne "") {
|
||||
$cmd = "load $load overwrite";
|
||||
$utils->doCmd($cmd);
|
||||
my @rslt = $t->waitfor("/LOAD-DB: Load attempt has been completed./");
|
||||
if (!($quiet & 0x1)) {
|
||||
print @rslt;
|
||||
print "\n";
|
||||
}
|
||||
exit(0);
|
||||
}
|
||||
|
||||
if ($switch ne "") {
|
||||
$cmd = "set_cx_state all $switch SWITCH";
|
||||
$utils->doCmd($cmd);
|
||||
exit(0);
|
||||
}
|
||||
|
||||
if ((length($endp_name) == 0) && (length($cx) == 0)) {
|
||||
print "ERROR: Must specify endp or cx name.\n";
|
||||
die("$usage");
|
||||
}
|
||||
|
||||
if ($pcap ne "") {
|
||||
if (($pcap eq "OFF") ||
|
||||
($pcap eq "off")) {
|
||||
$cmd = "set_wanlink_pcap $endp_name off";
|
||||
}
|
||||
else {
|
||||
$cmd = "set_wanlink_pcap $endp_name ON $pcap";
|
||||
}
|
||||
$utils->doCmd($cmd);
|
||||
exit(0);
|
||||
}
|
||||
|
||||
if ($state ne "") {
|
||||
$cmd = "set_cx_state all $cx $state";
|
||||
$utils->doCmd($cmd);
|
||||
exit(0);
|
||||
}
|
||||
|
||||
# Assumes that the endpoint already exists.
|
||||
if ($latency eq "") {
|
||||
$latency = "NA";
|
||||
}
|
||||
if ($speed eq "") {
|
||||
$speed = "NA";
|
||||
}
|
||||
if ($jitter eq "") {
|
||||
$jitter = "NA";
|
||||
}
|
||||
|
||||
if ($drop_pm eq "") {
|
||||
$drop_pm = "NA";
|
||||
}
|
||||
|
||||
$cmd = "set_wanlink_info $endp_name $speed $latency $jitter NA NA $drop_pm NA";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
exit(0);
|
||||
|
||||
292
lf_l4_auth.pl
Executable file
292
lf_l4_auth.pl
Executable file
@@ -0,0 +1,292 @@
|
||||
#!/usr/bin/perl -w
|
||||
#-----------------------------------------------------------------------#
|
||||
# This program is used to create layer-4 connections with #
|
||||
# IP4 addresses correlated to username/password combinations #
|
||||
# and get some basic information from LANforge. #
|
||||
# #
|
||||
# Written by Candela Technologies Inc. #
|
||||
#-----------------------------------------------------------------------#
|
||||
package main;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
$| = 1;# Un-buffer output
|
||||
use lib '/home/lanforge/scripts';
|
||||
use Getopt::Long;
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use POSIX;
|
||||
use constant NA => "NA";
|
||||
use constant NL => "\n";
|
||||
use constant shelf_num => 1;
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
our $quiet ="yes";
|
||||
our $resource = 1;
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
our $report_timer = 5000;
|
||||
our $outfile_pref = "l4-out";
|
||||
our $l4timeout = 1000 * 60 * 1; # minutes
|
||||
our $url_rate = 600; # urls/10min
|
||||
our $test_mgr = "l4_connections";
|
||||
our $port_range = undef;
|
||||
our $auth_pref = undef;
|
||||
our $target_url = undef;
|
||||
our $port_name = undef;
|
||||
our $first_port = undef;
|
||||
our $last_port = undef;
|
||||
our $user_pref = undef;
|
||||
our $pass_pref = undef;
|
||||
|
||||
#-----------------------------------------------------------------------#
|
||||
# Nothing to configure below here, most likely. #
|
||||
#-----------------------------------------------------------------------#
|
||||
|
||||
our $usage = "\nUsage: $0 --mgr {host-name | IP}
|
||||
--mgr_port {ip port}
|
||||
--resource {number}
|
||||
--report_timer {milliseconds}
|
||||
--quiet {yes|no}
|
||||
--timeout {millis} # url timeout in milliseconds ($::l4timeout ms)
|
||||
--url_rate {per 10 min) # requests per 10 minutes ($::url_rate)
|
||||
--port_range {first-last} # eg rd0#0-rd0#99 < keep name short!
|
||||
--auth_pref {1-4 chars,1-4 chars} # u,p appended with last octet: u101 p101
|
||||
--target_url {http://hostname/path} # http(s) urls will be rewritten to
|
||||
# http://hostname/path?user=u&pass=p
|
||||
--outfile_pref {l4-out} # found in /home/lanforge/l4logs
|
||||
|
||||
Example:
|
||||
|
||||
$0 --port_range rd2#0-rd2#99 --auth_pref u,p \
|
||||
--target_url 'http://10.99.0.2/index.html'
|
||||
|
||||
$0 --mgr 192.168.101.1 --mgr_port 4001 --resource 1 \\
|
||||
--port_range rd0#0-rd0#25 --report_timer 1000 \\
|
||||
--auth_pref bob,pas \\
|
||||
--target_url 'https://10.99.0.2/index.html' \\
|
||||
--outfile_pref 'req_log' \\
|
||||
--url_rate 6000 \\
|
||||
--timeout 120000
|
||||
|
||||
(*) first create macvlans with a gateway inside a virtual router
|
||||
";
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port|p=i' => \$::lfmgr_port,
|
||||
'resource|r=i' => \$::resource,
|
||||
'port_range=s' => \$::port_range,
|
||||
'report_timer=i' => \$::report_timer,
|
||||
'auth_pref|ap=s' => \$::auth_pref,
|
||||
'target_url|u=s' => \$::target_url,
|
||||
'outfile_pref|op=s' => \$::outfile_pref,
|
||||
'timeout|to=i' => \$::l4timeout,
|
||||
'url_rate=i' => \$::url_rate,
|
||||
) || die("$::usage");
|
||||
|
||||
if ( length($::port_range) < 1
|
||||
|| length($::auth_pref) < 1
|
||||
|| length($::target_url) < 1) {
|
||||
die( "missing port_range, auth_pref, or target_url: $::usage");
|
||||
}
|
||||
#print "PortRange: $::port_range\n";
|
||||
($::port_name, $::first_port, $::last_port) = $::port_range =~ /([[:alnum:]]+[^[:alnum:]])(\d+)-[[:alnum:]]+[^[:alnum:]](\d+)/;
|
||||
#print "PortName[$::port_name] FirstPort[$::first_port] LastPort[$::last_port]\n";
|
||||
#print "AuthPrefix: $::auth_pref\n";
|
||||
($::user_pref, $::pass_pref) = $::auth_pref =~ /^\s*(\S+)\s*,\s*(\S+)\s*$/;
|
||||
#print "UserPrefix[$::user_pref] PassPrefix[$::pass_pref]\n";
|
||||
|
||||
|
||||
if ( !defined($::port_name) || length($::port_name) < 1
|
||||
|| !defined($::first_port) || length($::first_port)< 1
|
||||
|| !defined($::last_port) || length($::last_port) < 1
|
||||
|| !defined($::user_pref) || length($::user_pref) < 1
|
||||
|| !defined($::pass_pref) || length($::pass_pref) < 1) {
|
||||
die( "missing port_name, first_port, last_port, user_pref, or pass_pref: $::usage");
|
||||
}
|
||||
|
||||
our ($schema, $host, $path) = $::target_url =~ /\s*(https?):\/\/([^\/]+)(\/?.*?)\s*$/;
|
||||
#print "schema[$schema] host[$host] path[$path]\n";
|
||||
|
||||
#----------------------------------------------------------------------#
|
||||
# Wait up to 20 seconds when requesting info from LANforge.
|
||||
our $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
$::t->open( Host => $::lfmgr_host,
|
||||
Port => $::lfmgr_port,
|
||||
Timeout => 10);
|
||||
$::t->max_buffer_length(8 * 1024 * 1000); # 8 MB buffer
|
||||
$::t->waitfor("/btbits\>\>/");
|
||||
|
||||
#-----------------------------------------------------------------------#
|
||||
# compat #
|
||||
#-----------------------------------------------------------------------#
|
||||
if ( !defined *LANforge::Utils::fmt_cmd ) {
|
||||
#*LANforge::Utils::fmt_cmd = sub {
|
||||
sub LANforge::Utils::fmt_cmd {
|
||||
my $self = shift;
|
||||
my $rv;
|
||||
for my $hunk (@_) {
|
||||
$rv .= ( $hunk =~ / +/) ? "'$hunk' " : "$hunk ";
|
||||
}
|
||||
chomp $rv;
|
||||
return $rv;
|
||||
};
|
||||
}
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------#
|
||||
|
||||
$::utils->telnet($::t); # Set our telnet object.
|
||||
if ($::quiet eq "yes") {
|
||||
$::utils->cli_send_silent(1); # Do show input to CLI
|
||||
$::utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(0); # Do show input to CLI
|
||||
$::utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
#-----------------------------------------------------------------------#
|
||||
# survey ports, complain if they are not present #
|
||||
#-----------------------------------------------------------------------#
|
||||
|
||||
our %port_ips = ();
|
||||
our %port_quads = ();
|
||||
our %port_urls = ();
|
||||
our %port_download= ();
|
||||
our %port_file = ();
|
||||
my $method = 1;
|
||||
my $match = '(IP: \S+)\s';
|
||||
my $tmp_quad;
|
||||
my $tmp_ip;
|
||||
for (my $i = $::first_port; $i <= $::last_port; $i++) {
|
||||
my $tmp_name = $::port_name.$i;
|
||||
my @txt = split(/\n/, $::utils->doAsyncCmd("nc_show_port 1 $::resource $tmp_name"));
|
||||
if (my ($matched) = grep(/$match/, @txt)) {
|
||||
#print "$::port_name$i: found it: $matched\n";
|
||||
($tmp_ip) = $matched =~ /^\s+IP: ([0-9.]+)\s+MASK.*$/;
|
||||
($tmp_quad) = $matched =~ /^\s+IP: [0-9.]+\.([^. ]+)\s+MASK.*$/;
|
||||
#print "tmp_quad $tmp_quad tmp_ip:$tmp_ip\n";
|
||||
}
|
||||
$::port_quads{$i} = $tmp_quad;
|
||||
$::port_ips{$i} = $tmp_ip;
|
||||
#print "last_q[$tmp_quad]\n";
|
||||
}
|
||||
|
||||
|
||||
#-----------------------------------------------------------------------#
|
||||
# M A I N #
|
||||
#-----------------------------------------------------------------------#
|
||||
# for every port, build the following items: #
|
||||
# - url with user:pass #
|
||||
# - input file url like "dl $url $outfile-$i #
|
||||
# - create l4 connection with 'use url file' #
|
||||
#-----------------------------------------------------------------------#
|
||||
|
||||
my $l4path="/home/lanforge/l4-urls";
|
||||
if ( !-d $l4path ) {
|
||||
mkdir $l4path || die "cannot make $l4path";
|
||||
}
|
||||
|
||||
our $use_url_file = 1;
|
||||
|
||||
for (my $i = $::first_port; $i <= $::last_port; $i++) {
|
||||
#print "port_quads:".$i."[".$::port_quads{$i}."]\n";
|
||||
my $tmp_quad = $::port_quads{$i};
|
||||
#print "tmp_quad[$tmp_quad]\n";
|
||||
|
||||
# style for basic/auth
|
||||
#my $url = $::schema."://".$::user_pref.$tmp_quad.':'.$::pass_pref.$tmp_quad."@".$::host.$::path;
|
||||
|
||||
#get style
|
||||
my $url = $::schema.'://'.$::host.$::path.'?username='.$::user_pref.$tmp_quad.'&password='.$::pass_pref.$tmp_quad;
|
||||
|
||||
print "url[$url]\n";
|
||||
$::port_urls{$i} = $url;
|
||||
$::port_download{$i} = "dl $url $l4path/$outfile_pref-$port_name$i.txt\n";
|
||||
$::port_file{$i} = "$l4path/dl_$port_name$i.txt";
|
||||
}
|
||||
|
||||
my $proxy_server = NA;
|
||||
my $proxy_userpwd = NA;
|
||||
my $ssl_cert_fname = "ca-bundle.crt";
|
||||
my $user_agent = NA;
|
||||
my $proxy_auth_type = "0";
|
||||
my $http_auth = 3; # | 0x2; for digest
|
||||
my $dns_cache_to = 60; #default
|
||||
my $max_speed = 0;
|
||||
my $block_size = NA;
|
||||
my $smtp_from = NA;
|
||||
|
||||
# create test-mgr
|
||||
my @testmgrs = split(/\n/, $::utils->doCmd("show_tm all"));
|
||||
if( my($tmmatches) = grep /$::test_mgr/, @testmgrs) {
|
||||
#print "test_mgr:$tmmatches\n";
|
||||
}
|
||||
else {
|
||||
$::utils->doCmd("add_tm $::test_mgr");
|
||||
}
|
||||
|
||||
|
||||
|
||||
for (my $i = $::first_port; $i <= $::last_port; $i++) {
|
||||
# create dummy endpoint
|
||||
my $tmp_ep1 = "L4_$port_name$i";
|
||||
my $tmp_ep2 = "D_L4_$port_name$i";
|
||||
my $cmd = $::utils->fmt_cmd( "add_l4_endp", $tmp_ep2,
|
||||
shelf_num, $::resource, "$port_name$i",
|
||||
"l4_generic", 0, 0, 0, ' ', ' ');
|
||||
#print "cmd: $cmd\n";
|
||||
$::utils->doCmd($cmd);
|
||||
$cmd = $cmd = "set_endp_flag $tmp_ep2 unmanaged 1";
|
||||
#print "cmd: $cmd\n";
|
||||
$::utils->doCmd($cmd);
|
||||
#sleep(0.2);
|
||||
|
||||
# create live endpoint
|
||||
my $ip_addr = $::port_ips{$i};
|
||||
|
||||
open(my $fh, ">", $::port_file{$i} ) || die "unable to create file $::port_file{$i}";
|
||||
print $fh $::port_download{$i};
|
||||
close $fh;
|
||||
|
||||
# layer4 endpoint
|
||||
my $url = ($::use_url_file)
|
||||
? $::port_file{$i}
|
||||
: $::port_download{$i}
|
||||
;
|
||||
$cmd = $::utils->fmt_cmd( "add_l4_endp", $tmp_ep1,
|
||||
shelf_num, $::resource, "$port_name$i",
|
||||
"l4_generic", 0, $::l4timeout, $::url_rate,
|
||||
$url, $proxy_server, $proxy_userpwd,
|
||||
$ssl_cert_fname, $user_agent, $proxy_auth_type,
|
||||
$http_auth, $dns_cache_to, $max_speed, $block_size,
|
||||
$smtp_from, "AUTO" );
|
||||
#print "cmd: $cmd\n";
|
||||
$::utils->doCmd($cmd);
|
||||
#sleep(0.2);
|
||||
if ($::use_url_file) {
|
||||
$cmd = $::utils->fmt_cmd("set_endp_flag", "$tmp_ep1", "GetUrlsFromFile", 1);
|
||||
$::utils->doCmd($cmd);
|
||||
#sleep(0.2);
|
||||
}
|
||||
#$::utils->doCmd("set_cx_report_timer $::test_mgr $tmp_ep1 $report_timer");
|
||||
#sleep(0.2);
|
||||
|
||||
my $cx_name = "CX_$tmp_ep1"; # was CX-L4-
|
||||
$cmd = $::utils->fmt_cmd("add_cx", $cx_name, $test_mgr, $tmp_ep1, $tmp_ep2);
|
||||
#print "cmd: $cmd\n";
|
||||
$::utils->doCmd($cmd);
|
||||
#sleep(0.2);
|
||||
$::utils->doCmd("set_cx_report_timer $::test_mgr $cx_name $report_timer");
|
||||
}
|
||||
|
||||
#
|
||||
128
lf_l4_reset.sh
Executable file
128
lf_l4_reset.sh
Executable file
@@ -0,0 +1,128 @@
|
||||
#!/bin/bash
|
||||
# This script will reset any layer 4 connection that reaches 0 Mbps over last minute.
|
||||
# Run this script from the /home/lanforge/scripts directory.
|
||||
|
||||
|
||||
# Custom variables
|
||||
# Use DB to set a database to load.
|
||||
# Use mgr to have this script run on another system (replace localhost with ip or hostname).
|
||||
# Use rate to change how often the script checks layer 4 endpoints (default is 60s).
|
||||
DB=""
|
||||
mgr="localhost"
|
||||
napTime="30s"
|
||||
min="0"
|
||||
|
||||
### Should not need to change anything below this line! ###
|
||||
|
||||
function show_help() {
|
||||
echo "$0 -m <manager> -d <delay> -n <minimum-bps> -l <database>"
|
||||
echo " --mgr <manager> --delay <seconds> --min <minimum-bps> --load <database>"
|
||||
echo ""
|
||||
exit
|
||||
}
|
||||
|
||||
ARGS=`getopt -o d:l:m:n:h --long help,load:,delay:,mgr:,min: -- "$@"`
|
||||
|
||||
while :; do
|
||||
case "$1" in
|
||||
-l|--load) DB="$2"; shift 2 ;;
|
||||
|
||||
-d|--delay) napTime="$2"; shift 2 ;;
|
||||
|
||||
-m|--mgr) mgr="$2"; shift 2 ;;
|
||||
|
||||
-n|--min) min="$2"; shift 2 ;;
|
||||
|
||||
--) shift; break;;
|
||||
|
||||
-h|--help)
|
||||
show_help
|
||||
exit 1 ;;
|
||||
*) break;;
|
||||
esac
|
||||
done
|
||||
|
||||
echo -n "Options --mgr $mgr --delay $napTime --min $min"
|
||||
if [[ $DB != "" ]]; then
|
||||
echo -n "--db $DB"
|
||||
fi
|
||||
echo ""
|
||||
|
||||
# Load DB (if provided above)
|
||||
if [[ ! $DB = "" ]]; then
|
||||
echo -n "Loading database $DB..."
|
||||
./lf_portmod.pl --manager $mgr --load $DB > /dev/null
|
||||
sleep 10s
|
||||
echo "...done"
|
||||
fi
|
||||
echo "Press Control-C to stop..."
|
||||
|
||||
while : ; do
|
||||
# List layer-4 cx
|
||||
l4output=`./lf_firemod.pl --mgr $mgr --cmd "show_cx" \
|
||||
| grep "type: L4_GENERIC" | awk ' ''{print $3}' | cut -d "_" -f 2- \
|
||||
| sort | uniq`
|
||||
|
||||
# We get all the statuses we can get because that it a lot faster
|
||||
# than querying one status at a time
|
||||
allStatuses=`./lf_firemod.pl --mgr $mgr --action show_endp`
|
||||
|
||||
l4list=($l4output)
|
||||
for i in "${l4list[@]}"
|
||||
do
|
||||
# if we call lf_firemod multiple times we have to wait on
|
||||
# the manager and it ends up taking longer than our dwell time
|
||||
# endp_status=`./lf_firemod.pl --mgr $mgr --action show_endp --endp_name`
|
||||
|
||||
endp_status=`echo "$allStatuses" | awk "/L4Endp \[$i\]/{flag=1}/^\$/{flag=0}flag"`
|
||||
|
||||
#echo '---------------------------------------'
|
||||
#echo "$endp_status"
|
||||
#echo '---------------------------------------'
|
||||
|
||||
l4read=`echo "$endp_status" | awk '/Bytes Read/ {print $8}'`
|
||||
l4write=`echo "$endp_status" | awk '/Bytes Written/ {print $8}'`
|
||||
runChk=`echo "$endp_status" | grep '^L4Endp '`
|
||||
runStat=`echo "$runChk" | sed 's/L4Endp \[.*\] (\(.*\))/\1/'`
|
||||
|
||||
checkSpeed=0
|
||||
doL4Restart=0
|
||||
case "$runStat" in
|
||||
"RUNNING")
|
||||
checkSpeed=1
|
||||
;;
|
||||
"RUNNING, ALLOW_REUSE")
|
||||
checkSpeed=1
|
||||
;;
|
||||
"NOT_RUNNING")
|
||||
doL4Restart=1
|
||||
;;
|
||||
"NOT_RUNNING, WAIT_RESTART")
|
||||
doL4Restart=1
|
||||
;;
|
||||
"NOT_RUNNING, ALLOW_REUSE")
|
||||
;;
|
||||
*)
|
||||
echo "Unknown case ${i}[$runStat]"
|
||||
;;
|
||||
esac
|
||||
|
||||
if (( $checkSpeed == 1 )); then
|
||||
if (( $l4read <= $min )) && (( $l4write <= $min )); then
|
||||
doL4Restart=1
|
||||
fi
|
||||
fi
|
||||
|
||||
#echo "restart[${doL4Restart}] $i l4read[$l4read] l4write[$l4write] $runChk"
|
||||
|
||||
if (( $doL4Restart == 1 )); then
|
||||
echo "Resetting $i at `date`"
|
||||
./lf_firemod.pl --mgr $mgr --cmd "set_cx_state all CX_$i STOPPED" > /dev/null
|
||||
sleep 3s
|
||||
./lf_firemod.pl --mgr $mgr --cmd "set_cx_state all CX_$i RUNNING" > /dev/null
|
||||
fi
|
||||
done
|
||||
|
||||
echo -n "."
|
||||
sleep $napTime
|
||||
done
|
||||
22
lf_log_parse.pl
Executable file
22
lf_log_parse.pl
Executable file
@@ -0,0 +1,22 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
# Convert the timestamp in LANforge logs (it is in unix-time, miliseconds)
|
||||
# to readable date.
|
||||
|
||||
use strict;
|
||||
use POSIX qw(strftime);
|
||||
|
||||
while (<>) {
|
||||
my $ln = $_;
|
||||
chomp($ln);
|
||||
if ($ln =~ /^(\d+):(.*)/) {
|
||||
my $ts = $1;
|
||||
my $rst = $2;
|
||||
my $dt = strftime("%Y-%m-%d %H:%M:%S", localtime($ts / 1000));
|
||||
my $msec = $ts % 1000;
|
||||
print "$dt $msec:$rst\n";
|
||||
}
|
||||
else {
|
||||
print "$ln\n";
|
||||
}
|
||||
}
|
||||
70
lf_loop_traffic.sh
Executable file
70
lf_loop_traffic.sh
Executable file
@@ -0,0 +1,70 @@
|
||||
#!/bin/bash
|
||||
|
||||
if [ -z "$1" -o -z "$2" -o -z "$3" ]; then
|
||||
echo "Usage: $0 <Layer-3 Name> <Run seconds> <Sleep seconds>"
|
||||
echo " Layer-3 Name: preface with cx: for cross connect"
|
||||
echo " preface with group: for test group"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
MANAGER=${MANAGER:-localhost}
|
||||
RESOURCE=${RESOURCE:-1}
|
||||
|
||||
TRAFFIC_NAME="$1"
|
||||
USING=wrong
|
||||
if [[ $1 = cx:* ]]; then
|
||||
USING=cx
|
||||
TRAFFIC_NAME=${TRAFFIC_NAME#cx:}
|
||||
elif [[ $1 = group:* ]]; then
|
||||
USING=tg
|
||||
TRAFFIC_NAME=${TRAFFIC_NAME#group:}
|
||||
fi
|
||||
|
||||
if [[ $USING = wrong ]]; then
|
||||
echo "Please specify group using 'group:$TRAFFIC_NAME' or single connection using 'cx:$TRAFFIC_NAME'"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
case $USING in
|
||||
cx)
|
||||
START="op_cx run"
|
||||
STOP="op_cx stop"
|
||||
;;
|
||||
tg)
|
||||
START="op_group run"
|
||||
STOP="op_group stop"
|
||||
;;
|
||||
esac
|
||||
|
||||
RUN_SEC="$2"
|
||||
SLEEP_SEC="$3"
|
||||
ACTION="STOPPED"
|
||||
|
||||
function op_cx() {
|
||||
ACTION="STOPPED"
|
||||
if [[ $1 = run ]]; then
|
||||
ACTION="RUNNING"
|
||||
elif [[ $1 = quiesce ]]; then
|
||||
ACTION="QUIESCE"
|
||||
fi
|
||||
./lf_firemod.pl --mgr $MANAGER --resource $RESOURCE --quiet yes --action do_cmd --cmd "set_cx_state default_tm $TRAFFIC_NAME $ACTION"
|
||||
}
|
||||
|
||||
function op_group() {
|
||||
ACTION="stop_group"
|
||||
if [[ $1 = run ]]; then
|
||||
ACTION="start_group"
|
||||
elif [[ $1 = quiesce ]]; then
|
||||
ACTION="quiesce_group"
|
||||
fi
|
||||
./lf_firemod.pl --mgr $MANAGER --resource $RESOURCE --quiet yes --action do_cmd --cmd "$ACTION $TRAFFIC_NAME"
|
||||
}
|
||||
|
||||
|
||||
cd /home/lanforge/scripts
|
||||
while :; do
|
||||
$START
|
||||
sleep $RUN_SEC
|
||||
$STOP
|
||||
sleep $SLEEP_SEC
|
||||
done
|
||||
1509
lf_macvlan.pl
Executable file
1509
lf_macvlan.pl
Executable file
File diff suppressed because it is too large
Load Diff
654
lf_macvlan2.pl
Executable file
654
lf_macvlan2.pl
Executable file
@@ -0,0 +1,654 @@
|
||||
#!/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.
|
||||
|
||||
# This script sets up connections of types:
|
||||
# lf, lf_udp, lf_tcp, custom_ether, custom_udp, and custom_tcp
|
||||
# across 1 real port and manny macvlan ports on 2 machines.
|
||||
# It then continously starts and stops the connections.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
#my $lfmgr_host = "localhost";
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
# This sets up connections between 2 LANforge machines
|
||||
my $lf1 = 15;
|
||||
|
||||
my $lf2 = 15; # We also have a second machine to create mac-vlans on.
|
||||
#my $lf2 = ""; # Set to "" if we have no second machine, can only do l4
|
||||
# endpoints in this case.
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
my @lf1_ports = (1); #, 2, 3);
|
||||
my @lf2_ports = (2); #, 2, 3);
|
||||
|
||||
my $ip_base = "172.2";
|
||||
my $ip_lsb = 2;
|
||||
my $ip_c = 2;
|
||||
my $msk = "255.255.0.0";
|
||||
|
||||
my $num_macvlans = 500;
|
||||
|
||||
# If zero, will have one of EACH of the cx types on each port.
|
||||
#my $one_cx_per_port = 1;
|
||||
my $one_cx_per_port = 1;
|
||||
|
||||
#my @cx_types = ("lf", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4");
|
||||
#my @min_pkt_szs = (64, 1, 1, 1, 1, 0);
|
||||
#my @max_pkt_szs = (1514, 12000, 13000, 2048, 2048, 0);
|
||||
|
||||
my @cx_types = ("lf_tcp", "lf_tcp", "lf_tcp", "lf_tcp", "lf_tcp",
|
||||
"lf_tcp", "lf_tcp", "lf_tcp", "lf_tcp", "lf_tcp",
|
||||
"lf_udp", "lf_tcp", "lf_udp", "lf_udp", "lf_tcp",
|
||||
"lf_tcp", "lf_tcp");
|
||||
my @min_pkt_szs = (10000, 10000, 10000, 10000, 6000, 6000,
|
||||
10000, 10000, 10000, 10000, 6000, 6000,
|
||||
1472, 1472, 1472, 1472, 8000,
|
||||
400, 800);
|
||||
my @max_pkt_szs = (16000, 16000, 16000, 16000, 6600, 6600,
|
||||
15555, 16000, 16000, 16000, 6000, 6600,
|
||||
1472, 1472, 1472, 1472, 27000,
|
||||
4000, 8071);
|
||||
|
||||
# Layer-4 only
|
||||
#my @cx_types = ("l4", "l4");
|
||||
#my @min_pkt_szs = (0, 0);
|
||||
#my @max_pkt_szs = (0, 0);
|
||||
|
||||
# URL will be acted on from machine $lf1
|
||||
my $l4_url = "http://172.1.5.75";
|
||||
|
||||
my $min_rate = 64000;
|
||||
#my $max_rate = 512000;
|
||||
my $max_rate = 64000;
|
||||
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 100;
|
||||
my $run_for_time = 120; # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Run for XX seconds..then will be stopped again
|
||||
my $report_timer = 8000; # 8 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# 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";
|
||||
|
||||
initToDefaults();
|
||||
#exit(0);
|
||||
|
||||
# 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
|
||||
|
||||
addMacVlans();
|
||||
|
||||
# Add some IP addresses to the ports
|
||||
initIpAddresses();
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
my $rl = 0;
|
||||
for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
|
||||
}# For some amount of start_stop iterations...
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub addMacVlans {
|
||||
my $i;
|
||||
my $q;
|
||||
|
||||
my $v;
|
||||
my $lsb = 10;
|
||||
my $lsb2 = 10;
|
||||
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<@lf1_ports; $q++) {
|
||||
my $pnum1 = $lf1_ports[$q];
|
||||
my $pnum2 = $lf2_ports[$q];
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
|
||||
$lsb++;
|
||||
if ($lsb > 99) {
|
||||
$lsb2++;
|
||||
$lsb = 2;
|
||||
}
|
||||
|
||||
my $s2 = $shelf+10;
|
||||
my $c2 = $lf1+10;
|
||||
my $p2 = $pnum1+10;
|
||||
my $mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf1 $pnum1 $mc");
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$c2 = $lf2+10;
|
||||
$p2 = $pnum2+10;
|
||||
$mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf2 $pnum2 $mc");
|
||||
|
||||
# Throttle ourself so we don't over-run the poor LANforge system.
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $pnum1);
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $pnum2);
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
doCmd("probe_ports");
|
||||
|
||||
# Wait untill we discover all the ports...
|
||||
|
||||
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};
|
||||
}
|
||||
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
while (1) {
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$i");
|
||||
if ($lf2 ne "") {
|
||||
$utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i");
|
||||
}
|
||||
if ($p1->isPhantom() || (($lf2 ne "") && $p2->isPhantom())) {
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}#addMacVlans
|
||||
|
||||
|
||||
# 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++) {
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
my $tmp = $lf1_ports[$i];
|
||||
my $tmp2 = $lf2_ports[$i];
|
||||
my $cmd = "set_port $shelf $lf1 $tmp $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$cmd = "set_port $shelf $lf2 $tmp2 $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
}
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $tmp);
|
||||
my $pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf1 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $tmp2);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf2 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}# If we have an LF-2 defined.
|
||||
}
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
my $ep = 0;
|
||||
my $cx = 0;
|
||||
my $i = 0;
|
||||
|
||||
|
||||
my @all_ports1 = @lf1_ports;
|
||||
my $j;
|
||||
my $pname;
|
||||
for ($j = 0; $j<@lf1_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports1 = (@all_ports1, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
|
||||
my @all_ports2 = @lf2_ports;
|
||||
if ($lf2 ne "") {
|
||||
for ($j = 0; $j<@lf2_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $lf2_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports2 = (@all_ports2, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "About to start endpoints, all_ports1:\n" . join(" ", @all_ports1) .
|
||||
"\nall_ports2: " . join(" ", @all_ports2) . "\n\n";
|
||||
|
||||
if ($one_cx_per_port) {
|
||||
my $j = 0;
|
||||
my $cxcnt = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
my $i = $cxcnt % @cx_types;
|
||||
$cxcnt++;
|
||||
|
||||
my $cxt = $cx_types[$i];
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_endp-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = sprintf "cx-%04d", $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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
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 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = sprintf "cx-%04d", $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
|
||||
}#one_cx_per_port
|
||||
else {
|
||||
my $j = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
for ($i = 0; $i<@cx_types; $i++) {
|
||||
my $cxt = $cx_types[$i];
|
||||
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_endp-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = sprintf "cx-%04d", $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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
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 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = sprintf "cx-%04d", $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 cx types
|
||||
}#for each port
|
||||
}# each cx per port
|
||||
|
||||
}#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);
|
||||
}
|
||||
630
lf_macvlan3.pl
Executable file
630
lf_macvlan3.pl
Executable file
@@ -0,0 +1,630 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
# This program is used to test the max TCP connections allowed through a firewall,
|
||||
# and may be used as an example for others who wish to automate LANforge tests.
|
||||
|
||||
# This script sets up 1 UDP connection and as many TCP connections as specified
|
||||
# by $num_macvlans. Each connection is started and verified that it is passing
|
||||
# traffic before starting the next connection. As each TCP connection is started
|
||||
# the UDP connection is checked for any dropped packets. As soon as dropped packets
|
||||
# are detected on the UDP connection, the number of TCP connections is recorded
|
||||
# and the entire test is repeated for $loop_max times. An average number of TCP
|
||||
# connections is calculated and reported at the conclusion of all the test runs.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use LANforge::Endpoint;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
my $script_speed = 25; # Increase to issue commands faster.
|
||||
|
||||
# The LANforge resources
|
||||
my $lf1 = 1; # Minor Resource EID.
|
||||
my $lf2 = ""; # Set to "" if we have no second machine. Or set to second Resource
|
||||
# minor EID to create mac-vlans on it.
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# i.e. the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
# EIDs or aliases can be used.
|
||||
# Port pairs must match on each shelf - will enhance to allow any pair on each shelf.
|
||||
#my @lf1_ports = (1); #, 2, 3);
|
||||
#my @lf2_ports = (2); #, 2, 3);
|
||||
my @lf1_ports = ("eth0"); #, "eth2");
|
||||
my @lf2_ports = ("eth1"); #, "eth3");
|
||||
|
||||
my $mac1 = 0x00; # Starting MAC address 00:m5:m4:m3:m2:m1 where:
|
||||
my $mac2 = 0x00; # m5 is shelf EID, m4 is card EID, m3 is $mac3,
|
||||
my $mac3 = 0x00; # m2 is $mac2 and m1 is $mac1.
|
||||
|
||||
my $ip_base1 = "192.168"; #
|
||||
my $ip_c1 = 2; #
|
||||
my $ip_lsb1 = 2; #
|
||||
my $msk1 = "255.255.255.0"; #
|
||||
my $ip_gw1 = "192.168.2.1"; #
|
||||
|
||||
my $ip_base2 = "172.1"; #
|
||||
my $ip_c2 = 1; #
|
||||
my $ip_lsb2 = 2; #
|
||||
my $msk2 = "255.255.255.0"; #
|
||||
my $ip_gw2 = "172.1.1.1"; #
|
||||
|
||||
|
||||
my $num_macvlans = 200; # Number of mac vlans per port, or the number of connections
|
||||
my $pause_min = 3; # Depends on $num_macvlans and how well your LANforge system runs
|
||||
|
||||
my $one_cx_per_port = 1;# If zero, will have one of EACH of the cx types on each port.
|
||||
|
||||
#my @cx_types = ("lf", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4");
|
||||
#my @min_pkt_szs = (64, 1, 1, 1, 1, 0);
|
||||
#my @max_pkt_szs = (1514, 12000, 13000, 2048, 2048, 0);
|
||||
|
||||
my @cx_types = ("lf_tcp");
|
||||
my @min_pkt_szs = (1472);
|
||||
my @max_pkt_szs = (1472);
|
||||
|
||||
my $min_rate = 9600;
|
||||
my $max_rate = 9600;
|
||||
|
||||
my $test_mgr = "mac_tm";
|
||||
|
||||
my $mac_init = 0; # Set to 1 to initialize IPs when running looped test.
|
||||
my $ip_init = 0; # Set to 1 to initialize IPs when running looped test.
|
||||
my $loop_max = 3; # Number of times the test will be run before calculating average TCP connections
|
||||
my $report_timer = 1000; # 1 second, must be set higher when using > 500 mac vlans
|
||||
my $cxcnt = 0;
|
||||
my $avg_cxcnt = 0;
|
||||
|
||||
|
||||
########################################################################
|
||||
# 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(Timeout => 15,
|
||||
Prompt => '/default\@btbits\>\>/');
|
||||
|
||||
my $timeout = 60;
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => $timeout);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
$t->max_buffer_length(1024 * 1024 * 10); # 10M buffer
|
||||
|
||||
# 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 ??
|
||||
|
||||
if ($lf2 == "") { $lf2 = $lf1; }
|
||||
my $start_mvlan = 0;
|
||||
my $num_mvlans = $num_macvlans;
|
||||
|
||||
|
||||
my $i_c1 = $ip_c1;
|
||||
my $i_lsb1 = $ip_lsb1;
|
||||
my $i_c2 = $ip_c2;
|
||||
my $i_lsb2 = $ip_lsb2;
|
||||
|
||||
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 = ();
|
||||
$cxcnt = 0;
|
||||
|
||||
initToDefaults();
|
||||
#exit(0);
|
||||
|
||||
# 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
|
||||
|
||||
addMacVlans();
|
||||
|
||||
# Add some IP addresses to the ports
|
||||
initIpAddresses();
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
print "Done adding CXs.\n";
|
||||
print "Pause $pause_min minutes for ports to update.\n";
|
||||
for (my $n=1; $n<=$pause_min; $n++) {
|
||||
print "$n of $pause_min\n";
|
||||
sleep(60);
|
||||
}
|
||||
|
||||
# Start Cross-Connects
|
||||
my $p = 0;
|
||||
for (my $q=0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
$p = $q+$q;
|
||||
|
||||
# check that the CX is passing packets
|
||||
my $endp = new LANforge::Endpoint();
|
||||
$utils->updateEndpoint($endp, $endpoint_names[$p]);
|
||||
my $en = $endp->rx_pkts();
|
||||
|
||||
my $slp=0;
|
||||
while ($en == 0) {
|
||||
# sleep to allow CX to connect
|
||||
sleep(1);
|
||||
$slp++;
|
||||
$utils->updateEndpoint($endp, $endpoint_names[$p]);
|
||||
$en = $endp->rx_pkts();
|
||||
if ($slp > 14) {
|
||||
# too long
|
||||
print "WARNING: Waited too long on endp $q\n";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
# check UDP CX for dropped packets
|
||||
my $endp1 = new LANforge::Endpoint();
|
||||
$utils->updateEndpoint($endp1, $endpoint_names[0]);
|
||||
my $en1 = $endp1->rx_dropped_pkts();
|
||||
|
||||
my $endp2 = new LANforge::Endpoint();
|
||||
$utils->updateEndpoint($endp2, $endpoint_names[1]);
|
||||
my $en2 = $endp2->rx_dropped_pkts();
|
||||
|
||||
if ($en1 != 0 || $en2 != 0) { # If there are ANY dropped packets on UDP CX
|
||||
$avg_cxcnt = $avg_cxcnt + $cxcnt; # Average calculated later
|
||||
last;
|
||||
}
|
||||
elsif ($q > 0) {
|
||||
# Successfully added TCP CX, count it
|
||||
$cxcnt++;
|
||||
}
|
||||
} #for $q
|
||||
} #for $loop_max
|
||||
|
||||
if ($avg_cxcnt == 0) {
|
||||
print "$cxcnt TCP connections were made.\n";
|
||||
print "No dropped packets were detected on the UDP connection.\n";
|
||||
print "Try increasing the number of connections.\n";
|
||||
}
|
||||
else {
|
||||
$avg_cxcnt = int($avg_cxcnt / $loop_max);
|
||||
print "$loop_max test loops completed.\n";
|
||||
print "Average number of simultaneous TCP connections: $avg_cxcnt\n";
|
||||
}
|
||||
|
||||
$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
|
||||
|
||||
my $lsb1 = sprintf("%d", $mac1);
|
||||
my $lsb2 = sprintf("%d", $mac2);
|
||||
my $lsb3 = sprintf("%d", $mac3);
|
||||
|
||||
# Return a unique MAC address using last 3 octets
|
||||
sub getNextMac {
|
||||
$lsb1++;
|
||||
if ($lsb1 > 255) {
|
||||
$lsb2++;
|
||||
$lsb1 = 0;
|
||||
if ($lsb2 > 255) {
|
||||
$lsb3++;
|
||||
$lsb2 = 0;
|
||||
if ($lsb3 > 255) {
|
||||
print "*** WARNING, MAC address rolling over XX:YY:ZZ:ff:ff:ff ***\n";
|
||||
$lsb3 = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
$mac1 = sprintf("%02x", $lsb1);
|
||||
$mac2 = sprintf("%02x", $lsb2);
|
||||
$mac3 = sprintf("%02x", $lsb3);
|
||||
return "$mac3:$mac2:$mac1";
|
||||
} # getNextMac
|
||||
|
||||
sub addMacVlans {
|
||||
if ($mac_init == 1 ) {
|
||||
$lsb1 = sprintf("%d", $mac1);
|
||||
$lsb2 = sprintf("%d", $mac2);
|
||||
$lsb3 = sprintf("%d", $mac3);
|
||||
}
|
||||
my $i;
|
||||
my $q;
|
||||
my $v;
|
||||
my $throttle = $script_speed;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<@lf1_ports; $q++) {
|
||||
my $pnum1 = $lf1_ports[$q];
|
||||
my $pnum2 = $lf2_ports[$q];
|
||||
for ($i = $start_mvlan; $i<($num_mvlans + $start_mvlan); $i++) {
|
||||
|
||||
my $shlf = sprintf("%02x", $shelf);
|
||||
my $card = sprintf("%02x", $lf1);
|
||||
my $mac_index = getNextMac();
|
||||
my $mac_addr = "00:$shlf:$card:$mac_index";
|
||||
doCmd("add_mvlan $shelf $lf1 $pnum1 $mac_addr $i");
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$card = sprintf("%02x", $lf2);
|
||||
$mac_index = getNextMac();
|
||||
$mac_addr = "00:$shlf:$card:$mac_index";
|
||||
doCmd("add_mvlan $shelf $lf2 $pnum2 $mac_addr $i");
|
||||
}
|
||||
|
||||
# Throttle ourself so we don't over-run the poor LANforge system.
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $pnum1);
|
||||
if ($lf2 ne "") {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $pnum2);
|
||||
}
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
doCmd("probe_ports");
|
||||
|
||||
# Wait untill we discover all the ports...
|
||||
|
||||
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};
|
||||
}
|
||||
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
while (1) {
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$i");
|
||||
if ($lf2 ne "") {
|
||||
$utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i");
|
||||
}
|
||||
if ($p1->isPhantom() || (($lf2 ne "") && $p2->isPhantom())) {
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}#addMacVlans
|
||||
|
||||
|
||||
# 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 card: $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;
|
||||
for ($i = 0; $i<$mx; $i++) {
|
||||
if ($ports[$i]->isMacVlan()) {
|
||||
doCmd($ports[$i]->getDeleteCmd());
|
||||
} #fi isMacVlan
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub initIpAddresses {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
# init base IP or keep rolling since rolling might stress caching in DUT/NUT.
|
||||
if ($ip_init = 1) {
|
||||
$i_c1 = $ip_c1;
|
||||
$i_lsb1 = $ip_lsb1;
|
||||
$i_c2 = $ip_c2;
|
||||
$i_lsb2 = $ip_lsb2;
|
||||
}
|
||||
for ($i = 0; $i<@lf1_ports; $i++) {
|
||||
my $tmp = $lf1_ports[$i];
|
||||
my $tmp2 = $lf2_ports[$i];
|
||||
my $cmd = "";
|
||||
$cmd = "set_port $shelf $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$cmd = "set_port $shelf $lf2 $tmp2 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $tmp);
|
||||
my $pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
my $throttle = $script_speed;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf1 $pname\#$q $ip_base1.$i_c1.$i_lsb1 $msk1 " .
|
||||
"$ip_gw1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$i_lsb1++;
|
||||
|
||||
if ($i_lsb1 > 250) {
|
||||
$i_c1++;
|
||||
$i_lsb1 = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $tmp2);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf2 $pname\#$q $ip_base2.$i_c2.$i_lsb2 $msk2 " .
|
||||
"$ip_gw2 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$i_lsb2++;
|
||||
|
||||
if ($i_lsb2 > 250) {
|
||||
$i_c2++;
|
||||
$i_lsb2 = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}# If we have an LF-2 defined.
|
||||
}
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
my $ep = 0;
|
||||
my $cx = 1;
|
||||
my $i = 0;
|
||||
|
||||
|
||||
my @all_ports1 = @lf1_ports;
|
||||
my $j;
|
||||
my $pname;
|
||||
for ($j = 0; $j<@lf1_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports1 = (@all_ports1, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
|
||||
my @all_ports2 = @lf2_ports;
|
||||
if ($lf2 ne "") {
|
||||
for ($j = 0; $j<@lf2_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $lf2_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports2 = (@all_ports2, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "About to start endpoints, all_ports1:\n" . join(" ", @all_ports1) .
|
||||
"\nall_ports2: " . join(" ", @all_ports2) . "\n\n";
|
||||
|
||||
if ($one_cx_per_port) {
|
||||
my $j = 1;
|
||||
my $cxs = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
my $i = $cxs % @cx_types;
|
||||
$cxs++;
|
||||
if ($j == 1) {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
# Create UDP endpoints
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "endp-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the UDP endpoints
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " lf_udp " .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must have lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " lf_udp " .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = sprintf "cx-%04d", $cx;
|
||||
$cmd = "add_cx $cx_name $test_mgr $ep2 $ep1";
|
||||
doCmd($cmd);
|
||||
doCmd("set_cx_report_timer $test_mgr $cx_name $report_timer");
|
||||
|
||||
$cx++;
|
||||
|
||||
@cx_names = (@cx_names, $cx_name);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
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 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = sprintf "cx-%04d", $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
|
||||
}#one_cx_per_port
|
||||
}#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);
|
||||
}
|
||||
813
lf_macvlan_l4.pl
Executable file
813
lf_macvlan_l4.pl
Executable file
@@ -0,0 +1,813 @@
|
||||
#!/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.
|
||||
|
||||
# This script sets up connections of types:
|
||||
# lf, lf_udp, lf_tcp, custom_ether, custom_udp, and custom_tcp
|
||||
# across 1 real port and manny macvlan ports on 2 machines.
|
||||
# It then continously starts and stops the connections.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
# Set up connections between 2 LANforge machines
|
||||
# ==============================================
|
||||
my $INIT = 1; # If true, removes all previous tests!!!
|
||||
|
||||
my $lf1 = 1;
|
||||
#my $lf2 = 4; # We also have a second machine to create mac-vlans on.
|
||||
my $lf2 = ""; # Set to "" if we have no second machine, can only do l4
|
||||
# endpoints in this case.
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
my @lf1_ports = (0); #, 2, 3);
|
||||
my @lf2_ports = (0); #, 2, 3);
|
||||
|
||||
my $ip_base = "172.29";
|
||||
my $ip_lsb = 110;
|
||||
my $ip_c = 3;
|
||||
my $msk = "255.255.0.0";
|
||||
|
||||
my $use_mac_vlans = 1; # set to 1 for MAC-VLANS. Will use 8021q otherwise.
|
||||
my $num_vlans = 100;
|
||||
my $starting_vid = 1000;
|
||||
|
||||
# If zero, will have one of EACH of the cx types on each port.
|
||||
#my $one_cx_per_port = 1;
|
||||
my $one_cx_per_port = 0;
|
||||
|
||||
#my @cx_types = ("lf", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4");
|
||||
#my @min_pkt_szs = (64, 1, 1, 1, 1, 0);
|
||||
#my @max_pkt_szs = (1514, 12000, 13000, 2048, 2048, 0);
|
||||
|
||||
#my @cx_types = ("lf_tcp");
|
||||
#my @min_pkt_szs = (1);
|
||||
#my @max_pkt_szs = (13000);
|
||||
|
||||
# Layer-4 only
|
||||
#my @cx_types = ("l4", "l4", "l4"); #, "l4", "l4");
|
||||
#my @min_pkt_szs = (0, 0, 0); #, 0, 0);
|
||||
#my @max_pkt_szs = (0, 0, 0); #, 0, 0);
|
||||
my @cx_types = ("l4"); #, "l4", "l4");
|
||||
my @min_pkt_szs = (0); #, 0, 0);
|
||||
my @max_pkt_szs = (0); #, 0, 0);
|
||||
|
||||
# URL will be acted on from machine $lf1
|
||||
#my $l4_url = "http://192.168.3.148/index.html";
|
||||
my $l4_url = "http://www.candelatech.com/oss/pktgen.c";
|
||||
my $save_to_dev_null = 1; # Set to zero if you want to save http files to /tmp/$ep1
|
||||
|
||||
my $min_rate = 64000;
|
||||
#my $max_rate = 512000;
|
||||
my $max_rate = 64000;
|
||||
my $url_per_10m = 600; # 600 is 1 request per second
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $loop_max = 100000;
|
||||
my $start_stop_iterations = 1;
|
||||
my $run_for_time = 2000; # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Run for XX seconds..then will be stopped again
|
||||
my $report_timer = 8000; # 8 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
my @num = (); #make sorting by name easier :P
|
||||
my $total_mvlans = (($num_macvlans+1)*2);
|
||||
my $num_len = length ($total_mvlans);
|
||||
use Switch;
|
||||
my $i = 0;
|
||||
|
||||
switch ($num_len) {
|
||||
case 1 {
|
||||
for ($i=0;$i<$total_mvlans;$i++) {
|
||||
$num[$i] = sprintf("%01d", $i);
|
||||
}
|
||||
}
|
||||
case 2 {
|
||||
for ($i=0;$i<$total_mvlans;$i++) {
|
||||
$num[$i] = sprintf("%02d", $i);
|
||||
}
|
||||
}
|
||||
case 3 {
|
||||
for ($i=0;$i<$total_mvlans;$i++) {
|
||||
$num[$i] = sprintf("%03d", $i);
|
||||
}
|
||||
}
|
||||
case 4 {
|
||||
for ($i=0;$i<$total_mvlans;$i++) {
|
||||
$num[$i] = sprintf("%04d", $i);
|
||||
}
|
||||
}
|
||||
else { print '***** Error Invalid Number of MAC VLANS i.e. >10,000 !!!!'; }
|
||||
}
|
||||
#my $junk=0;
|
||||
# for ($junk=0;$junk<$total_mvlans;$junk++) {
|
||||
# printf "$num[$junk],";
|
||||
# }
|
||||
#printf "\n";
|
||||
|
||||
#exit(0);
|
||||
|
||||
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(Timeout => 45,
|
||||
Prompt => '/default\@btbits\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 45);
|
||||
|
||||
$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++) {
|
||||
@endpoint_names = ();
|
||||
@cx_names = ();
|
||||
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "\n\n***** Starting loop: $loop at: $dt *****\n\n";
|
||||
|
||||
if ($INIT) {
|
||||
initToDefaults();
|
||||
}
|
||||
#exit(0);
|
||||
|
||||
# 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
|
||||
|
||||
if ($use_mac_vlans) {
|
||||
addMacVlans();
|
||||
}
|
||||
else {
|
||||
add8021qVlans();
|
||||
}
|
||||
|
||||
# Add some IP addresses to the ports
|
||||
initIpAddresses();
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
my $rl = 0;
|
||||
#for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
for ($rl = 0; $rl<$loop; $rl++) {
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Drop the ports.. (Testing kernel bug fix. )
|
||||
if ($loop % 2 == 0) {
|
||||
clearVlanPorts($shelf, $lf1);
|
||||
}
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
|
||||
}# For some amount of start_stop iterations...
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub addMacVlans {
|
||||
my $i;
|
||||
my $q;
|
||||
|
||||
my $v;
|
||||
my $lsb = 10;
|
||||
my $lsb2 = 10;
|
||||
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<@lf1_ports; $q++) {
|
||||
my $pnum1 = $lf1_ports[$q];
|
||||
my $pnum2 = $lf2_ports[$q];
|
||||
for ($i = 0; $i<$num_vlans; $i++) {
|
||||
|
||||
$lsb++;
|
||||
if ($lsb > 99) {
|
||||
$lsb2++;
|
||||
$lsb = 2;
|
||||
}
|
||||
|
||||
my $s2 = $shelf+10;
|
||||
my $c2 = $lf1+10;
|
||||
my $p2 = $pnum1+10;
|
||||
my $mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf1 $pnum1 $mc");
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$c2 = $lf2+10;
|
||||
$p2 = $pnum2+10;
|
||||
$mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf2 $pnum2 $mc");
|
||||
|
||||
# Throttle ourself so we don't over-run the poor LANforge system.
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $pnum1);
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $pnum2);
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
doCmd("probe_ports");
|
||||
|
||||
# Wait untill we discover all the ports...
|
||||
|
||||
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};
|
||||
}
|
||||
|
||||
for ($i = 0; $i<$num_vlans; $i++) {
|
||||
while (1) {
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$i");
|
||||
if ($lf2 ne "") {
|
||||
$utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i");
|
||||
}
|
||||
if ($p1->isPhantom() || (($lf2 ne "") && $p2->isPhantom())) {
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}#addMacVlans
|
||||
|
||||
|
||||
sub add8021qVlans {
|
||||
my $i;
|
||||
my $q;
|
||||
|
||||
my $v;
|
||||
my $lsb = 10;
|
||||
my $lsb2 = 10;
|
||||
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<@lf1_ports; $q++) {
|
||||
my $pnum1 = $lf1_ports[$q];
|
||||
my $pnum2 = $lf2_ports[$q];
|
||||
for ($i = 0; $i<$num_vlans; $i++) {
|
||||
|
||||
$lsb++;
|
||||
if ($lsb > 99) {
|
||||
$lsb2++;
|
||||
$lsb = 2;
|
||||
}
|
||||
my $vid = $starting_vid + $i;
|
||||
doCmd("add_vlan $shelf $lf1 $pnum1 $vid");
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$vid = $starting_vid + $num_vlans + $i;
|
||||
doCmd("add_vlan $shelf $lf2 $pnum2 $vid");
|
||||
|
||||
# Throttle ourself so we don't over-run the poor LANforge system.
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $pnum1);
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $pnum2);
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
doCmd("probe_ports");
|
||||
|
||||
# Wait untill we discover all the ports...
|
||||
|
||||
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};
|
||||
}
|
||||
|
||||
for ($i = 0; $i<$num_vlans; $i++) {
|
||||
while (1) {
|
||||
my $vid = $starting_vid + $i;
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\.$vid");
|
||||
if ($lf2 ne "") {
|
||||
$vid = $starting_vid + $num_vlans + $i;
|
||||
$utils->updatePort($p2, $shelf, $lf2, "$pname2\.$vid");
|
||||
}
|
||||
if ($p1->isPhantom() || (($lf2 ne "") && $p2->isPhantom())) {
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}#add8021qVlans
|
||||
|
||||
|
||||
# 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 {
|
||||
clearVlanPorts($shelf, $lf1);
|
||||
if ($lf2 ne "") {
|
||||
clearVlanPorts($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 clearVlanPorts {
|
||||
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 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++) {
|
||||
my $tst = $ports[$i]->is8021qVlan();
|
||||
if ($use_mac_vlans) {
|
||||
$tst = $ports[$i]->isMacVlan();
|
||||
}
|
||||
if ($tst) {
|
||||
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++) {
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
my $tmp = $lf1_ports[$i];
|
||||
my $tmp2 = $lf2_ports[$i];
|
||||
my $cmd = "set_port $shelf $lf1 $tmp $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"172.29.0.5 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$cmd = "set_port $shelf $lf2 $tmp2 $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"172.29.0.5 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
}
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $tmp);
|
||||
my $pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
my $vid = $starting_vid + $q;
|
||||
my $pnm = "$pname\.$vid";
|
||||
if ($use_mac_vlans) {
|
||||
$pnm = "$pname\#$q";
|
||||
}
|
||||
$cmd = "set_port $shelf $lf1 $pnm $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"172.29.0.5 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pnm");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $tmp2);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
my $vid = $starting_vid + $num_vlans + $q;
|
||||
my $pnm = "$pname\.$vid";
|
||||
if ($use_mac_vlans) {
|
||||
$pnm = "$pname\#$q";
|
||||
}
|
||||
$cmd = "set_port $shelf $lf2 $pnm $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"172.29.0.5 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, "$pnm");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}# If we have an LF-2 defined.
|
||||
}
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
my $ep = 0;
|
||||
my $cx = 0;
|
||||
my $i = 0;
|
||||
|
||||
|
||||
my @all_ports1 = @lf1_ports;
|
||||
my $j;
|
||||
my $pname;
|
||||
for ($j = 0; $j<@lf1_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
if ($use_mac_vlans) {
|
||||
@all_ports1 = (@all_ports1, "$pname\#$q");
|
||||
}
|
||||
else {
|
||||
my $vid = $starting_vid + $q;
|
||||
@all_ports1 = (@all_ports1, "$pname\.$vid");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my @all_ports2 = @lf2_ports;
|
||||
if ($lf2 ne "") {
|
||||
for ($j = 0; $j<@lf2_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $lf2_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
if ($use_mac_vlans) {
|
||||
@all_ports2 = (@all_ports2, "$pname\#$q");
|
||||
}
|
||||
else {
|
||||
my $vid = $starting_vid + $num_vlans + $q;
|
||||
@all_ports2 = (@all_ports2, "$pname\.$vid");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "About to start endpoints, all_ports1:\n" . join(" ", @all_ports1) .
|
||||
"\nall_ports2: " . join(" ", @all_ports2) . "\n\n";
|
||||
|
||||
if ($one_cx_per_port) {
|
||||
my $j = 0;
|
||||
my $cxcnt = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
my $i = $cxcnt % @cx_types;
|
||||
$cxcnt++;
|
||||
|
||||
my $cxt = $cx_types[$i];
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "l4-${num[$ep]}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_l4-${num[$ep]}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
my $save_file = "/tmp/$ep1";
|
||||
if ($save_to_dev_null) {
|
||||
$save_file = "/dev/null";
|
||||
}
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 $url_per_10m '" .
|
||||
"dl $l4_url $save_file' ' '";
|
||||
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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "endp-${num[$ep]}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "endp-${num[$ep]}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
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
|
||||
}#one_cx_per_port
|
||||
else {
|
||||
my $j = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
for ($i = 0; $i<@cx_types; $i++) {
|
||||
my $cxt = $cx_types[$i];
|
||||
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "l4-${num[$ep]}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_l4-${num[$ep]}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
my $save_file = "/tmp/$ep1";
|
||||
if ($save_to_dev_null) {
|
||||
$save_file = "/dev/null";
|
||||
}
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 $url_per_10m '" .
|
||||
"dl $l4_url $save_file' ' '";
|
||||
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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "endp-${num[$ep]}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "endp-${num[$ep]}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
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 cx types
|
||||
}#for each port
|
||||
}# each cx per port
|
||||
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
|
||||
print ">>> $cmd\n";
|
||||
|
||||
$t->print($cmd);
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
#sleep(1);
|
||||
}
|
||||
723
lf_macvlan_streams.pl
Executable file
723
lf_macvlan_streams.pl
Executable file
@@ -0,0 +1,723 @@
|
||||
#!/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.
|
||||
|
||||
# This script sets up connections of types:
|
||||
# lf, lf_udp, lf_tcp, custom_ether, custom_udp, and custom_tcp
|
||||
# across 1 real port and manny macvlan ports on 2 machines.
|
||||
# It then continously starts and stops the connections.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use LANforge::Endpoint;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
# This sets up connections between 2 LANforge machines
|
||||
my $lf1 = 1;
|
||||
|
||||
my $lf2 = 2; # We also have a second machine to create mac-vlans on.
|
||||
#my $lf2 = ""; # Set to "" if we have no second machine, can only do l4
|
||||
# # endpoints in this case.
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
my @lf1_ports = (5); #, 2, 3);
|
||||
my @lf2_ports = (5); #, 2, 3);
|
||||
|
||||
# These are for the IP port, the initial value....
|
||||
my $port_nums = 5000;
|
||||
|
||||
my $ip_base = "172.1";
|
||||
my $ip_lsb = 2;
|
||||
my $ip_c = 2;
|
||||
my $msk = "255.255.0.0";
|
||||
|
||||
my $num_macvlans = 50;
|
||||
|
||||
# If zero, will have one of EACH of the cx types on each port.
|
||||
#my $one_cx_per_port = 1;
|
||||
my $one_cx_per_port = 0;
|
||||
|
||||
my $mn_sz = 1000;
|
||||
my $mx_sz = 1000;
|
||||
|
||||
# 10 of each, on each port/macvlan With 100 mac-vlans, yields 1000 sessions.
|
||||
my @cx_types = ("lf_udp", "lf_tcp", "lf_udp", "lf_tcp", "lf_udp",
|
||||
"lf_tcp", "lf_udp", "lf_tcp", "lf_udp", "lf_tcp" );
|
||||
my @min_pkt_szs = ($mn_sz, $mn_sz, $mn_sz, $mn_sz, $mn_sz,
|
||||
$mn_sz, $mn_sz, $mn_sz, $mn_sz, $mn_sz);
|
||||
my @max_pkt_szs = ($mx_sz, $mx_sz, $mx_sz, $mx_sz, $mx_sz,
|
||||
$mx_sz, $mx_sz, $mx_sz, $mx_sz, $mx_sz);
|
||||
|
||||
# Layer-4 only
|
||||
#my @cx_types = ("l4", "l4");
|
||||
#my @min_pkt_szs = (0, 0);
|
||||
#my @max_pkt_szs = (0, 0);
|
||||
|
||||
# URL will be acted on from machine $lf1
|
||||
#my $l4_url = "http://172.1.5.75";
|
||||
my $l4_url = "http://172.1.2.3";
|
||||
|
||||
my $min_rate = 24000;
|
||||
my $max_rate = 24000;
|
||||
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 10000;
|
||||
my $run_for_time = 0; # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 1; # Run for XX seconds..then will be stopped again
|
||||
my $report_timer = 5000; # 5 seconds
|
||||
my $stop_at_connections = 100000;
|
||||
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my @endpoint_names = (); #will be added to as they are created
|
||||
my @cx_names = ();
|
||||
|
||||
my $tot_cx_started = 0;
|
||||
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 45);
|
||||
|
||||
$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";
|
||||
|
||||
initToDefaults();
|
||||
#exit(0);
|
||||
|
||||
# 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
|
||||
|
||||
addMacVlans();
|
||||
|
||||
# Add some IP addresses to the ports
|
||||
initIpAddresses();
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
my $begin_time = time();
|
||||
|
||||
my $was_rcv_silent = $utils->cli_rcv_silent();
|
||||
my $was_send_silent = $utils->cli_send_silent();
|
||||
|
||||
$utils->cli_rcv_silent(1);
|
||||
|
||||
my $rl = 0;
|
||||
for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
|
||||
my $stime = time();
|
||||
my $slp = 0;
|
||||
|
||||
$utils->cli_send_silent($was_send_silent);
|
||||
doCmd("set_cx_state $test_mgr all RUNNING", 0, 1);
|
||||
$utils->cli_send_silent(1);
|
||||
|
||||
#sleep(1); # Give the servers a chance to get started...
|
||||
|
||||
if ($run_for_time == 0) {
|
||||
# Stop test as soon as all have received a packet.
|
||||
my $i;
|
||||
my $endp1 = new LANforge::Endpoint();
|
||||
for ($i = 0; $i<@endpoint_names; $i++) {
|
||||
my $en = $endpoint_names[$i];
|
||||
$utils->updateEndpoint($endp1, $en, 1);
|
||||
while ($endp1->rx_pkts() <= 0) {
|
||||
if (time() > $stime + 15) {
|
||||
# Things are not working right, it should never take this long
|
||||
print "WARNING: Endpoint $en is not receiving packets after $slp seconds.\n";
|
||||
exit 0;
|
||||
}
|
||||
$utils->updateEndpoint($endp1, $en, 1);
|
||||
}
|
||||
}
|
||||
|
||||
# Stop cxs.
|
||||
$utils->cli_send_silent($was_send_silent);
|
||||
doCmd("set_cx_state $test_mgr all STOPPED", 0, 1);
|
||||
$utils->cli_send_silent(1);
|
||||
|
||||
my $elapsed = time() - $stime;
|
||||
my $tot_elapsed = time() - $begin_time;
|
||||
|
||||
$i = @cx_names;
|
||||
$tot_cx_started += $i;
|
||||
print "\nStarted and stopped $i connections this round in $elapsed seconds.\n";
|
||||
print "Started and stopped a total of $tot_cx_started in $tot_elapsed seconds.\n ";
|
||||
print $tot_cx_started / $tot_elapsed . " connections per second...\n\n";
|
||||
|
||||
if ($tot_cx_started >= $stop_at_connections) {
|
||||
exit 0;
|
||||
}
|
||||
|
||||
# Now, lets change the port numbers around.
|
||||
for ($i = 0; $i<@endpoint_names; $i++) {
|
||||
my $en = $endpoint_names[$i];
|
||||
|
||||
my $cmd = "add_endp $en NA NA NA NA $port_nums NA NA NA NA NA NA NA NA";
|
||||
$port_nums = nextPortNum($port_nums);
|
||||
doCmd($cmd, 1, 1);
|
||||
}#for
|
||||
|
||||
}
|
||||
else {
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
}
|
||||
|
||||
}# For some amount of start_stop iterations...
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub addMacVlans {
|
||||
my $i;
|
||||
my $q;
|
||||
|
||||
my $v;
|
||||
my $lsb = 10;
|
||||
my $lsb2 = 10;
|
||||
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<@lf1_ports; $q++) {
|
||||
my $pnum1 = $lf1_ports[$q];
|
||||
my $pnum2 = $lf2_ports[$q];
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
|
||||
$lsb++;
|
||||
if ($lsb > 99) {
|
||||
$lsb2++;
|
||||
$lsb = 2;
|
||||
}
|
||||
|
||||
my $s2 = $shelf+10;
|
||||
my $c2 = $lf1+10;
|
||||
my $p2 = $pnum1+10;
|
||||
my $mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf1 $pnum1 $mc");
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$c2 = $lf2+10;
|
||||
$p2 = $pnum2+10;
|
||||
$mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf2 $pnum2 $mc");
|
||||
|
||||
# Throttle ourself so we don't over-run the poor LANforge system.
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $pnum1);
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $pnum2);
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
doCmd("probe_ports");
|
||||
|
||||
# Wait untill we discover all the ports...
|
||||
|
||||
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};
|
||||
}
|
||||
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
while (1) {
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$i");
|
||||
if ($lf2 ne "") {
|
||||
$utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i");
|
||||
}
|
||||
if ($p1->isPhantom() || (($lf2 ne "") && $p2->isPhantom())) {
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}#addMacVlans
|
||||
|
||||
|
||||
# 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++) {
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
my $tmp = $lf1_ports[$i];
|
||||
my $tmp2 = $lf2_ports[$i];
|
||||
my $cmd = "set_port $shelf $lf1 $tmp $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$cmd = "set_port $shelf $lf2 $tmp2 $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
}
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $tmp);
|
||||
my $pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf1 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $tmp2);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf2 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}# If we have an LF-2 defined.
|
||||
}
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
my $ep = 0;
|
||||
my $cx = 0;
|
||||
my $i = 0;
|
||||
|
||||
|
||||
my @all_ports1 = @lf1_ports;
|
||||
my $j;
|
||||
my $pname;
|
||||
for ($j = 0; $j<@lf1_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports1 = (@all_ports1, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
|
||||
my @all_ports2 = @lf2_ports;
|
||||
if ($lf2 ne "") {
|
||||
for ($j = 0; $j<@lf2_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $lf2_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports2 = (@all_ports2, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "About to start endpoints, all_ports1:\n" . join(" ", @all_ports1) .
|
||||
"\nall_ports2: " . join(" ", @all_ports2) . "\n\n";
|
||||
|
||||
if ($one_cx_per_port) {
|
||||
my $j = 0;
|
||||
my $cxcnt = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
my $i = $cxcnt % @cx_types;
|
||||
$cxcnt++;
|
||||
|
||||
my $cxt = $cx_types[$i];
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_endp-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
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 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" $port_nums $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
$port_nums = nextPortNum($port_nums);
|
||||
doCmd($cmd);
|
||||
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must have lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" $port_nums $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
$port_nums = nextPortNum($port_nums);
|
||||
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
|
||||
}#one_cx_per_port
|
||||
else {
|
||||
my $j = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
for ($i = 0; $i<@cx_types; $i++) {
|
||||
my $cxt = $cx_types[$i];
|
||||
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_endp-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
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 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" $port_nums $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
$port_nums = nextPortNum($port_nums);
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" $port_nums $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
$port_nums = nextPortNum($port_nums);
|
||||
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 cx types
|
||||
}#for each port
|
||||
}# each cx per port
|
||||
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
sub nextPortNum {
|
||||
my $cur = shift;
|
||||
if ($cur > 65033) {
|
||||
return int(rand(1000) + 5000);
|
||||
}
|
||||
$cur++;
|
||||
return $cur;
|
||||
}
|
||||
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
my $send_silent = shift;
|
||||
my $rcv_silent = shift;
|
||||
|
||||
if (! $send_silent) {
|
||||
print ">>> $cmd\n";
|
||||
}
|
||||
|
||||
$t->print($cmd);
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
if (! $rcv_silent) {
|
||||
print "**************\n @rslt ................\n\n";
|
||||
}
|
||||
#sleep(1);
|
||||
}
|
||||
469
lf_many_conn.pl
Executable file
469
lf_many_conn.pl
Executable file
@@ -0,0 +1,469 @@
|
||||
#!/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.
|
||||
|
||||
# The purpose of this script is to create as many TCP (or UDP) connections
|
||||
# as possible during a given amount of time. If you tell later scripts not
|
||||
# to initialize things to defaults, then you can run multiple copies of this
|
||||
# script at once by changing the starting CX number. This script not only
|
||||
# starts and stops connections, but also verifys that both ends of the connection
|
||||
# have received data before tearing the connection down. (Errors will be printed
|
||||
# to the console if the connection does not start in 15 seconds.)
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Udated by:
|
||||
#
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $lanf1 = 7;
|
||||
my $lanf2 = 5;
|
||||
|
||||
# Script assumes that we are using one port on each machine for data transmission...specifically
|
||||
# port 1.
|
||||
|
||||
my $test_mgr = "conn-mgr";
|
||||
|
||||
|
||||
# Run for XX seconds before tearing down and bringing up the next set..
|
||||
my $run_for_time = 1000;
|
||||
my $report_timer = 20000; # XX/1000 seconds
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
my $proto = "tcp"; # tcp, udp, or both
|
||||
my $to_do_at_a_time = 3000; # Do XX cross-connects at a time. Don't make this too big...
|
||||
my $quiet = "yes";
|
||||
my $start_cx_num = 0;
|
||||
my $init_to_dflts = "yes";
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the first item lf1_ports talks to the third column in lf2_ports.
|
||||
# Syntax is: port_num ip_addr ip_mask ip_gateway(dlft_router)
|
||||
my $lf1_port = "2 172.16.1.200 255.255.255.0 172.16.1.1";
|
||||
my $lf2_port = "2 172.16.1.220 255.255.255.0 172.16.1.1";
|
||||
|
||||
|
||||
my $min_rate_a = 1000;
|
||||
my $max_rate_a = 1000;
|
||||
my $min_rate_b = 128000;
|
||||
my $max_rate_b = 3000000;
|
||||
my $wsize_min_a = 4000; # Write size
|
||||
my $wsize_max_a = 4000; # Write size
|
||||
my $wsize_min_b = 24000; # Write size
|
||||
my $wsize_max_b = 24000; # Write size
|
||||
my $rcvb_a = 64000;
|
||||
my $rcvb_b = 16000;
|
||||
my $txb_a = 16000;
|
||||
my $txb_b = 64000;
|
||||
|
||||
my $do_bulk_removes = 0;
|
||||
my $start_all_cx_at_once = 1;
|
||||
my $do_cx_too = 1; # Should probably be 1 most of the time...
|
||||
my $do_run_cxs = 1; #Should usually be 1
|
||||
my $fail_msg = "";
|
||||
my $manual_check = 0;
|
||||
|
||||
my $cmd_log_name = "lf_conn_cmds.txt";
|
||||
open(CMD_LOG, ">$cmd_log_name") or die("Can't open $cmd_log_name for writing...\n");
|
||||
print "History of all commands can be found in $cmd_log_name\n";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $usage = "$0 [--lf1_port {\"port_num ip mask gateway\"}]
|
||||
[--lf2_port {\"port_num ip mask gateway\"}]
|
||||
[--protocol {tcp | udp}]
|
||||
[--start_cx_num {num}]
|
||||
[--quiet {yes | no}]
|
||||
[--num_cxs {num}]
|
||||
[--init_to_dflts {yes | no}]
|
||||
|
||||
Example:
|
||||
$0 --lf1_port \"1 172.22.22.2 255.255.255.0 172.22.22.1\" --lf2_port \"1 172.22.22.3 255.255.255.0 172.22.22.1\" --init_to_dflts yes\n";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'protocol|p=s' => \$proto,
|
||||
'start_cx_num|s=i' => \$start_cx_num,
|
||||
'quiet|q=s' => \$quiet,
|
||||
'num_cxs|n=i' => \$to_do_at_a_time,
|
||||
'init_ports|i=s' => \$init_to_dflts,
|
||||
'lf1_port|l=s' => \$lf1_port,
|
||||
'lf2_port|L=s' => \$lf2_port,
|
||||
'init_to_dflts|d=s' => \$init_to_dflts,
|
||||
) || die("$usage");
|
||||
|
||||
|
||||
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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
|
||||
# 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(1); # Repress output from CLI ??
|
||||
|
||||
|
||||
my $dt = "";
|
||||
|
||||
if ($init_to_dflts eq "yes") {
|
||||
initToDefaults();
|
||||
|
||||
# Now, add back the test manager we will be using
|
||||
$utils->doCmd("add_tm $test_mgr");
|
||||
$utils->doCmd("tm_register $test_mgr default"); #Add default user
|
||||
$utils->doCmd("tm_register $test_mgr default_gui"); #Add default GUI user
|
||||
|
||||
setUpPorts();
|
||||
}
|
||||
|
||||
# $utils->doCmd("log_level 63");
|
||||
|
||||
|
||||
# Create the connections we will be manipulating.
|
||||
my $i = 0;
|
||||
my $ep = $start_cx_num * 2;
|
||||
|
||||
my $cmd = "";
|
||||
my $cx = $start_cx_num;
|
||||
|
||||
|
||||
my $burst_a = "NO";
|
||||
if ($min_rate_a != $max_rate_a) {
|
||||
$burst_a = "YES";
|
||||
}
|
||||
my $burst_b = "NO";
|
||||
if ($min_rate_b != $max_rate_b) {
|
||||
$burst_b = "YES";
|
||||
}
|
||||
|
||||
my $szrnd_a = "NO";
|
||||
if ($wsize_min_a != $wsize_max_a) {
|
||||
$szrnd_a = "YES";
|
||||
}
|
||||
|
||||
my $szrnd_b = "NO";
|
||||
if ($wsize_min_b != $wsize_max_b) {
|
||||
$szrnd_b = "YES";
|
||||
}
|
||||
|
||||
|
||||
for ($i = 0; $i<$to_do_at_a_time; $i++) {
|
||||
my $pattern = "INCREASING";
|
||||
my $epnum = $i;
|
||||
my $ep1 = "l3e-${ep}-TX";
|
||||
|
||||
$ep++;
|
||||
my $ep2 = "l3e-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
$cmd = "add_endp $ep1 $shelf_num $lanf1 $pn lf_$proto -1 $burst_a $min_rate_a $max_rate_a $szrnd_a $wsize_min_a $wsize_max_a $pattern NO";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_details $ep1 $rcvb_a $txb_a";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
|
||||
# Don't verify these, for speed reasons (and they should always work unless something
|
||||
# is mis-configured.
|
||||
#my $endp1 = new LANforge::Endpoint();
|
||||
#$utils->updateEndpoint($endp1, $ep1);
|
||||
#verifyEndpointAttributes($endp1, $ep1, $shelf_num, $lf1, $lf1_ports[$j], $cx_types[$i], -1, $burst,
|
||||
# $min_rate, $max_rate, $szrnd, $min_pkt_szs[$i], $max_pkt_szs[$i], $pattern,
|
||||
# "NO"); # last is use_checksum
|
||||
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
$cmd = "add_endp $ep2 $shelf_num $lanf2 $pn lf_$proto -1 $burst_b $min_rate_b $max_rate_b $szrnd_b $wsize_min_b $wsize_max_b $pattern NO";
|
||||
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_details $ep2 $rcvb_b $txb_b";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "cx-${cx}";
|
||||
$cmd = "add_cx $cx_name $test_mgr $ep1 $ep2";
|
||||
$utils->doCmd($cmd);
|
||||
$utils->doCmd("set_cx_report_timer $test_mgr $cx_name $report_timer");
|
||||
|
||||
$cx++;
|
||||
|
||||
@cx_names = (@cx_names, $cx_name);
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
# Now, bring up and down connections
|
||||
|
||||
my $tot_cx_started = 0;
|
||||
my $begin_time = time();
|
||||
|
||||
while (1) {
|
||||
my $stime = time();
|
||||
|
||||
if ($start_all_cx_at_once) {
|
||||
my $nm = $cx_names[$i];
|
||||
$cmd = "set_cx_state $test_mgr ALL RUNNING";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
else {
|
||||
for ($i = 0; $i<@cx_names; $i++) {
|
||||
my $nm = $cx_names[$i];
|
||||
$cmd = "set_cx_state $test_mgr $nm RUNNING";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
# Make sure they all started, and wait untill both sides have received
|
||||
# a packet or two.
|
||||
my $slp = 0;
|
||||
for ($i = 0; $i<@endpoint_names; $i++) {
|
||||
my $endp1 = new LANforge::Endpoint();
|
||||
my $en = $endpoint_names[$i];
|
||||
$utils->updateEndpoint($endp1, $en);
|
||||
while ($endp1->rx_pkts() <= 0) {
|
||||
if ($slp > 14) {
|
||||
# Things are not working right, it should never take this long
|
||||
print "WARNING: Endpoint $en is not receiving packets after $slp seconds.\n";
|
||||
last;
|
||||
}
|
||||
$slp++;
|
||||
sleep(1);
|
||||
$utils->updateEndpoint($endp1, $en);
|
||||
}
|
||||
}
|
||||
|
||||
# Stop cxs.
|
||||
for ($i = 0; $i<@cx_names; $i++) {
|
||||
my $nm = $cx_names[$i];
|
||||
$cmd = "set_cx_state $test_mgr $nm STOPPED";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
|
||||
my $elapsed = time() - $stime;
|
||||
my $tot_elapsed = time() - $begin_time;
|
||||
|
||||
$i = @cx_names;
|
||||
$tot_cx_started += $i;
|
||||
print "\nStarted and stopped $i connections this round in $elapsed seconds.\n";
|
||||
print "Started and stopped a total of $tot_cx_started in $tot_elapsed seconds.\n\n";
|
||||
|
||||
}
|
||||
|
||||
exit(0);
|
||||
|
||||
|
||||
sub initToDefaults {
|
||||
# Clean up database if stuff exists
|
||||
|
||||
$utils->doCmd("rm_cx $test_mgr all");
|
||||
$utils->doCmd("rm_endp YES_ALL");
|
||||
$utils->doCmd("rm_test_mgr $test_mgr");
|
||||
|
||||
# initPortsToDefault();
|
||||
}#initToDefaults
|
||||
|
||||
|
||||
sub initPortsToDefault {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
|
||||
$utils->doCmd("set_port $shelf_num $lanf1 $pn 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
$utils->doCmd("set_port $shelf_num $lanf2 $pn 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
|
||||
sub testFailed {
|
||||
my $msg = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
if (defined($should_fail) && ($should_fail eq "YES")) {
|
||||
print "\nGOOD: SUB-TEST FAILED correctly: $msg\n";
|
||||
$fail_msg .= "GOOD (should fail): $msg";
|
||||
}
|
||||
else {
|
||||
print "\nSUB-TEST FAILED: $msg\n";
|
||||
$fail_msg .= $msg;
|
||||
|
||||
if ($manual_check) {
|
||||
#$utils->doCmd("log_level 7");
|
||||
print "Press enter to continue with test: ";
|
||||
<STDIN>;
|
||||
}
|
||||
else {
|
||||
die("FATAL ERROR: $fail_msg\n");
|
||||
}
|
||||
}
|
||||
}#testFailed
|
||||
|
||||
sub setUpPorts {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
|
||||
my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
|
||||
my $cmd = "set_port $shelf_num $lanf1 $pn $ip $msk $gw NA NA NA";
|
||||
$utils->doCmd($cmd);
|
||||
my $p1 = new LANforge::Port();
|
||||
# Tell the port what it is so it decodes the right one..
|
||||
$utils->updatePort($p1, $shelf_num, $lanf1, $pn);
|
||||
# Make sure the values we attempted to set actually worked.
|
||||
verifyPortAttributes($p1, $shelf_num, $lanf1, $pn, $ip, $msk, $gw);
|
||||
|
||||
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
$cmd = "set_port $shelf_num $lanf2 $pn $ip $msk $gw NA NA NA";
|
||||
$utils->doCmd($cmd);
|
||||
my $p2 = new LANforge::Port();
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
# Tell the port what it is so it decodes the right one..
|
||||
$utils->updatePort($p2, $shelf_num, $lanf2, $pn);
|
||||
|
||||
verifyPortAttributes($p2, $shelf_num, $lanf2, $pn, $ip, $msk, $gw);
|
||||
|
||||
}#setUpPorts
|
||||
|
||||
|
||||
sub verifyPortAttributes {
|
||||
my $port = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $ip = shift;
|
||||
my $msk = shift;
|
||||
my $gw = shift;
|
||||
|
||||
my $_sn = $port->shelf_id();
|
||||
my $_cn = $port->card_id();
|
||||
my $_pn = $port->port_id();
|
||||
my $_ipa = $port->ip_addr();
|
||||
|
||||
my $p = $port->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n");
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n");
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n");
|
||||
$_ipa eq $ip or testFailed("$p: IP Address: $_ipa does not match: $ip\n");
|
||||
$port->ip_mask() eq $msk or testFailed("$p: IP Mask: " . $port->ip_mask() . " does not match: $msk\n");
|
||||
$port->ip_gw() eq $gw or testFailed("$p: IP Gateway: " . $port->ip_gw() . " does not match: $gw\n");
|
||||
|
||||
print "$p verified as correct!\n";
|
||||
}#verifyPortAttributes
|
||||
|
||||
|
||||
sub verifyEndpointAttributes {
|
||||
my $endp = shift;
|
||||
my $name = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $type = shift;
|
||||
my $ip_port = shift;
|
||||
my $bursty = shift;
|
||||
my $min_rate = shift;
|
||||
my $max_rate = shift;
|
||||
my $szrnd = shift;
|
||||
my $min_pkt_sz = shift;
|
||||
my $max_pkt_sz = shift;
|
||||
my $pattern = shift;
|
||||
my $using_csum = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
my $_sn = $endp->shelf_id();
|
||||
my $_cn = $endp->card_id();
|
||||
my $_pn = $endp->port_id();
|
||||
|
||||
my $p = $endp->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n", $should_fail);
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n", $should_fail);
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n", $should_fail);
|
||||
$endp->isOfType($type) or testFailed("$p: Type: " . $endp->ep_type() . " does not match: $type\n", $should_fail);
|
||||
if ($ip_port ne -1) {
|
||||
$endp->ip_port() eq $ip_port or testFailed("$p: IP-Port: " . $endp->ip_port() .
|
||||
" does not match: $ip_port\n", $should_fail);
|
||||
}
|
||||
$endp->getBursty() eq $bursty or testFailed("$p: Bursty: " . $endp->getBursty() .
|
||||
" does not match: $bursty\n", $should_fail);
|
||||
|
||||
$endp->min_tx_rate() eq $min_rate or testFailed("$p: Min-Tx-Rate: " . $endp->min_tx_rate() .
|
||||
" does not match: $min_rate\n", $should_fail);
|
||||
$endp->max_tx_rate() eq $max_rate or testFailed("$p: Max-Tx-Rate: " . $endp->max_tx_rate() .
|
||||
" does not match: $max_rate\n", $should_fail);
|
||||
|
||||
if ($endp->isCustom()) {
|
||||
($endp->size_random() eq "NO") or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" but we are CUSTOM!!\n", $should_fail);
|
||||
}
|
||||
else {
|
||||
$endp->size_random() eq $szrnd or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" does not match: $szrnd\n", $should_fail);
|
||||
}
|
||||
|
||||
if (! $endp->isCustom()) {
|
||||
$endp->min_pkt_size() eq $min_pkt_sz or testFailed("$p: Min-Packet-Size: " . $endp->min_pkt_size() .
|
||||
" does not match: $min_pkt_sz\n", $should_fail);
|
||||
$endp->max_pkt_size() eq $max_pkt_sz or testFailed("$p: Max-Packet-Size: " . $endp->max_pkt_size() .
|
||||
" does not match: $max_pkt_sz\n", $should_fail);
|
||||
}
|
||||
$endp->pattern() eq $pattern or testFailed("$p: Pattern: " . $endp->pattern() .
|
||||
" does not match: $pattern\n", $should_fail);
|
||||
$endp->checksum() eq $using_csum or testFailed("$p: Using-Checksum: " . $endp->checksum() .
|
||||
" does not match: $using_csum\n", $should_fail);
|
||||
|
||||
}#verifyEndpointAttributes
|
||||
|
||||
|
||||
sub genRandomHex {
|
||||
my $bytes = shift;
|
||||
|
||||
my @tbl = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f");
|
||||
my $i;
|
||||
my $pld = "";
|
||||
for ($i = 0; $i<$bytes; $i++) {
|
||||
$pld .= $tbl[(rand() * 1000.0) % 16] . $tbl[(rand() * 1000.0) % 16]; #Generate some hex the hard way!
|
||||
if ($i != ($bytes - 1)) {
|
||||
$pld .= " ";
|
||||
}
|
||||
}
|
||||
|
||||
return $pld;
|
||||
}#genRandomHex
|
||||
423
lf_many_conn2.pl
Executable file
423
lf_many_conn2.pl
Executable file
@@ -0,0 +1,423 @@
|
||||
#!/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.
|
||||
|
||||
# The purpose of this script is to create many connections
|
||||
# This script not only starts and stops connections, but
|
||||
# also verifys that both ends of the connection
|
||||
# have received data before tearing the connection down.
|
||||
# (Errors will be printed to the console if the connection
|
||||
# does not start in 15 seconds.)
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Udated by:
|
||||
#
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
use Net::Telnet();
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $lanf1 = 4;
|
||||
my $lanf2 = 4;
|
||||
|
||||
# Script assumes that we are using one port on each machine for data transmission...specifically
|
||||
# port 1.
|
||||
|
||||
my $test_mgr = "conn-mgr";
|
||||
|
||||
|
||||
my $report_timer = 8000; # XX/1000 seconds
|
||||
|
||||
my $between_start_stop = 120; # run for 120 seconds between start/stop
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
my $proto = "tcp"; # tcp, udp, or both
|
||||
my $cx_to_create = 800; # How many we will try to create.
|
||||
my $quiet = "yes";
|
||||
my $start_cx_num = 0;
|
||||
my $init_to_dflts = "yes";
|
||||
my $speed = 200000;
|
||||
my $payloadsize = 1400;
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the first item lf1_ports talks to the third column in lf2_ports.
|
||||
# Syntax is: port_num ip_addr ip_mask ip_gateway(dlft_router)
|
||||
#my $lf1_port = "1 172.16.1.200 255.255.255.0 172.16.1.1";
|
||||
#my $lf2_port = "1 172.16.1.220 255.255.255.0 172.16.1.1";
|
||||
my $lf1_port = "1 172.17.1.200 255.255.255.0 172.17.1.1";
|
||||
my $lf2_port = "2 172.17.1.220 255.255.255.0 172.17.1.1";
|
||||
|
||||
|
||||
|
||||
my $do_bulk_removes = 1;
|
||||
my $do_cx_too = 1; # Should probably be 1 most of the time...
|
||||
my $do_run_cxs = 1; #Should usually be 1
|
||||
my $fail_msg = "";
|
||||
my $manual_check = 0;
|
||||
|
||||
my $cmd_log_name = "lf_conn_cmds.txt";
|
||||
open(CMD_LOG, ">$cmd_log_name") or die("Can't open $cmd_log_name for writing...\n");
|
||||
print "History of all commands can be found in $cmd_log_name\n";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $usage = "$0 [--lf1_port {\"port_num ip mask gateway\"}]
|
||||
[--lf2_port {\"port_num ip mask gateway\"}]
|
||||
[--protocol {tcp | udp}]
|
||||
[--start_cx_num {num}]
|
||||
[--quiet {yes | no}]
|
||||
[--num_cxs {num}]
|
||||
[--init_to_dflts {yes | no}]
|
||||
|
||||
Example:
|
||||
$0 --lf1_port \"1 172.22.22.2 255.255.255.0 172.22.22.1\" --lf2_port \"1 172.22.22.3 255.255.255.0 172.22.22.1\" --init_to_dflts yes\n";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'protocol|p=s' => \$proto,
|
||||
'start_cx_num|s=i' => \$start_cx_num,
|
||||
'quiet|q=s' => \$quiet,
|
||||
'num_cxs|n=i' => \$cx_to_create,
|
||||
'init_ports|i=s' => \$init_to_dflts,
|
||||
'lf1_port|l=s' => \$lf1_port,
|
||||
'lf2_port|L=s' => \$lf2_port,
|
||||
'init_to_dflts|d=s' => \$init_to_dflts,
|
||||
) || die("$usage");
|
||||
|
||||
|
||||
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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
|
||||
# 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(1); # Repress output from CLI ??
|
||||
|
||||
|
||||
my $dt = "";
|
||||
|
||||
if ($init_to_dflts eq "yes") {
|
||||
initToDefaults();
|
||||
|
||||
# Now, add back the test manager we will be using
|
||||
$utils->doCmd("add_tm $test_mgr");
|
||||
$utils->doCmd("tm_register $test_mgr default"); #Add default user
|
||||
$utils->doCmd("tm_register $test_mgr default_gui"); #Add default GUI user
|
||||
|
||||
setUpPorts();
|
||||
}
|
||||
|
||||
# $utils->doCmd("log_level 63");
|
||||
|
||||
|
||||
# Create the connections we will be manipulating.
|
||||
my $i = 0;
|
||||
my $ep = $start_cx_num * 2;
|
||||
|
||||
my $cmd = "";
|
||||
my $cx = $start_cx_num;
|
||||
|
||||
for ($i = 0; $i<$cx_to_create; $i++) {
|
||||
my $burst = "NO";
|
||||
my $szrnd = "NO";
|
||||
my $pattern = "INCREASING";
|
||||
my $epnum = $i;
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
my $min_rate = $speed;
|
||||
my $max_rate = $speed;
|
||||
my $pktsz = $payloadsize;
|
||||
|
||||
$ep++;
|
||||
my $ep2 = "endp-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
$cmd = "add_endp $ep1 $shelf_num $lanf1 $pn lf_$proto -1 $burst $min_rate $max_rate $szrnd $pktsz $pktsz $pattern NO";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
# Don't verify these, for speed reasons (and they should always work unless something
|
||||
# is mis-configured.
|
||||
#my $endp1 = new LANforge::Endpoint();
|
||||
#$utils->updateEndpoint($endp1, $ep1);
|
||||
#verifyEndpointAttributes($endp1, $ep1, $shelf_num, $lf1, $lf1_ports[$j], $cx_types[$i], -1, $burst,
|
||||
# $min_rate, $max_rate, $szrnd, $min_pkt_szs[$i], $max_pkt_szs[$i], $pattern,
|
||||
# "NO"); # last is use_checksum
|
||||
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
$cmd = "add_endp $ep2 $shelf_num $lanf2 $pn lf_$proto -1 $burst $min_rate $max_rate $szrnd $pktsz $pktsz $pattern NO";
|
||||
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "cx-${cx}";
|
||||
$cmd = "add_cx $cx_name $test_mgr $ep1 $ep2";
|
||||
$utils->doCmd($cmd);
|
||||
$utils->doCmd("set_cx_report_timer $test_mgr $cx_name $report_timer");
|
||||
|
||||
$cx++;
|
||||
|
||||
@cx_names = (@cx_names, $cx_name);
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
# Now, bring up and down connections
|
||||
|
||||
my $tot_cx_started = 0;
|
||||
my $begin_time = time();
|
||||
|
||||
while (1) {
|
||||
my $stime = time();
|
||||
|
||||
for ($i = 0; $i<@cx_names; $i++) {
|
||||
my $nm = $cx_names[$i];
|
||||
$cmd = "set_cx_state $test_mgr $nm RUNNING";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
|
||||
# Make sure they all started, and wait untill both sides have received
|
||||
# a packet or two.
|
||||
my $slp = 0;
|
||||
for ($i = 0; $i<@endpoint_names; $i++) {
|
||||
my $endp1 = new LANforge::Endpoint();
|
||||
my $en = $endpoint_names[$i];
|
||||
$utils->updateEndpoint($endp1, $en);
|
||||
while ($endp1->rx_pkts() <= 0) {
|
||||
if ($slp > 20) {
|
||||
# Things are not working right, it should never take this long
|
||||
print "WARNING: Endpoint $en is not receiving packets after $slp seconds.\n";
|
||||
last;
|
||||
}
|
||||
$slp++;
|
||||
sleep(1);
|
||||
$utils->updateEndpoint($endp1, $en);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($between_start_stop);
|
||||
|
||||
# Stop cxs.
|
||||
for ($i = 0; $i<@cx_names; $i++) {
|
||||
my $nm = $cx_names[$i];
|
||||
$cmd = "set_cx_state $test_mgr $nm STOPPED";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
}#while true
|
||||
|
||||
exit(0);
|
||||
|
||||
|
||||
sub initToDefaults {
|
||||
# Clean up database if stuff exists
|
||||
|
||||
$utils->doCmd("rm_cx $test_mgr all");
|
||||
$utils->doCmd("rm_endp YES_ALL");
|
||||
$utils->doCmd("rm_test_mgr $test_mgr");
|
||||
|
||||
# initPortsToDefault();
|
||||
}#initToDefaults
|
||||
|
||||
|
||||
sub initPortsToDefault {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
|
||||
$utils->doCmd("set_port $shelf_num $lanf1 $pn 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
$utils->doCmd("set_port $shelf_num $lanf2 $pn 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
|
||||
sub testFailed {
|
||||
my $msg = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
if (defined($should_fail) && ($should_fail eq "YES")) {
|
||||
print "\nGOOD: SUB-TEST FAILED correctly: $msg\n";
|
||||
$fail_msg .= "GOOD (should fail): $msg";
|
||||
}
|
||||
else {
|
||||
print "\nSUB-TEST FAILED: $msg\n";
|
||||
$fail_msg .= $msg;
|
||||
|
||||
if ($manual_check) {
|
||||
#$utils->doCmd("log_level 7");
|
||||
print "Press enter to continue with test: ";
|
||||
<STDIN>;
|
||||
}
|
||||
else {
|
||||
die("FATAL ERROR: $fail_msg\n");
|
||||
}
|
||||
}
|
||||
}#testFailed
|
||||
|
||||
sub setUpPorts {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
|
||||
my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
|
||||
my $cmd = "set_port $shelf_num $lanf1 $pn $ip $msk $gw NA NA NA";
|
||||
$utils->doCmd($cmd);
|
||||
my $p1 = new LANforge::Port();
|
||||
# Tell the port what it is so it decodes the right one..
|
||||
$utils->updatePort($p1, $shelf_num, $lanf1, $pn);
|
||||
# Make sure the values we attempted to set actually worked.
|
||||
verifyPortAttributes($p1, $shelf_num, $lanf1, $pn, $ip, $msk, $gw);
|
||||
|
||||
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
$cmd = "set_port $shelf_num $lanf2 $pn $ip $msk $gw NA NA NA";
|
||||
$utils->doCmd($cmd);
|
||||
my $p2 = new LANforge::Port();
|
||||
($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
|
||||
# Tell the port what it is so it decodes the right one..
|
||||
$utils->updatePort($p2, $shelf_num, $lanf2, $pn);
|
||||
|
||||
verifyPortAttributes($p2, $shelf_num, $lanf2, $pn, $ip, $msk, $gw);
|
||||
|
||||
}#setUpPorts
|
||||
|
||||
|
||||
sub verifyPortAttributes {
|
||||
my $port = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $ip = shift;
|
||||
my $msk = shift;
|
||||
my $gw = shift;
|
||||
|
||||
my $_sn = $port->shelf_id();
|
||||
my $_cn = $port->card_id();
|
||||
my $_pn = $port->port_id();
|
||||
my $_ipa = $port->ip_addr();
|
||||
|
||||
my $p = $port->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n");
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n");
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n");
|
||||
$_ipa eq $ip or testFailed("$p: IP Address: $_ipa does not match: $ip\n");
|
||||
$port->ip_mask() eq $msk or testFailed("$p: IP Mask: " . $port->ip_mask() . " does not match: $msk\n");
|
||||
$port->ip_gw() eq $gw or testFailed("$p: IP Gateway: " . $port->ip_gw() . " does not match: $gw\n");
|
||||
|
||||
print "$p verified as correct!\n";
|
||||
}#verifyPortAttributes
|
||||
|
||||
|
||||
sub verifyEndpointAttributes {
|
||||
my $endp = shift;
|
||||
my $name = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $type = shift;
|
||||
my $ip_port = shift;
|
||||
my $bursty = shift;
|
||||
my $min_rate = shift;
|
||||
my $max_rate = shift;
|
||||
my $szrnd = shift;
|
||||
my $min_pkt_sz = shift;
|
||||
my $max_pkt_sz = shift;
|
||||
my $pattern = shift;
|
||||
my $using_csum = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
my $_sn = $endp->shelf_id();
|
||||
my $_cn = $endp->card_id();
|
||||
my $_pn = $endp->port_id();
|
||||
|
||||
my $p = $endp->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n", $should_fail);
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n", $should_fail);
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n", $should_fail);
|
||||
$endp->isOfType($type) or testFailed("$p: Type: " . $endp->ep_type() . " does not match: $type\n", $should_fail);
|
||||
if ($ip_port ne -1) {
|
||||
$endp->ip_port() eq $ip_port or testFailed("$p: IP-Port: " . $endp->ip_port() .
|
||||
" does not match: $ip_port\n", $should_fail);
|
||||
}
|
||||
$endp->getBursty() eq $bursty or testFailed("$p: Bursty: " . $endp->getBursty() .
|
||||
" does not match: $bursty\n", $should_fail);
|
||||
|
||||
$endp->min_tx_rate() eq $min_rate or testFailed("$p: Min-Tx-Rate: " . $endp->min_tx_rate() .
|
||||
" does not match: $min_rate\n", $should_fail);
|
||||
$endp->max_tx_rate() eq $max_rate or testFailed("$p: Max-Tx-Rate: " . $endp->max_tx_rate() .
|
||||
" does not match: $max_rate\n", $should_fail);
|
||||
|
||||
if ($endp->isCustom()) {
|
||||
($endp->size_random() eq "NO") or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" but we are CUSTOM!!\n", $should_fail);
|
||||
}
|
||||
else {
|
||||
$endp->size_random() eq $szrnd or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" does not match: $szrnd\n", $should_fail);
|
||||
}
|
||||
|
||||
if (! $endp->isCustom()) {
|
||||
$endp->min_pkt_size() eq $min_pkt_sz or testFailed("$p: Min-Packet-Size: " . $endp->min_pkt_size() .
|
||||
" does not match: $min_pkt_sz\n", $should_fail);
|
||||
$endp->max_pkt_size() eq $max_pkt_sz or testFailed("$p: Max-Packet-Size: " . $endp->max_pkt_size() .
|
||||
" does not match: $max_pkt_sz\n", $should_fail);
|
||||
}
|
||||
$endp->pattern() eq $pattern or testFailed("$p: Pattern: " . $endp->pattern() .
|
||||
" does not match: $pattern\n", $should_fail);
|
||||
$endp->checksum() eq $using_csum or testFailed("$p: Using-Checksum: " . $endp->checksum() .
|
||||
" does not match: $using_csum\n", $should_fail);
|
||||
|
||||
}#verifyEndpointAttributes
|
||||
|
||||
|
||||
sub genRandomHex {
|
||||
my $bytes = shift;
|
||||
|
||||
my @tbl = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f");
|
||||
my $i;
|
||||
my $pld = "";
|
||||
for ($i = 0; $i<$bytes; $i++) {
|
||||
$pld .= $tbl[(rand() * 1000.0) % 16] . $tbl[(rand() * 1000.0) % 16]; #Generate some hex the hard way!
|
||||
if ($i != ($bytes - 1)) {
|
||||
$pld .= " ";
|
||||
}
|
||||
}
|
||||
|
||||
return $pld;
|
||||
}#genRandomHex
|
||||
32
lf_many_vphy.pl
Executable file
32
lf_many_vphy.pl
Executable file
@@ -0,0 +1,32 @@
|
||||
#!/usr/bin/perl -w
|
||||
# Create lots of virtual radios with stations.
|
||||
# Note that lf_associate_ap.pl has many more options that
|
||||
# are not currently used here.
|
||||
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
|
||||
my $usage = "$0
|
||||
[--num_radios { number } ]
|
||||
[--ssid {ssid}]
|
||||
";
|
||||
|
||||
my $num_radios = 1;
|
||||
my $ssid = "ssid";
|
||||
|
||||
|
||||
|
||||
|
||||
GetOptions (
|
||||
'num_radios|r=i' => \$num_radios,
|
||||
'ssid|s=s' => \$ssid,
|
||||
) || (print($usage) && exit(1));
|
||||
|
||||
my $i;
|
||||
for ($i = 0; $i < $num_radios; $i++) {
|
||||
my $idx = $i + 1;
|
||||
my $sta = 600 + $idx;
|
||||
my $cmd = "./lf_associate_ap.pl --resource 1 --radio vphy$idx --vrad_chan 1 --num_stations 1 --first_sta sta$sta --action add --first_ip DHCP --ssid $ssid";
|
||||
print "$cmd\n";
|
||||
system($cmd);
|
||||
}
|
||||
1749
lf_max_cxs_v1_3000.pl
Executable file
1749
lf_max_cxs_v1_3000.pl
Executable file
File diff suppressed because it is too large
Load Diff
39
lf_mcast.bash
Executable file
39
lf_mcast.bash
Executable file
@@ -0,0 +1,39 @@
|
||||
#!/bin/bash
|
||||
|
||||
# Example script that creates and starts some multicast endpoints using
|
||||
# the lf_firemod.pl script. Lots of hard-coded variables in this
|
||||
# file that could become command-line switches, or could be re-implemented
|
||||
# in perl or some other favorite scripting language.
|
||||
|
||||
xmit_count=200
|
||||
rcv_count=100 # Could create more of these and only start a subset
|
||||
|
||||
lf_mgr=192.168.100.212
|
||||
resource=3
|
||||
quiet=no
|
||||
report_timer=1000
|
||||
|
||||
# Create and start transmitters
|
||||
for ((i=0; i<$xmit_count; i+=1))
|
||||
do
|
||||
port_num=$((10000 + i))
|
||||
# Creat transmitter endpoint
|
||||
./lf_firemod.pl --action create_endp --endp_name mcast_xmit_$i --speed 154000 --endp_type mc_udp --mcast_addr 224.9.9.$i --mcast_port $port_num --rcv_mcast NO --port_name eth1 --min_pkt_sz 1472 --max_pkt_sz 1472 --use_csums NO --ttl 32 --mgr $lf_mgr --resource $resource --quiet $quiet --report_timer $report_timer
|
||||
|
||||
# Start transmitter
|
||||
./lf_firemod.pl --endp_name mcast_xmit_$i --action start_endp --mgr $lf_mgr
|
||||
done
|
||||
|
||||
# Create and start receivers.
|
||||
for ((i=0; i<$rcv_count; i+=1))
|
||||
do
|
||||
port_num=$((10000 + i))
|
||||
./lf_firemod.pl --action create_endp --endp_name mcast_rcv_$i --speed 0 --endp_type mc_udp --mcast_addr 224.9.9.$i --mcast_port $port_num --rcv_mcast YES --port_name sta2 --use_csums NO --mgr $lf_mgr --resource $resource --quiet $quiet --report_timer $report_timer
|
||||
|
||||
# Start receiver
|
||||
./lf_firemod.pl --endp_name mcast_rcv_$i --action start_endp --mgr $lf_mgr
|
||||
done
|
||||
|
||||
|
||||
# Script could then randomly start and stop the receivers
|
||||
# to cause multicast join and leave messages.
|
||||
267
lf_monitor.pl
Executable file
267
lf_monitor.pl
Executable file
@@ -0,0 +1,267 @@
|
||||
#!/usr/bin/perl -w
|
||||
# This program is used to monitor and manage Layer4 connections
|
||||
#
|
||||
# Written by Candela Technologies Inc.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
use lib '/home/lanforge/scripts';
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
|
||||
use constant NA => "NA";
|
||||
use constant NL => "\n";
|
||||
our $shelf_num = 1;
|
||||
our $utils;
|
||||
# Default values for ye ole cmd-line args.
|
||||
our $resource = 1;
|
||||
our $quiet = "yes";
|
||||
our $cx_name = "";
|
||||
our $do_cmd = NA;
|
||||
our $action = "show_port";
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
our $cx_vals = undef;
|
||||
our $stop_at = "";
|
||||
our $fail_msg = "";
|
||||
our $interval = 10;
|
||||
our $reqs_sufx = qq<reqs*|requests*|urls*>;
|
||||
our $bytes_sufx = qq<bytes*>;
|
||||
our $secs_sufx = qq<secs*|seconds*>;
|
||||
our $known_suffixes = qq<$reqs_sufx|$bytes_sufx|$secs_sufx>;
|
||||
|
||||
our $rx_bytes = 0;
|
||||
our $url_count = 0;
|
||||
our $runtime = 0;
|
||||
our $is_running = 0;
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
# nice but not requested
|
||||
# show_endp output can be narrowed with key-value arguments
|
||||
#[--cx_vals {key,key,key,key}]
|
||||
# Examples:
|
||||
# --action show_cx --cx_vals MinTxRate,DestMAC,Avg-Jitter
|
||||
|
||||
my $usage = "$0 --action { show_cx | watch_cx | list_cx } ]
|
||||
[--mgr {host-name | IP}]
|
||||
[--mgr_port {ip port}]
|
||||
[--cx_name {name}]
|
||||
[--resource {number}]
|
||||
[--interval {number of seconds}]
|
||||
[--stop_at {[seconds]sec | [requests]req | [transferred]bytes}
|
||||
req can also be: requests reqs url urls
|
||||
[--quiet { yes | no }]
|
||||
|
||||
Example:
|
||||
$0 --mgr jedtest --action watch_cx --cx_name gl4g00 --interval 2 --stop_at 3urls
|
||||
";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'action|a=s' => \$action,
|
||||
'cx_name|e=s' => \$cx_name,
|
||||
'cx_vals|o=s' => \$cx_vals,
|
||||
'mgr|m=s' => \$lfmgr_host,
|
||||
'mgr_port|p=i' => \$lfmgr_port,
|
||||
'resource|r=i' => \$resource,
|
||||
'quiet|q=s' => \$quiet,
|
||||
'stop_at|s=s' => \$stop_at,
|
||||
'interval|i=i' => \$interval,
|
||||
) || do_err_exit("$usage");
|
||||
|
||||
if ($do_cmd ne "NA") {
|
||||
$action = "do_cmd";
|
||||
}
|
||||
|
||||
if (!(($action eq "show_cx") ||
|
||||
($action eq "watch_cx") ||
|
||||
($action eq "list_cx") ||
|
||||
($action eq "list_ports"))) {
|
||||
do_err_exit("Invalid action: $action\n$usage\n");
|
||||
}
|
||||
|
||||
do_err_exit("mgr should not be empty; $usage") if ("$lfmgr_host" eq "" );
|
||||
do_err_exit("mgr_port should not be empty; $usage") if ("$lfmgr_port" eq "" );
|
||||
do_err_exit("resource should not be empty; $usage") if ("$resource" eq "" );
|
||||
|
||||
if ($action eq "show_cx") {
|
||||
do_err_exit("cx_name should not be empty; $usage") if ("$cx_name" eq "" );
|
||||
}
|
||||
elsif( $action eq "watch_cx") {
|
||||
do_err_exit("stop_at should be greater than zero; $usage") if ("$stop_at" eq "");
|
||||
do_err_exit("interval should be greater than zero; $usage") if ($interval < 1 );
|
||||
do_err_exit("cx_name should not be empty; $usage") if ("$cx_name" eq "" );
|
||||
|
||||
if ($stop_at !~ /^\d+($known_suffixes)$/) {
|
||||
do_err_exit("stop_at should not have spaces and should end with $known_suffixes; $usage");
|
||||
}
|
||||
}
|
||||
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
sub do_err_exit {
|
||||
my $errmsg = shift;
|
||||
print $errmsg.NL;
|
||||
exit(1);
|
||||
}
|
||||
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
# Open connection to the LANforge server.
|
||||
# Wait up to 20 seconds when requesting info from LANforge.
|
||||
sub init {
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
$::utils = new LANforge::Utils();
|
||||
$::utils->telnet($t); # Set our telnet object.
|
||||
if ($::quiet eq "yes") {
|
||||
$::utils->cli_send_silent(1); # Do show input to CLI
|
||||
$::utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(0); # Do show input to CLI
|
||||
$::utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
}
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
sub stop_cx {
|
||||
my $_name = $::cx_name;
|
||||
$_name = "CX_".$::cx_name if ( $::cx_name !~ /^CX_/);
|
||||
my $result = $utils->doAsyncCmd("set_cx_state default_tm $_name STOPPED");
|
||||
print $result.NL;
|
||||
}
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
sub summarize_cx {
|
||||
my $name = $::cx_name;
|
||||
do_err_exit("please call summarize_cx() with endpoint name") if (!defined $name || "$name" eq "");
|
||||
|
||||
$name = "CX_".$::cx_name if ( $::cx_name !~ /^CX_/);
|
||||
my @lines = split(NL, $::utils->doAsyncCmd("show_cxe default_tm $name"));
|
||||
|
||||
for my $line (@lines) {
|
||||
chomp $line;
|
||||
if ( $line =~ /^L4Endp /) {
|
||||
($line =~ /^L4Endp .*? \((\w+)\)/);
|
||||
$::is_running = ("$1" eq "RUNNING") ? 1 : 0;
|
||||
}
|
||||
if ( $line =~ / RunningFor: /) {
|
||||
($::runtime) = ($line =~ / RunningFor: (\d+s) /);
|
||||
}
|
||||
if ( $line =~ / URLs Processed: / ) {
|
||||
($::url_count) = ($line =~ / Total: (\d+) /);
|
||||
}
|
||||
if ( $line =~ / Bytes Read: / ) {
|
||||
($::rx_bytes) = ($line =~ / Total: (\d+) /);
|
||||
}
|
||||
}
|
||||
}
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
|
||||
|
||||
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
##
|
||||
## M A I N
|
||||
##
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
|
||||
# begin our connection.
|
||||
init();
|
||||
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
if( $action eq "list_cx") {
|
||||
my @lines = split(NL, $utils->doAsyncCmd("show_endpoints"));
|
||||
my $msg = "";
|
||||
my $l4_flag = 0;
|
||||
my $print_flag = 0;
|
||||
for my $line (@lines) {
|
||||
chomp $line;
|
||||
|
||||
$l4_flag = 1 if ( $line =~ /^L4Endp /);
|
||||
next if (! $l4_flag);
|
||||
|
||||
if ( $line =~ /^L4Endp /) {
|
||||
($msg) = ($line =~ /^L4Endp (.*)$/);
|
||||
}
|
||||
if ( $line =~ /^\s+URL: /) {
|
||||
(my $u) = ($line =~ /^\s+URL: \S+ (\S+) /);
|
||||
$msg .= " $u";
|
||||
$print_flag = 1;
|
||||
}
|
||||
if ( $print_flag ) {
|
||||
print $msg . NL;
|
||||
$l4_flag = 0;
|
||||
$print_flag = 0;
|
||||
$msg = '';
|
||||
}
|
||||
}
|
||||
exit 0;
|
||||
}
|
||||
|
||||
## ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
|
||||
if ($action eq "show_cx") {
|
||||
my $_name = $::cx_name;
|
||||
$_name = "CX_".$::cx_name if ( $::cx_name !~ /^CX_/);
|
||||
print $utils->doAsyncCmd("show_cxe default_tm $_name") . NL;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if( $action eq "watch_cx") {
|
||||
my $thresh;
|
||||
($thresh) = ( $stop_at =~ /^(\d+)\w+$/);
|
||||
do_err_exit("stop_at should be greater than zero; $usage") if ("$stop_at" eq "");
|
||||
do_err_exit("stop_at should be greater than zero; $usage") if ($thresh < 1);
|
||||
do_err_exit("interval should be greater than zero; $usage") if ($interval < 1 );
|
||||
do_err_exit("cx_name should not be empty; $usage") if ("$cx_name" eq "" );
|
||||
|
||||
summarize_cx( $cx_name );
|
||||
my $continue = 1;
|
||||
while ($continue) {
|
||||
sleep $interval;
|
||||
summarize_cx( $cx_name );
|
||||
print "$cx_name: " .($is_running ? "active":"inactive");
|
||||
print " $::runtime, $::url_count urls, $::rx_bytes bytes\n";
|
||||
|
||||
# now check for bailout
|
||||
#print "Thresh $thresh | $stop_at | runtime $::runtime urls $::url_count rx $::rx_bytes\n";
|
||||
if ( $stop_at =~ /^\d+$secs_sufx$/ ) {
|
||||
my ($rtime) = ($::runtime =~ /^(\d+)s/);
|
||||
if ($rtime >= $thresh) {
|
||||
$continue = 0;
|
||||
}
|
||||
}
|
||||
elsif ( $stop_at =~ /^\d+($reqs_sufx)$/) {
|
||||
if ($::url_count >= $thresh) {
|
||||
$continue = 0;
|
||||
}
|
||||
}
|
||||
elsif ( $stop_at =~ /^\d+$bytes_sufx*$/ ) {
|
||||
if ($::rx_bytes >= $thresh) {
|
||||
$continue = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
stop_cx();
|
||||
print "connection $cx_name stopped.\n";
|
||||
}
|
||||
|
||||
#eof
|
||||
762
lf_netoptics.pl
Executable file
762
lf_netoptics.pl
Executable file
@@ -0,0 +1,762 @@
|
||||
#!/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.
|
||||
|
||||
# This script sets up connections to load-test pairs of ports.
|
||||
# The user does not need to give many details..the script attempts
|
||||
# to configure connections with optimal values for maximum throughput.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
# This breaks Net::Telnet...gah!
|
||||
#use bigint;
|
||||
|
||||
use strict;
|
||||
#use Switch;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
my @cx_types = ();
|
||||
|
||||
my $test_mgr = "netoptics_tm";
|
||||
my $report_timer = 1000; # Set report timer for all tests created in ms, i.e. 8 seconds
|
||||
|
||||
my $lfmgr_host = "127.0.0.1";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
# This sets up connections.
|
||||
my $lf1 = 1; # Minor Resource EID of first LANforge resource.
|
||||
|
||||
my @lf1_ports = ();
|
||||
|
||||
my $num_vlans = 3; # .1q vlans per physical port
|
||||
my $vid = "RANDOM";
|
||||
my $vlan_mac = "RANDOM";
|
||||
my $num_mvlans = 3; # mac-vlans per .1q vlan
|
||||
my $mvlan_mac = "RANDOM";
|
||||
my $num_cxs = 5; # CXs per MVL pair (or endpoints per MVL)
|
||||
my $ipaddr = "DHCP";
|
||||
my $mask = "255.255.0.0";
|
||||
my $subnet_per_vl = 1;
|
||||
|
||||
my $multicon = "AUTO";
|
||||
my $duration = 10 * 60 * 1000; # 10 minutes by default
|
||||
my $max_rate = 10000000000;
|
||||
my $max_pkt_sz = "AUTO";
|
||||
my $dbname = "netoptics-scr";
|
||||
my $clear_port_on_start = 1;
|
||||
my $group_prefix = "L3";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $ports_rpt = "Interface VID MAC IP\n";
|
||||
|
||||
# Parse cmd-line args
|
||||
my $i;
|
||||
for ($i = 0; $i<@ARGV; $i++) {
|
||||
my $var = $ARGV[$i];
|
||||
if ($var =~ m/(\S+)=(.*)/) {
|
||||
my $arg = $1;
|
||||
my $val = $2;
|
||||
handleCmdLineArg($arg, $val);
|
||||
}
|
||||
else {
|
||||
handleCmdLineArg($var);
|
||||
}
|
||||
}
|
||||
|
||||
if (@cx_types == 0) {
|
||||
@cx_types = ("lf_tcp");
|
||||
}
|
||||
|
||||
if (@lf1_ports < 2) {
|
||||
print("ERROR: Must specify two base ports, ie: --portA=eth1 --portB=eth2\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
if ($lfmgr_host eq undef) {
|
||||
print "\nYou must define a LANforge Manager!!!\n\n"
|
||||
. "For example:\n"
|
||||
. "./lf_netoptics.pl --mgr=localhost\n"
|
||||
. "OR\n"
|
||||
. "./lf_netoptics.pl --mgr=192.168.1.101\n\n";
|
||||
printHelp();
|
||||
exit (1);
|
||||
}
|
||||
|
||||
print
|
||||
"\nStarting script with the following arguments:"
|
||||
. "\nmanager: $lfmgr_host:$lfmgr_port"
|
||||
. "\nlf1: $lf1"
|
||||
. "\nlf1_ports: " . join(" ", @lf1_ports)
|
||||
. "\nipaddr: $ipaddr"
|
||||
. "\nsubnet-per-vlan: $subnet_per_vl"
|
||||
. "\nnum_mvlans: $num_mvlans"
|
||||
. "\nmax_rate: $max_rate"
|
||||
. "\nmax_pkt_size: $max_pkt_sz"
|
||||
. "\ncx_types: " . join(" ", @cx_types)
|
||||
. "\nnum_cxs: $num_cxs\n\n";
|
||||
|
||||
# Run some logic tests.
|
||||
if (1) {
|
||||
my $tst_ip = "99.99.99.2";
|
||||
my $tsti = toIpString($tst_ip);
|
||||
my $tips = toStringIp($tsti);
|
||||
if ($tst_ip ne $tips) {
|
||||
print ("tst-ip: $tst_ip as-integer: $tsti as-string-again: $tips\n");
|
||||
die("bug");
|
||||
}
|
||||
}
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
my $t = new Net::Telnet(Timeout => 15,
|
||||
#Dump_Log => "lf_netoptics.log",
|
||||
Prompt => '/default\@btbits\>\>/');
|
||||
|
||||
$t->telnetmode(0); # Not true telnet protocol
|
||||
$t->max_buffer_length(1024 * 1024 * 10); # 10M buffer
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 45);
|
||||
|
||||
$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 = getDate();
|
||||
my $dt_start = $dt;
|
||||
|
||||
|
||||
initToDefaults();
|
||||
|
||||
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
|
||||
doCmd("tm_register $test_mgr Admin");
|
||||
|
||||
my $i;
|
||||
my $p;
|
||||
my $q;
|
||||
my $m;
|
||||
my $ip;
|
||||
|
||||
# For each port, add .1q vlans.
|
||||
# For each .1q vlan, add mac-vlans
|
||||
|
||||
# Create list of IP addresses, one for each mac-vlan.
|
||||
if ($ipaddr eq "RANDOM") {
|
||||
# basically, just randomize the middle two octets
|
||||
$ip = (10 << 24) + int(rand(1<<23));
|
||||
$ip &= 0xffffff00;
|
||||
$ip |= 2;
|
||||
}
|
||||
else {
|
||||
if ($ipaddr eq "DHCP") {
|
||||
$ip = 0;
|
||||
}
|
||||
else {
|
||||
$ip = toIpString($ipaddr);
|
||||
print "IP-addr: $ipaddr (as int: $ip)\n";
|
||||
}
|
||||
}
|
||||
my @vl_ips = ();
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
@vl_ips = (@vl_ips, $ip);
|
||||
if ($subnet_per_vl) {
|
||||
if ($ipaddr eq "RANDOM") {
|
||||
# basically, just randomize the middle two octets
|
||||
$ip = (10 << 24) + int(rand(1<<23));
|
||||
$ip &= 0xffffff00;
|
||||
$ip |= 2;
|
||||
}
|
||||
else {
|
||||
if ($ipaddr eq "DHCP") {
|
||||
$ip = 0;
|
||||
}
|
||||
else {
|
||||
my $maski = toIpString($mask);
|
||||
print "maski: $maski ip: $ip\n";
|
||||
$ip += ~$maski;
|
||||
$ip &= $maski;
|
||||
$ip |= 2;
|
||||
print "after: ip: $ip\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$ip++;
|
||||
}
|
||||
}
|
||||
|
||||
my @ips = ();
|
||||
for ($p = 0; $p<@lf1_ports; $p++) {
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
for ($m = 0; $m<$num_mvlans; $m++) {
|
||||
if ($subnet_per_vl) {
|
||||
my $ip = $vl_ips[$q];
|
||||
@ips = (@ips, $ip);
|
||||
$ip++;
|
||||
$vl_ips[$q] = $ip;
|
||||
}
|
||||
else {
|
||||
@ips = (@ips, $ip);
|
||||
$ip++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $total_mvlans = @lf1_ports * $num_vlans * $num_mvlans;
|
||||
|
||||
# Build list of VIDs, we want same VID on each different
|
||||
# physical/base port.
|
||||
my $myvid;
|
||||
if ($vid eq "RANDOM") {
|
||||
$myvid = int(rand(4094));
|
||||
if ($myvid <= 0) {
|
||||
$myvid = 1;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$myvid = $vid;
|
||||
}
|
||||
|
||||
my @vids = ($myvid);
|
||||
for ($q = 0; $q < ($num_vlans - 1); $q++) {
|
||||
my $myvid;
|
||||
if ($vid eq "RANDOM") {
|
||||
$myvid = int(rand(4094));
|
||||
if ($myvid <= 0) {
|
||||
$myvid = 1;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$vid++;
|
||||
$myvid = $vid;
|
||||
}
|
||||
@vids = (@vids, $myvid);
|
||||
}
|
||||
|
||||
|
||||
my $do_simple_names = (@lf1_ports == 2);
|
||||
|
||||
my $ip_idx = 0;
|
||||
for ($p = 0; $p<@lf1_ports; $p++) {
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
# Create .1q vlan
|
||||
my $myvid = $vids[$q];
|
||||
my $vname = $lf1_ports[$p] . ".$myvid";
|
||||
doCmd("add_vlan $shelf $lf1 $lf1_ports[$p] $myvid $vname 8000");
|
||||
|
||||
if ($vlan_mac ne "PARENT") {
|
||||
my $mac_addr;
|
||||
if ($vlan_mac eq "RANDOM") {
|
||||
$mac_addr = getNextMac($vlan_mac);
|
||||
}
|
||||
else {
|
||||
$mac_addr = $vlan_mac;
|
||||
}
|
||||
doCmd("set_port $shelf $lf1 $vname NA NA NA NA NA $mac_addr");
|
||||
if ($vlan_mac ne "RANDOM") {
|
||||
$vlan_mac = getNextMac($vlan_mac);
|
||||
}
|
||||
}
|
||||
|
||||
# Create mac-vlans
|
||||
for ($m = 0; $m<$num_mvlans; $m++) {
|
||||
|
||||
my $mac_addr;
|
||||
if ($mvlan_mac eq "RANDOM") {
|
||||
$mac_addr = getNextMac($mvlan_mac);
|
||||
}
|
||||
else {
|
||||
$mac_addr = $mvlan_mac;
|
||||
}
|
||||
|
||||
my $mvname = "$vname#$m";
|
||||
doCmd("add_mvlan $shelf $lf1 $vname $mac_addr $m $mvname");
|
||||
|
||||
my $ips = toStringIp($ips[$ip_idx]);
|
||||
$ip_idx++;
|
||||
my $masks = $mask;
|
||||
my $interest_flags = 0x4000 | 0x4 | 0x8 ; # dhcp, IP, Mask
|
||||
my $cur_flags = 0;
|
||||
if ($ipaddr eq "DHCP") {
|
||||
$masks = "0.0.0.0";
|
||||
$cur_flags = 0x80000000; # use-dhcp
|
||||
}
|
||||
|
||||
# Set up IP addressing on the mac-vlan
|
||||
doCmd("set_port $shelf $lf1 $mvname $ips $masks NA NA $cur_flags NA NA NA NA $interest_flags");
|
||||
|
||||
$ports_rpt .= "$mvname $myvid $mac_addr $ips\n";
|
||||
|
||||
# Now, create endpoints on this port.
|
||||
my $e;
|
||||
for ($e = 0; $e < $num_cxs; $e++) {
|
||||
my $burst = "NO";
|
||||
my $szrnd = "NO";
|
||||
my $pattern = "increasing";
|
||||
my $ep1 = "$group_prefix-$p.$q#$m-$e";
|
||||
my $etype = $cx_types[$e % @cx_types];
|
||||
my $rate = int($max_rate / $num_cxs);
|
||||
my $pdu_sz = getPduSize($etype, $max_rate);
|
||||
my $mcon = $multicon;
|
||||
if ($mcon eq "AUTO") {
|
||||
if ($max_rate > 1000000000) {
|
||||
$mcon = 1;
|
||||
}
|
||||
else {
|
||||
$mcon = 0;
|
||||
}
|
||||
}
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 $mvname $etype -1 $burst $rate $rate $szrnd $pdu_sz $pdu_sz $pattern NO NA NA $mcon";
|
||||
doCmd($cmd);
|
||||
if ($clear_port_on_start) {
|
||||
doCmd("set_endp_flag $ep1 ClearPortOnStart 1");
|
||||
}
|
||||
}
|
||||
|
||||
if ($mvlan_mac ne "RANDOM") {
|
||||
$mvlan_mac = getNextMac($mvlan_mac);
|
||||
}
|
||||
}
|
||||
}
|
||||
}#for all ports
|
||||
|
||||
my $pdu_sz = getPduSize($cx_types[0], $max_rate);
|
||||
my $flags = 4; # symmetric
|
||||
my $script_body = "my-script $flags Script2544 '$duration 5000 bps,$max_rate $pdu_sz 50000,100000,500000,100000,0 bps,$max_rate $pdu_sz 0 NONE' ALL 0";
|
||||
|
||||
# Add cross-connects between the endpoints on port-pairs.
|
||||
for ($p = 0; $p<@lf1_ports; $p += 2) {
|
||||
# Add test-group for this port-pair
|
||||
my $pgname = "$group_prefix-$p";
|
||||
if ($do_simple_names) {
|
||||
$pgname = "$group_prefix-all";
|
||||
}
|
||||
doCmd("add_group $pgname 4 4");
|
||||
doCmd("set_script $pgname $script_body");
|
||||
|
||||
for ($q = 0; $q<$num_vlans; $q++) {
|
||||
my $myvid = $vids[$q];
|
||||
|
||||
# Add test-group for this vlan-pair
|
||||
my $vgname = "$group_prefix-$p.v$myvid";
|
||||
if ($do_simple_names) {
|
||||
$vgname = "$group_prefix-all-v$myvid";
|
||||
}
|
||||
|
||||
doCmd("add_group $vgname 4 4");
|
||||
doCmd("set_script $vgname $script_body");
|
||||
|
||||
for ($m = 0; $m<$num_mvlans; $m++) {
|
||||
|
||||
# Add test-group for this mvlan pair
|
||||
my $gname = "$group_prefix-$p.$q#$m";
|
||||
if ($do_simple_names) {
|
||||
$gname = "$group_prefix-v$myvid#$m";
|
||||
}
|
||||
doCmd("add_group $gname 4 4");
|
||||
doCmd("set_script $gname $script_body");
|
||||
|
||||
my $e;
|
||||
for ($e = 0; $e < $num_cxs; $e++) {
|
||||
# Now, add the cross-connects
|
||||
my $pp = int($p / 2);
|
||||
my $p2 = $p+1;
|
||||
my $ep1 = "$group_prefix-$p.$q#$m-$e";
|
||||
my $ep2 = "$group_prefix-$p2.$q#$m-$e";
|
||||
my $cx_name = "$group_prefix-$pp.$q.$m-$e";
|
||||
if ($do_simple_names) {
|
||||
$cx_name = "$group_prefix-$myvid#$m-$e";
|
||||
}
|
||||
|
||||
my $cmd = "add_cx $cx_name $test_mgr $ep1 $ep2";
|
||||
doCmd($cmd);
|
||||
doCmd("set_cx_report_timer $test_mgr $cx_name $report_timer");
|
||||
|
||||
# Add to groups
|
||||
doCmd("add_tgcx $gname $cx_name");
|
||||
doCmd("add_tgcx $vgname $cx_name");
|
||||
doCmd("add_tgcx $pgname $cx_name");
|
||||
|
||||
# TODO: Add 2544 scripts to test-groups
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
# Save this in a database for later retrieval.
|
||||
doCmd("save $dbname");
|
||||
|
||||
# Print some reporting on what was configured.
|
||||
print "<PORTS_CREATED>\n$ports_rpt</PORTS_CREATED>\n";
|
||||
|
||||
|
||||
$dt = getDate();
|
||||
print "Started lf_netoptics.pl script at : $dt_start\n";
|
||||
print "Completed lf_netoptics.pl script at: $dt\n\n";
|
||||
exit(0);
|
||||
#####################
|
||||
# END lf_macvlan.pl #
|
||||
#####################
|
||||
|
||||
|
||||
|
||||
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");
|
||||
my $rslt = doCmd("show_group");
|
||||
my @rslts = split(/\n/, $rslt);
|
||||
my $i;
|
||||
my $pat = ".*TestGroup name: (${group_prefix}-\\S+)\\s+";
|
||||
#print "pattern -:$pat:-\n";
|
||||
for ($i = 0; $i<@rslts; $i++) {
|
||||
my $ln = $rslts[$i];
|
||||
chomp($ln);
|
||||
#print "test-group-rslt-line -:$ln:-\n";
|
||||
if ($ln =~ /$pat/) {
|
||||
doCmd("rm_group $1");
|
||||
}
|
||||
}
|
||||
|
||||
initPortsToDefault();
|
||||
}#initToDefaults
|
||||
|
||||
sub getNextMac {
|
||||
my $last = shift;
|
||||
if ($last eq "RANDOM") {
|
||||
my $msb = int(rand(255)) & 0xfe; # make sure odd bit (mcast) isn't set.
|
||||
return sprintf("%02x:%02x:%02x:%02x:%02x:%02x", $msb, int(rand(255)), int(rand(255)), int(rand(255)),
|
||||
int(rand(255)), int(rand(255)));
|
||||
}
|
||||
else {
|
||||
# Parse last, and increment.
|
||||
if ($last =~ /(\S+):(\S+):(\S+):(\S+):(\S+):(\S+)/) {
|
||||
my $dl = hex($6);
|
||||
$dl |= (hex($5) << 8);
|
||||
$dl |= (hex($4) << 16);
|
||||
$dl |= (hex($3) << 24);
|
||||
|
||||
my $dh |= hex($2);
|
||||
$dh |= (hex($1) << 8);
|
||||
|
||||
$dl++; # Increment mac by one.
|
||||
if ($dl == 0) {
|
||||
# Wrapped, how unlucky.
|
||||
$dh++;
|
||||
}
|
||||
return sprintf("%02x:%02x:%02x:%02x:%02x:%02x",
|
||||
($dh & 0xff00) >> 8,
|
||||
($dh & 0xff),
|
||||
($dl & 0xff000000) >> 24,
|
||||
($dl & 0xff0000) >> 16,
|
||||
($dl & 0xff00) >> 8,
|
||||
($dl & 0xff));
|
||||
}
|
||||
}
|
||||
} # getNextMac
|
||||
|
||||
|
||||
sub toIpString {
|
||||
my $ips = shift;
|
||||
if ($ips =~ /(\S+)\.(\S+)\.(\S+)\.(\S+)/) {
|
||||
my $d = int($4);
|
||||
$d += ((int($3) << 8) & 0xff00);
|
||||
$d += ((int($2) << 16) & 0xff0000);
|
||||
$d += ((int($1) << 24) & 0xff000000);
|
||||
return $d;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub toStringIp {
|
||||
my $ip = shift;
|
||||
return sprintf("%d.%d.%d.%d",
|
||||
($ip >> 24),
|
||||
($ip & 0xff0000) >> 16,
|
||||
($ip & 0xff00) >> 8,
|
||||
($ip & 0xff));
|
||||
}
|
||||
|
||||
# Wait until 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 {
|
||||
clearVlanPorts($shelf, $lf1);
|
||||
|
||||
throttleCard($shelf, $lf1);
|
||||
|
||||
# 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];
|
||||
doCmd("set_port $shelf $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
}
|
||||
|
||||
sub clearVlanPorts {
|
||||
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 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;
|
||||
for ($i = 0; $i<$mx; $i++) {
|
||||
if (($ports[$i]->isMacVlan()) || ($ports[$i]->is8021qVlan())) {
|
||||
# See if it belongs to any of our interfaces
|
||||
my $par = $ports[$i]->parent();
|
||||
if ($par ne "") {
|
||||
my $base;
|
||||
if ($par =~ /(\S+)\#.*/) {
|
||||
$base = $1; # mac-vlan
|
||||
}
|
||||
elsif ($par =~ /(\S+)\..*/) {
|
||||
$base = $1; # .1q vlan
|
||||
}
|
||||
else {
|
||||
$base = $par;
|
||||
}
|
||||
|
||||
my $p;
|
||||
for ($p = 0; $p < @lf1_ports; $p++) {
|
||||
if ($lf1_ports[$p] eq $base) {
|
||||
doCmd($ports[$i]->getDeleteCmd());
|
||||
$found_one = 1;
|
||||
last;
|
||||
}
|
||||
}# for all physical/base ports
|
||||
}# if found port has parent device
|
||||
}# Found a vlan device
|
||||
}# for all found ports
|
||||
}# while we found something to delete
|
||||
}#clearVlanPorts
|
||||
|
||||
# Returns string, might want to split it to get line-by-line option
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
|
||||
if ($cmd) {
|
||||
print ">>> $cmd\n";
|
||||
$t->print($cmd);
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
return join("\n", @rslt);
|
||||
} else {
|
||||
print "\n***** doCmd (): NULL COMMAND !!! *****";
|
||||
print "\n$cmd\n\n";
|
||||
exit (1);
|
||||
}
|
||||
}
|
||||
|
||||
sub getDate {
|
||||
my $date = `date`;
|
||||
chomp($date);
|
||||
return $date
|
||||
}
|
||||
|
||||
sub printArgs {
|
||||
print
|
||||
. "\nModified arguments:"
|
||||
. "\nmanager: $lfmgr_host\n"
|
||||
. "\nlf1: $lf1\n"
|
||||
. "\nlf1_ports: " . join(" ", @lf1_ports)
|
||||
. "\nnum_mvlans: $num_mvlans"
|
||||
. "\nmax_rate: $max_rate"
|
||||
. "\ncx_types: " . join(" ", @cx_types)
|
||||
. "\n\n";
|
||||
}
|
||||
|
||||
sub printHelp {
|
||||
print
|
||||
. "USAGE: --mgr=[ip-of-mgr]\n"
|
||||
. " --testMgrName=\"ben_tm\"\n"
|
||||
. " --resourceId=[1|n]\n"
|
||||
. " --protocolFlags=[n]: tcp4:1, udp4:2, tcp6:4 udp6:8\n"
|
||||
. " --portA=\"eth1\"\n"
|
||||
. " --portB=\"eth2\"\n"
|
||||
. " --vlanAmt=[3|n]\n"
|
||||
. " --macVlanAmt=[3|n]\n"
|
||||
. " --clearPortOnStart=[0|1]\n"
|
||||
. " --cxPerMacVlanAmt=[5|n]\n"
|
||||
. " --vlanID=[RANDOM|n]\n"
|
||||
. " --ip=\"DHCP|RANDOM|192.168.7.2\"\n"
|
||||
. " --mask=\"255.255.0.0\"\n"
|
||||
. " --subnetPerMacVlan=[0|1]\n"
|
||||
. " --dbName=\"my_db_name\"\n"
|
||||
. " --desiredTotalTxRate=[n] (in bits-per-second)\n"
|
||||
. " --pduSize=[AUTO|n] (in bytes, payload size)\n"
|
||||
. " --duration=[n] (duration of script run, in miliseconds)\n"
|
||||
. " --multicon=[AUTO|0|1|n] (Enable multi-conn feature, or not)\n"
|
||||
. "\n";
|
||||
|
||||
}
|
||||
|
||||
sub getPduSize {
|
||||
my $etype = shift;
|
||||
my $rate = shift;
|
||||
|
||||
if ($max_pkt_sz ne "AUTO") {
|
||||
return $max_pkt_sz;
|
||||
}
|
||||
|
||||
my $rv;
|
||||
if ($rate > 1000000000) {
|
||||
# Use big pkts for > 1Gbps
|
||||
if ($etype =~ /.*udp.*/i) {
|
||||
return 64000;
|
||||
}
|
||||
else {
|
||||
return 200000;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Attempt to fit into 1500 byte MTU pkt
|
||||
if ($etype eq "lf_udp") {
|
||||
return 1472;
|
||||
}
|
||||
elsif ($etype eq "lf_tcp") {
|
||||
return 1460;
|
||||
}
|
||||
elsif ($etype eq "lf_udp6") {
|
||||
return 1452;
|
||||
}
|
||||
elsif ($etype eq "lf_tcp6") {
|
||||
return 1440;
|
||||
}
|
||||
else {
|
||||
print "Unknown cx type: $etype in PDU auto-cal method, returning 4000\n";
|
||||
return 4000;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub handleCmdLineArg {
|
||||
my $arg = $_[0];
|
||||
my $val = $_[1];
|
||||
|
||||
if ($arg eq "help" || $arg eq "--help" || $arg eq "-h" || $arg eq "-help" || $arg eq "-h" ) {
|
||||
printHelp();
|
||||
exit(0);
|
||||
}
|
||||
elsif ($arg eq "--mgr") {
|
||||
$lfmgr_host = $val;
|
||||
}
|
||||
elsif ($arg eq "--testMgrName") {
|
||||
$test_mgr = $val;
|
||||
}
|
||||
elsif ($arg eq "--resourceId") {
|
||||
$lf1 = $val;
|
||||
}
|
||||
elsif ($arg eq "--protocolFlags") {
|
||||
my $vi = int($val);
|
||||
if ($vi & 0x1) {
|
||||
@cx_types = (@cx_types, "lf_tcp");
|
||||
}
|
||||
if ($vi & 0x2) {
|
||||
@cx_types = (@cx_types, "lf_udp");
|
||||
}
|
||||
if ($vi & 0x4) {
|
||||
@cx_types = (@cx_types, "lf_tcp6");
|
||||
}
|
||||
if ($vi & 0x8) {
|
||||
@cx_types = (@cx_types, "lf_udp6");
|
||||
}
|
||||
}
|
||||
elsif ($arg eq "--portA") {
|
||||
@lf1_ports = (@lf1_ports, $val);
|
||||
}
|
||||
elsif ($arg eq "--portB") {
|
||||
@lf1_ports = (@lf1_ports, $val);
|
||||
}
|
||||
elsif ($arg eq "--vlanAmt") {
|
||||
$num_vlans = $val;
|
||||
}
|
||||
elsif ($arg eq "--macVlanAmt") {
|
||||
$num_mvlans = $val;
|
||||
}
|
||||
elsif ($arg eq "--vlanID") {
|
||||
$vid = $val;
|
||||
}
|
||||
elsif ($arg eq "--vlanMAC") {
|
||||
$vlan_mac = $val;
|
||||
}
|
||||
elsif ($arg eq "--macVlanMAC") {
|
||||
$mvlan_mac = $val;
|
||||
}
|
||||
elsif ($arg eq "--ip") {
|
||||
$ipaddr = $val;
|
||||
}
|
||||
elsif ($arg eq "--mask") {
|
||||
$mask = $val;
|
||||
}
|
||||
elsif ($arg eq "--subnetPerMacVlan") {
|
||||
$subnet_per_vl = $val;
|
||||
}
|
||||
elsif ($arg eq "--dbName") {
|
||||
$dbname = $val;
|
||||
}
|
||||
elsif ($arg eq "--cxPerMacVlanAmt") {
|
||||
$num_cxs = $val;
|
||||
}
|
||||
elsif ($arg eq "--clearPortOnStart") {
|
||||
$clear_port_on_start = int($val);
|
||||
}
|
||||
elsif ($arg eq "--desiredTotalTxRate") {
|
||||
$max_rate = $val;
|
||||
}
|
||||
elsif ($arg eq "--pduSize") {
|
||||
$max_pkt_sz = $val;
|
||||
}
|
||||
elsif ($arg eq "--duration") {
|
||||
$duration = int($val);
|
||||
}
|
||||
elsif ($arg eq "--multicon") {
|
||||
$multicon = $val;
|
||||
}
|
||||
else {
|
||||
print "\n\nCould not parse one or more of the arguments !!!\n"
|
||||
. "First rejected argument: $arg\n";
|
||||
printHelp();
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
1066
lf_nfs_io.pl
Executable file
1066
lf_nfs_io.pl
Executable file
File diff suppressed because it is too large
Load Diff
87
lf_parse_tshark_log.pl
Executable file
87
lf_parse_tshark_log.pl
Executable file
@@ -0,0 +1,87 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
|
||||
$| = 1; # Don't buffer things...
|
||||
|
||||
my $last_seq = -1;
|
||||
my $last_pkt = -1;
|
||||
my $last_ts = -1;
|
||||
|
||||
my $last_seq_ooo = -1;
|
||||
my $last_pkt_ooo = -1;
|
||||
my $last_ts_ooo = -1;
|
||||
|
||||
# Reads in input like:
|
||||
#23930 18.005150 192.168.1.102 -> 192.168.1.101 LANforge Seq: 66653
|
||||
#23931 18.005265 192.168.1.102 -> 192.168.1.101 LANforge Seq: 66654
|
||||
#23932 18.005391 192.168.1.102 -> 192.168.1.101 LANforge Seq: 66655
|
||||
|
||||
while(<>) {
|
||||
my $ln = $_;
|
||||
chomp($ln);
|
||||
if ($ln =~ /^\s*(\d+)\s+(\S+)\s+(.*)\s+LANforge Seq:\s+(\d+)/) {
|
||||
my $pkt = $1;
|
||||
my $ts = $2;
|
||||
my $stream = $3;
|
||||
my $seq = $4;
|
||||
|
||||
#print "pkt is LANforge protocol: $ln\n";
|
||||
|
||||
my $gap = $seq - $last_seq;
|
||||
my $skip_update = 0;
|
||||
# TODO: Deal with different streams, have to take IP ports into account too probably.
|
||||
if ($gap != 1) {
|
||||
if ($gap > 1) {
|
||||
print "DROP: pkt-gap, seq: $last_seq\/$seq pkt-cnt: $last_pkt\/$pkt timestamp: $last_ts\/$ts gap: $gap\n";
|
||||
$last_seq_ooo = -1;
|
||||
}
|
||||
elsif ($gap == 0) {
|
||||
print "DUP: pkt-gap, seq: $last_seq\/$seq pkt-cnt: $last_pkt\/$pkt timestamp: $last_ts\/$ts gap: $gap\n";
|
||||
$last_seq_ooo = -1;
|
||||
}
|
||||
else {
|
||||
# New seq is smaller than old. Either an OOO pkt, or perhaps a seq-number wrap?
|
||||
if ($seq <= 10) {
|
||||
# Assume wrap
|
||||
print "WRAP: pkt-gap, seq: $last_seq\/$seq pkt-cnt: $last_pkt\/$pkt timestamp: $last_ts\/$ts gap: $gap\n";
|
||||
$last_seq_ooo = -1;
|
||||
}
|
||||
else {
|
||||
my $ooo_gap = $seq - $last_seq_ooo;
|
||||
my $skip_update_ooo = 0;
|
||||
if ($last_seq_ooo == -1) {
|
||||
print "OOO: pkt-gap, seq: $last_seq\/$seq pkt-cnt: $last_pkt\/$pkt timestamp: $last_ts\/$ts gap: $gap\n";
|
||||
}
|
||||
elsif ($ooo_gap > 1) {
|
||||
print "OOO-DROP: pkt-gap, seq: $last_seq_ooo\/$seq pkt-cnt: $last_pkt_ooo\/$pkt timestamp: $last_ts_ooo\/$ts gap: $ooo_gap\n";
|
||||
}
|
||||
elsif ($ooo_gap == 0) {
|
||||
print "OOO-DUP: pkt-gap, seq: $last_seq_ooo\/$seq pkt-cnt: $last_pkt_ooo\/$pkt timestamp: $last_ts_ooo\/$ts gap: $ooo_gap\n";
|
||||
}
|
||||
elsif ($ooo_gap < 0) {
|
||||
# Fun, out of order flow in already out of order flow!
|
||||
print "OOO-OOO: pkt-gap, seq: $last_seq_ooo\/$seq pkt-cnt: $last_pkt_ooo\/$pkt timestamp: $last_ts_ooo\/$ts gap: $ooo_gap\n";
|
||||
$skip_update_ooo = 1;
|
||||
}
|
||||
|
||||
if (! $skip_update_ooo) {
|
||||
# Start of OOO pkt sequence
|
||||
$last_seq_ooo = $seq;
|
||||
$last_pkt_ooo = $pkt;
|
||||
$last_ts_ooo = $ts;
|
||||
}
|
||||
|
||||
# Don't update main pkt counters for OOO pkts.
|
||||
$skip_update = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (! $skip_update) {
|
||||
$last_seq = $seq;
|
||||
$last_pkt = $pkt;
|
||||
$last_ts = $ts;
|
||||
}
|
||||
}
|
||||
}
|
||||
279
lf_port_walk.pl
Executable file
279
lf_port_walk.pl
Executable file
@@ -0,0 +1,279 @@
|
||||
#!/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.
|
||||
|
||||
# The purpose of this script is to create 10 (or more) TCP and/or UDP connections on
|
||||
# specified ports. The connections will run for a short period of time, and
|
||||
# then 10 more will be created on a new set of ports (the next 10). It
|
||||
# writes it's cmds to a log file so you can get an idea of what it's doing.
|
||||
#
|
||||
# This script should be useful for people who are testing firewalls and other
|
||||
# types of systems that care about what ports the data is transmitted on...
|
||||
#
|
||||
# Written by Candela Technologies Inc.
|
||||
# Udated by:
|
||||
#
|
||||
#
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $lanf1 = 1;
|
||||
my $lanf2 = 2;
|
||||
|
||||
# Script assumes that we are using one port on each machine for data transmission...specifically
|
||||
# port 1.
|
||||
|
||||
my $test_mgr = "port-walker";
|
||||
|
||||
|
||||
my $run_for_time = 20; # Run for XX seconds before tearing down and bringing up the next set..
|
||||
my $report_timer = 8000; # XX/1000 seconds
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
my $proto = "both"; # tcp, udp, or both
|
||||
my $start_port = 1; # Port to start with...
|
||||
my $end_port = 65535; # port to end with
|
||||
my $to_do_at_a_time = 20; # Do XX cross-connects at a time. Don't make this too big,
|
||||
# especially now...there is a buglet w/the GUI, especially...
|
||||
my $do_bulk_removes = 1;
|
||||
my $do_cx_too = 1; # Should probably be 1 most of the time...
|
||||
my $do_run_cxs = 1; #Should usually be 1
|
||||
|
||||
my $cmd_log_name = "lf_port_walk_cmds.txt";
|
||||
open(CMD_LOG, ">$cmd_log_name") or die("Can't open $cmd_log_name for writing...\n");
|
||||
print "History of all commands can be found in $cmd_log_name\n";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $usage = "$0 [--protocol={tcp | udp | both}] [--start_port={port}] [--end_port={port}]\n";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'protocol|p=s' => \$proto,
|
||||
'start_port|s=i' => \$start_port,
|
||||
'end_port|e=i' => \$end_port,
|
||||
) || die("$usage");
|
||||
|
||||
|
||||
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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
# Lets create udp and tcp connections on all ports. Some of these
|
||||
# won't work, so we'll ignore them.
|
||||
|
||||
# get these numbers by doing something like:
|
||||
# netstat -an | grep LISTEN
|
||||
# There may be more or less on your machine...it would be best to check with the
|
||||
# above cmd.
|
||||
#
|
||||
my @tcp_ignore_array = (
|
||||
6010, # X
|
||||
3999, 4002, 4001, # LANforge
|
||||
1024, # varies, rpc.statd often
|
||||
111, # portmapper for NFS
|
||||
22, #ssh
|
||||
25, #smtp (email)
|
||||
);
|
||||
|
||||
# Set up a hash for fast existence checking...
|
||||
my %ignore_ports = ();
|
||||
for ($i = 0; $i<@tcp_ignore_array; $i++) {
|
||||
my $prt = $tcp_ignore_array[$i];
|
||||
$ignore_ports->{$prt} = "$prt";
|
||||
}
|
||||
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "\n\n***** Starting loop at: $dt *****\n\n";
|
||||
|
||||
# Remove any existing configuration information
|
||||
initToDefaults();
|
||||
|
||||
print " ***Sleeping 3 seconds for ports to initialize to defaults...\n";
|
||||
sleep(3);
|
||||
|
||||
#exit(0);
|
||||
|
||||
# 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();
|
||||
|
||||
print " ***Sleeping 3 seconds for ports to initialize to current values...\n";
|
||||
sleep(3);
|
||||
|
||||
|
||||
# Now, go build lots of endpoints, one for every tcp/udp port known to man and beast!
|
||||
for ($i = $start_port; $i<$end_port; $i++) {
|
||||
|
||||
# Do XX at once.
|
||||
my $j = 0;
|
||||
for ($j = 0; $j<$to_do_at_a_time; $j++) {
|
||||
|
||||
my $ht = $ignore_ports->{$i};
|
||||
if ((defined($ht)) && (length($ht) > 0)) {
|
||||
# continue...it's in our ignore list
|
||||
# TODO: We could probably still do UDP, so we should really have separate
|
||||
# ingore lists for the different protocols...
|
||||
print " *** Skipping port: $i\n";
|
||||
$i++;
|
||||
next;
|
||||
}
|
||||
|
||||
# Syntax for adding an endpoint is:
|
||||
# add_endp [alias] [shelf] [card] [port] [type] [IP-port] [bursty] [min_rate] [max_rate]
|
||||
# [pkt_sz_random] [min_pkt] [max_pkt] [pattern] [use_checksum]
|
||||
|
||||
if (($proto eq "both") || ($proto eq "udp")) {
|
||||
# Set up 128Kbps full duplex UDP link, 1200 byte UDP payloads, on port $i
|
||||
print " *** Creating UDP endpoint on port $i\n";
|
||||
doCmd("add_endp udp-$i-TX $shelf_num $lanf1 1 lf_udp $i NO 512000 512000 NO 1200 1200 increasing NO");
|
||||
doCmd("add_endp udp-$i-RX $shelf_num $lanf2 1 lf_udp $i NO 512000 512000 NO 1200 1200 increasing NO");
|
||||
if ($do_cx_too) {
|
||||
doCmd("add_cx udp-$i $test_mgr udp-${i}-TX udp-${i}-RX");
|
||||
@cx_names = (@cx_names, "udp-$i");
|
||||
}
|
||||
|
||||
@endpoint_names = (@endpoint_names, "udp-${i}-TX", "udp-${i}-RX");
|
||||
}
|
||||
|
||||
if (($proto eq "both") || ($proto eq "tcp")) {
|
||||
# Set up 128Kbps full duplex TCP link, 1200 byte TCP payloads, on port $i
|
||||
print " *** Creating TCP endpoint on port $i\n";
|
||||
doCmd("add_endp tcp-$i-TX $shelf_num $lanf1 1 lf_tcp $i NO 512000 512000 NO 1200 1200 increasing NO");
|
||||
doCmd("add_endp tcp-$i-RX $shelf_num $lanf2 1 lf_tcp $i NO 512000 512000 NO 1200 1200 increasing NO");
|
||||
if ($do_cx_too) {
|
||||
doCmd("add_cx tcp-$i $test_mgr tcp-${i}-TX tcp-${i}-RX");
|
||||
@cx_names = (@cx_names, "tcp-$i");
|
||||
}
|
||||
|
||||
@endpoint_names = (@endpoint_names, "tcp-${i}-TX", "tcp-${i}-RX");
|
||||
}
|
||||
|
||||
$i++;
|
||||
if ($i >= $end_port) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
# So, our CXs and endpoints are created...lets start them running.
|
||||
if ($do_run_cxs) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
|
||||
# SLeep for a bit, because it takes connections, especially TCP a bit to get started
|
||||
# properly...and we want to give the user time to see if the expected behaviour is
|
||||
# really happening....
|
||||
|
||||
print " ***Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
if ($do_run_cxs) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
|
||||
my $q = 0;
|
||||
if (! $do_bulk_removes) {
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
# Delete the endpoints and cross-connects related to this test manager.
|
||||
doCmd("rm_cx $test_mgr $cx_names[$q]");
|
||||
}
|
||||
|
||||
for ($q = 0; $q<@endpoint_names; $q++) {
|
||||
# Delete the endpoints and cross-connects related to this test manager.
|
||||
doCmd("rm_endp $endpoint_names[$q]");
|
||||
}
|
||||
}
|
||||
else {
|
||||
doCmd("rm_cx $test_mgr ALL");
|
||||
doCmd("rm_endp YES_ALL"); # Won't delete those attached to cross-connects still...
|
||||
}
|
||||
|
||||
@endpoint_names = ();
|
||||
@cx_names = ();
|
||||
|
||||
}# for all ports
|
||||
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub initPortsToDefault {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
my $num_ports = 1;
|
||||
for ($i = 1; $i<=$num_ports; $i++) {
|
||||
doCmd("set_port $shelf_num $lanf1 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub initIpAddresses {
|
||||
# Set all ports we are messing with to known state.
|
||||
|
||||
# Syntax for setting port info is:
|
||||
# set_port [shelf] [card] [port] [ip] [mask] [gateway] [cmd-flags] [cur-flags] [MAC]
|
||||
# NOTE: Just use NA for the flags for now...not tested otherwise.
|
||||
|
||||
doCmd("set_port $shelf_num $lanf1 1 172.25.7.2 255.255.255.0 172.25.7.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 1 172.25.7.3 255.255.255.0 172.25.7.1 NA NA NA");
|
||||
}
|
||||
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
|
||||
print CMD_LOG "$cmd\n";
|
||||
print ">>> $cmd\n";
|
||||
|
||||
$t->print($cmd);
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
#sleep(1);
|
||||
}
|
||||
440
lf_portmod.pl
Executable file
440
lf_portmod.pl
Executable file
@@ -0,0 +1,440 @@
|
||||
#!/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.
|
||||
|
||||
# If Net::Telnet is not found, try: yum install "perl(Net::Telnet)"
|
||||
|
||||
# If the LANforge libraries are not found, make sure you are running
|
||||
# from the /home/lanforge directory (or where-ever you installed LANforge)
|
||||
|
||||
# Contact: support@candelatech.com if you have any questions or suggestions
|
||||
# for improvement.
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Updated by: greearb@candelatech.com
|
||||
#
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
#use Carp;
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
#use constant;
|
||||
package main;
|
||||
|
||||
#use constant NL => "\n";
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
my $shelf_num = 1;
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $card = 1;
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
|
||||
my $port_name = "";
|
||||
my $cmd = "";
|
||||
our $quiet = 0;
|
||||
my $load = "";
|
||||
my $amt_resets = 1;
|
||||
my $max_port_name = 0;
|
||||
my $min_sleep = 60;
|
||||
my $max_sleep = 120;
|
||||
my $if_state = "unset";
|
||||
my $fail_msg = "";
|
||||
my $manual_check = 0;
|
||||
my $amt_resets_sofar = 0;
|
||||
my $show_port = undef;
|
||||
my @port_stats = ();
|
||||
my $cmd_log_name = ""; #= "lf_portmod.txt";
|
||||
my $set_speed = "NA";
|
||||
my $wifi_mode = "NA";
|
||||
my $passwd = "NA";
|
||||
my $ssid = "NA";
|
||||
my $ap = "NA";
|
||||
my $eap_identity = "NA";
|
||||
my $eap_passwd = "NA";
|
||||
my $cli_cmd = "";
|
||||
my $log_file = "";
|
||||
my $NOT_FOUND = "-not found-";
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
my $usage = "$0 --port_name {name | number}
|
||||
--cmd { reset }
|
||||
[--manager { network address of LANforge manager} ]
|
||||
[--cli_cmd { lf-cli-command text } ]
|
||||
[--amt_resets { number (0 means forever) } ]
|
||||
[--max_port_name { number } ]
|
||||
[--min_sleep { number (seconds) } ]
|
||||
[--max_sleep { number (seconds) } ]
|
||||
[--load { db-name } ]
|
||||
[--card { card-id } ]
|
||||
[--quiet { level } ]
|
||||
[--set_ifstate {up | down} ]
|
||||
[--show_port [key,key,key]]
|
||||
# show all port stats or just those matching /key:value/
|
||||
[--set_speed {wifi port speed, see GUI port-modify drop-down for possible values. Common
|
||||
examples: 'OS Defaults', '6 Mbps a/g', '1 Stream /n', '2 Streams /n', MCS-0 (x1 15 M), MCS-10 (x2 90 M),
|
||||
'v-MCS-0 (x1 32.5 M)', 'v-1 Stream /AC', 'v-2 Streams /AC', ... }
|
||||
[--wifi_mode {wifi mode: 0: AUTO, 1: 802.11a, 2: b, 3: g, 4: abg, 5: abgn,
|
||||
6: bgn 7: bg, 8: abgnAC, 9 anAC, 10 an}
|
||||
# wifi-mode option is applied when --set_speed is used.
|
||||
[--passwd {WiFi WPA/WPA2/ password}
|
||||
[--ssid {WiFi SSID}
|
||||
[--ap {BSSID of AP, or 'DEFAULT' for any.}
|
||||
[--eap_identity {value|[BLANK]}]
|
||||
[--eap_passwd {value|[BLANK]}]
|
||||
[--log_file {value}] # disabled by default
|
||||
|
||||
Examples:
|
||||
./lf_portmod.pl --manager 192.168.1.101 --card 1 --port_name eth2 --show_port
|
||||
./lf_portmod.pl --manager 192.168.1.101 --card 1 --port_name sta1 --show_port AP,ESSID,bps_rx,bps_tx
|
||||
./lf_portmod.pl --manager 192.168.1.101 --cli_cmd \"scan 1 1 sta0\"
|
||||
./lf_portmod.pl --manager 192.168.1.101 --card 1 --port_name eth2 --cmd reset
|
||||
./lf_portmod.pl --manager 192.168.1.101 --card 1 --port_name eth2 --set_ifstate down
|
||||
./lf_portmod.pl --manager 192.168.1.101 --card 1 --port_name eth2 --wifi_mode 2 --set_speed \"1 Mbps /b\" \\
|
||||
--ssid fast-ap --passwd \"secret passwd\" --ap DEFAULT
|
||||
./lf_portmod.pl --load my_db
|
||||
./lf_portmod.pl --manager 192.168.100.138 --cmd reset --port_name 2 --amt_resets 5 --max_port_name 8 --card 1 --min_sleep 10 --max_sleep 20
|
||||
./lf_portmod.pl --manager 192.168.1.101 --card 1 --port_name sta11 --cmd set_wifi_extra --eap_identity 'adams' --eap_passwd 'family'
|
||||
";
|
||||
|
||||
my $i = 0;
|
||||
my $log_cli = 'unset';
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'ap=s' => \$ap,
|
||||
'port_name|e=s' => \$port_name,
|
||||
'cmd|c=s' => \$cmd,
|
||||
'cli_cmd|i=s' => \$cli_cmd,
|
||||
'manager|m=s' => \$lfmgr_host,
|
||||
'load|L=s' => \$load,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'card|C=i' => \$card,
|
||||
'amt_resets=i' => \$amt_resets,
|
||||
'max_port_name=i' => \$max_port_name,
|
||||
'min_sleep=i' => \$min_sleep,
|
||||
'max_sleep=i' => \$max_sleep,
|
||||
'passwd=s' => \$passwd,
|
||||
'set_ifstate|s=s' => \$if_state,
|
||||
'set_speed=s' => \$set_speed,
|
||||
'ssid=s' => \$ssid,
|
||||
'show_port:s' => \$show_port,
|
||||
'port_stats=s{1,}' => \@port_stats,
|
||||
'eap_identity|i=s' => \$eap_identity,
|
||||
'eap_passwd|p=s' => \$eap_passwd,
|
||||
'log_file|l=s' => \$log_file,
|
||||
'log_cli=s{0,1}' => \$log_cli,
|
||||
'wifi_mode=i' => \$wifi_mode,
|
||||
) || (print($usage) && exit(1));
|
||||
|
||||
if ($::quiet eq "0") {
|
||||
$::quiet = "no";
|
||||
}
|
||||
elsif ($::quiet eq "1") {
|
||||
$::quiet = "yes";
|
||||
}
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
if (defined $log_cli) {
|
||||
if ($log_cli ne "unset") {
|
||||
# here is how we reset the variable if it was used as a flag
|
||||
if ($log_cli eq "") {
|
||||
$ENV{'LOG_CLI'} = 1;
|
||||
}
|
||||
else {
|
||||
$ENV{'LOG_CLI'} = $log_cli;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
$::utils->telnet($t);
|
||||
if ($::utils->isQuiet()) {
|
||||
if (defined $ENV{'LOG_CLI'} && $ENV{'LOG_CLI'} ne "") {
|
||||
$::utils->cli_send_silent(0);
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(1); # Do not show input to telnet
|
||||
}
|
||||
$::utils->cli_rcv_silent(1); # Repress output from telnet
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(0); # Show input to telnet
|
||||
$::utils->cli_rcv_silent(0); # Show output from telnet
|
||||
}
|
||||
$::utils->log_cli("# $0 ".`date "+%Y-%m-%d %H:%M:%S"`);
|
||||
if (defined $log_file && ($log_file ne "")) {
|
||||
open(CMD_LOG, ">$log_file") or die("Can't open $log_file for writing...\n");
|
||||
$cmd_log_name = $log_file;
|
||||
if (!$::utils->isQuiet()) {
|
||||
print "History of all commands can be found in $log_file\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# please use utils->fmt_cmd nowadays
|
||||
sub fmt_cmd {
|
||||
my $rv;
|
||||
if ($::utils->can('fmt_cmd')) {
|
||||
$rv = $::utils->fmt_cmd(@_);
|
||||
return $rv;
|
||||
}
|
||||
|
||||
for my $hunk (@_) {
|
||||
die("fmt_cmd called with empty space or null argument.") unless(defined $hunk && $hunk ne '');
|
||||
die("rv[${rv}]\n --> fmt_cmd passed an array. Please pass strings.") if(ref($hunk) eq 'ARRAY');
|
||||
die("rv[${rv}]\n --> fmt_cmd passed a hash. Please pass strings.") if(ref($hunk) eq 'HASH');
|
||||
$hunk = "0" if($hunk eq "0" || $hunk eq "+0");
|
||||
|
||||
if( $hunk eq "" ) {
|
||||
$hunk = 'NA';
|
||||
}
|
||||
$rv .= ( $hunk =~m/ +/) ? "'$hunk' " : "$hunk ";
|
||||
}
|
||||
chomp $rv;
|
||||
return $rv;
|
||||
}
|
||||
|
||||
|
||||
sub fmt_port_up_down {
|
||||
my ($resource, $port_id, $state) = @_;
|
||||
|
||||
my $cur_flags = 0;
|
||||
if ($state eq "down") {
|
||||
$cur_flags |= 0x1; # port down
|
||||
}
|
||||
|
||||
# Specify the interest flags so LANforge knows which flag bits to pay attention to.
|
||||
my $ist_flags = 0;
|
||||
$ist_flags |= 0x2; # check current flags
|
||||
$ist_flags |= 0x800000; # port down
|
||||
|
||||
my $cmd = $::utils->fmt_cmd("set_port", 1, $resource, $port_id, "NA",
|
||||
"NA", "NA", "NA", "$cur_flags",
|
||||
"NA", "NA", "NA", "NA", "$ist_flags");
|
||||
return $cmd;
|
||||
}
|
||||
|
||||
sub fmt_wifi_extra {
|
||||
my ($resource, $port_id, $eap_id, $eap_passwd) = @_;
|
||||
my $cmd = $::utils->fmt_cmd("set_wifi_extra", 1, $resource, $port_id,
|
||||
"NA", # key_mgmt Key management: WPA-PSK, WPA-EAP, IEEE8021X, NONE, WPA-PSK-SHA256, WPA-EAP-SHA256 or combo.
|
||||
"NA", # pairwise Pairwise ciphers: CCMP, TKIP, NONE, or combination.
|
||||
"NA", # group Group cyphers: CCMP, TKIP, WEP104, WEP40, or combination.
|
||||
"NA", # psk WPA pre-shared key.
|
||||
"NA", # key WEP key0. Should enter this in ascii-hex.
|
||||
"NA", # ca_cert CA-CERT file name.
|
||||
"NA", # eap EAP method: MD5, MSCHAPV2, OTP, GTC, TLS, PEAP, TTLS.
|
||||
"$eap_id", # identity EAP Identity string.
|
||||
"NA", # anonymous_identity Anonymous identity string for EAP.
|
||||
"NA", # phase1 Outer-authentication, ie TLS tunnel parameters.
|
||||
"NA", # phase2 Inner authentication with TLS tunnel.
|
||||
"$eap_passwd", # password EAP Password string.
|
||||
"NA", # pin EAP-SIM pin string. (For AP, this field is HS20 Operating Class)
|
||||
"NA", # pac_file EAP-FAST PAC-File name. (For AP, this field is the RADIUS secret password)
|
||||
"NA", # private_key EAP private key certificate file name. (For AP, this field is HS20 WAN Metrics)
|
||||
"NA", # pk_passwd EAP private key password. (For AP, this field is HS20 connection capability)
|
||||
"NA", # hessid 802.11u HESSID (MAC address format).
|
||||
"NA", # realm 802.11u realm: mytelco.com
|
||||
"NA", # client_cert 802.11u Client cert file /etc/wpa_supplicant/ca.pem
|
||||
"NA", # imsi 802.11u IMSI: 310026-000000000
|
||||
"NA", # milenage 802.11u milenage: 90dca4eda45b53cf0f12d7c9c3bc6a89:cb9cccc4b9258e6dca4760379fb82
|
||||
"NA", # domain 802.11u domain: mytelco.com
|
||||
"NA", # roaming_consortium 802.11u roaming consortium: 223344 (15 characters max)
|
||||
"NA", # venue_group 802.11u Venue Group, integer. VAP only.
|
||||
"NA", # venue_type 802.11u Venue Type, integer. VAP only.
|
||||
"NA", # network_type 802.11u network type, integer, VAP only.*
|
||||
"NA", # ipaddr_type_avail 802.11u network type available, integer, VAP only.
|
||||
"NA", # network_auth_type 802.11u network authentication type, VAP only.
|
||||
"NA" # anqp_3gpp_cell_net 802.11u 3GCPP Cellular Network Info, VAP only.
|
||||
);
|
||||
return $cmd;
|
||||
}
|
||||
|
||||
# $utils->doCmd("log_level 63");
|
||||
|
||||
if ($cli_cmd ne "") {
|
||||
my @rslt = $utils->doAsyncCmd($cli_cmd);
|
||||
if (!$utils->isQuiet()) {
|
||||
print @rslt;
|
||||
print "\n";
|
||||
}
|
||||
close(CMD_LOG);
|
||||
exit(0);
|
||||
}
|
||||
|
||||
if ($load ne "") {
|
||||
$cli_cmd = "load $load overwrite";
|
||||
$utils->doCmd($cli_cmd);
|
||||
my @rslt = $t->waitfor("/LOAD-DB: Load attempt has been completed./");
|
||||
if (!$utils->isQuiet()) {
|
||||
print @rslt;
|
||||
print "\n";
|
||||
}
|
||||
close(CMD_LOG);
|
||||
exit(0);
|
||||
}
|
||||
|
||||
if (length($port_name) == 0) {
|
||||
print "ERROR: Must specify port name.\n";
|
||||
die("$usage");
|
||||
}
|
||||
|
||||
# this is the --show_port options ("")
|
||||
if ((defined $show_port) && ("$show_port" eq "")) {
|
||||
print $utils->doAsyncCmd("nc_show_port 1 $card $port_name") . "\n";
|
||||
exit(0);
|
||||
}
|
||||
# this is the --show_port "ssss" options (key,key,key)
|
||||
elsif((defined $show_port) && ("$show_port" ne "")) {
|
||||
my %option_map = ();
|
||||
my $option = '';
|
||||
for $option (split(',', $show_port)) {
|
||||
#print "preprare option_map.$option to ''\n";
|
||||
$option="DNS-Servers" if ($option eq "DNS Servers");
|
||||
$option="TX-Queue-Len" if ($option eq "TX Queue Len");
|
||||
$option="Missed-Beacons" if ($option eq "Missed Beacons");
|
||||
$option_map{ $option } = '';
|
||||
}
|
||||
my $i;
|
||||
my @lines = split("\n", $utils->doAsyncCmd("nc_show_port 1 $card $port_name"));
|
||||
|
||||
# trick here is to place a ; before anything that looks like a keyword
|
||||
for($i=0; $i<@lines; $i++) {
|
||||
$lines[$i] = " ".$lines[$i]." ;";
|
||||
$lines[$i] =~ s/ (dbm|[kmg]?bps)/$1/ig;
|
||||
$lines[$i] =~ s/DNS Servers/DNS-Servers/ig;
|
||||
$lines[$i] =~ s/TX Queue Len/TX-Queue-Len/ig;
|
||||
$lines[$i] =~ s/Missed Beacons/Missed-Beacons/ig;
|
||||
$lines[$i] =~ s/([^ :]+\: +)/;$1/g;
|
||||
$lines[$i] =~ s/^\s+;?//;
|
||||
#print "$i: ".$lines[$i]."\n";
|
||||
}
|
||||
my $matcher = "(".join('|', keys %option_map).")";
|
||||
#print "MATCHER: $matcher\n";
|
||||
my @matches = grep( /$matcher/, @lines);
|
||||
for my $match (@matches) {
|
||||
my @parts = split(/\s*;/, $match);
|
||||
shift(@parts) if (@parts > 1 && $parts[0] =~ /^\s+$/);
|
||||
for (my $i=0; $i <= $#parts; $i++) {
|
||||
my $option= "";
|
||||
my $value = "";
|
||||
($option) = $parts[$i] =~ /^\s*(.*?):/;
|
||||
($value) = $parts[$i] =~ /:(.*)$/;
|
||||
$option =~ s/^\s*(.*?)\s*$/$1/;
|
||||
if ($value =~ /^\s*$/) {
|
||||
$value = "";
|
||||
}
|
||||
else {
|
||||
$value =~ s/^\s*(.*?)\s*$/$1/
|
||||
}
|
||||
next if (!defined $option || $option eq "");
|
||||
|
||||
if ( defined $option && defined $option_map{ $option } ) {
|
||||
|
||||
if ( $option eq "Missed-Beacons"
|
||||
|| $option eq "Rx-Invalid-CRYPT"
|
||||
|| $option eq "Rx-Invalid-MISC"
|
||||
|| $option eq "Tx-Excessive-Retry" )
|
||||
{
|
||||
$match =~ s/\s*;/; /g;
|
||||
$value = $match;
|
||||
$value =~ s/${option}:\s*;//;
|
||||
}
|
||||
$option_map{$option} = $value;
|
||||
}
|
||||
}
|
||||
}
|
||||
for $option ( sort keys %option_map ) {
|
||||
@matches = grep { /$option:/ } @lines;
|
||||
if (@matches < 1) {
|
||||
print STDERR "$option $NOT_FOUND\n";
|
||||
}
|
||||
else {
|
||||
print $option.": ".$option_map{ $option }."\n";
|
||||
}
|
||||
}
|
||||
exit(0);
|
||||
}
|
||||
|
||||
if ($if_state ne "unset") {
|
||||
if ($if_state eq "up" || $if_state eq "down") {
|
||||
$cli_cmd = fmt_port_up_down($card, $port_name, $if_state);
|
||||
$utils->doCmd($cli_cmd);
|
||||
exit(0);
|
||||
}
|
||||
else {
|
||||
print "ERROR: ifstate must be 'up' or 'down', value was: $if_state.\n";
|
||||
exit (1);
|
||||
}
|
||||
}
|
||||
|
||||
if ($set_speed ne "NA" || $ssid ne "NA" || $passwd ne "NA" || $ap ne "NA") {
|
||||
$cli_cmd = "add_vsta 1 $card NA $port_name NA '$ssid' NA '$passwd' '$ap' NA NA $wifi_mode '$set_speed'";
|
||||
$utils->doCmd($cli_cmd);
|
||||
}
|
||||
|
||||
if ($eap_identity ne "NA" || $eap_passwd ne "NA") {
|
||||
my $cli_cmd = fmt_wifi_extra( $card, $port_name, "$eap_identity", "$eap_passwd");
|
||||
$utils->doCmd($cli_cmd);
|
||||
}
|
||||
|
||||
if ($cmd eq "reset") {
|
||||
my $pn_int = -1;
|
||||
if ($port_name =~ /^\d+$/ ) {
|
||||
$pn_int = int($port_name);
|
||||
}
|
||||
while (1) {
|
||||
my $pname = $port_name;
|
||||
if (($pn_int > 0) && ($pn_int < $max_port_name)) {
|
||||
$pname = $pn_int + int(rand($max_port_name - $pn_int));
|
||||
}
|
||||
print("Resetting port: ${shelf_num}.${card}.${pname}\n");
|
||||
$cli_cmd = "reset_port $shelf_num $card $pname";
|
||||
$utils->doCmd($cli_cmd);
|
||||
$amt_resets_sofar++;
|
||||
if ($amt_resets != 0) {
|
||||
if ($amt_resets_sofar >= $amt_resets) {
|
||||
print("Completed: $amt_resets_sofar resets, exiting.\n");
|
||||
close(CMD_LOG);
|
||||
exit(0);
|
||||
}
|
||||
}
|
||||
my $sleep_time = $min_sleep;
|
||||
if ($min_sleep < $max_sleep) {
|
||||
$sleep_time += int(rand($max_sleep - $min_sleep));
|
||||
}
|
||||
if ($sleep_time > 0) {
|
||||
print("Sleeping for: $sleep_time seconds before next reset.\n");
|
||||
sleep($sleep_time);
|
||||
}
|
||||
}#while
|
||||
}
|
||||
|
||||
close(CMD_LOG);
|
||||
exit(0);
|
||||
83
lf_show_events.pl
Executable file
83
lf_show_events.pl
Executable file
@@ -0,0 +1,83 @@
|
||||
#!/usr/bin/perl -w
|
||||
# This program is used to create a hunt-script
|
||||
# # used for matrix load emulation on LANforge
|
||||
# # (C) Candela Technologies 2015
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
#use Carp;
|
||||
#$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
use lib '/home/lanforge/scripts';
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
#our $resource = 1;
|
||||
our $quiet = "yes";
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
our $do_clear = 0;
|
||||
our $do_alerts = 0;
|
||||
# ########################################################################
|
||||
# # Nothing to configure below here, most likely.
|
||||
# ########################################################################
|
||||
our $usage = qq($0 ...
|
||||
[--mgr {host-name | IP}]
|
||||
[--mgr_port {ip port}]
|
||||
[--resource {number}]
|
||||
[--quiet { yes | no }]
|
||||
[--clear] # or -c; clear events. Alerts cannot be cleared.
|
||||
[--alerts] # or -a; show alerts instead of events
|
||||
);
|
||||
my $i = 0;
|
||||
my $cmd;
|
||||
die($::usage) if (@ARGV < 2);
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port|p=i' => \$::lfmgr_port,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'alerts|a' => \$::do_alerts,
|
||||
'clear|c' => \$::do_clear,
|
||||
) || die("$::usage");
|
||||
|
||||
my $utils = new LANforge::Utils();
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
$t->open( Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
$utils->telnet($t);
|
||||
if ($quiet eq "yes") {
|
||||
$utils->cli_send_silent(1);
|
||||
$utils->cli_rcv_silent(1);
|
||||
}
|
||||
else {
|
||||
$utils->cli_send_silent(0);
|
||||
$utils->cli_rcv_silent(0);
|
||||
}
|
||||
|
||||
if ($do_alerts) {
|
||||
print $utils->doAsyncCmd("show_alerts");
|
||||
}
|
||||
else {
|
||||
print $utils->doAsyncCmd("show_events");
|
||||
}
|
||||
print "\n";
|
||||
|
||||
if ($do_clear) {
|
||||
$utils->doAsyncCmd("rm_event all");
|
||||
}
|
||||
|
||||
exit(0);
|
||||
#
|
||||
190
lf_sta_name.pl
Executable file
190
lf_sta_name.pl
Executable file
@@ -0,0 +1,190 @@
|
||||
#!/usr/bin/perl -w
|
||||
#
|
||||
# This program is used to modify the LANforge virtual station aliases
|
||||
#
|
||||
# (C) 2016 Candela Technologies Inc.
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
use Carp;
|
||||
$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use lib '/home/lanforge/scripts';
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
our $shelf_num = 1;
|
||||
our $resource = 1;
|
||||
our $quiet = "yes";
|
||||
our $do_cmd = "NA";
|
||||
our $lfmgr_host = "localhost";
|
||||
our $lfmgr_port = 4001;
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
our $usage = qq<
|
||||
$0 --action { set_alias | reset_alias } ]
|
||||
[--mgr {host-name | IP} default: $::lfmgr_host]
|
||||
[--resource {lanforge resource id}]
|
||||
[--mgr_port {ip port}]
|
||||
|
||||
[--first_dev {actual device name with suffix number}]
|
||||
[--last_dev {actual device name with suffix number}]
|
||||
[--new_prefix {phrase to replace 'sta' with}]
|
||||
[--old_prefix {old prefix}]
|
||||
[--quiet { yes | no }]
|
||||
# spaces and punctuation are prohibitied in aliases!
|
||||
|
||||
Examples:
|
||||
# alias sta100-sta149 as truck100-truck149
|
||||
$0 --mgr 192.168.100.138 --action set_alias --first_dev sta100 --last_dev sta149 --new_prefix truck
|
||||
|
||||
# reset truck* stations to original sta* names
|
||||
$0 --mgr 192.168.100.138 --action reset_alias --old_prefix truck
|
||||
|
||||
# reset a series of station aliases to original names
|
||||
$0 --mgr 192.168.100.138 --action reset_alias --first_sta truck100 --last_sta truck110
|
||||
>;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'action|a=s' => \$::action,
|
||||
'cmd|c=s' => \$::do_cmd,
|
||||
'mgr|m=s' => \$::lfmgr_host,
|
||||
'mgr_port|p=i' => \$::lfmgr_port,
|
||||
'resource|r=i' => \$::resource,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'new_prefix=s' => \$::new_prefix,
|
||||
'old_prefix=s' => \$::old_prefix,
|
||||
'first_dev=s' => \$::first_dev,
|
||||
'last_dev=s' => \$::last_dev,
|
||||
) || (print($usage) && exit(1));
|
||||
|
||||
die ("Please specify manager address. $::usage")
|
||||
if (!defined $::lfmgr_host || "$::lfmgr_host" eq "" );
|
||||
|
||||
die ("Please specify resource id. $::usage")
|
||||
if (!defined $::resource || "$::resource" eq "" );
|
||||
|
||||
die ("Please tell me what to do with --action. " )
|
||||
if (!defined $::action || "$::action" eq "");
|
||||
|
||||
if ($::action eq "set_alias" ) {
|
||||
die( "Please specify the first station device. $::usage")
|
||||
if (!defined $::first_dev || "$::first_dev" eq "" );
|
||||
die( "Please specify the last station device. $::usage")
|
||||
if (!defined $::last_dev || "$::last_dev" eq "" );
|
||||
die( "Please specify the new prefix. $::usage")
|
||||
if (!defined $::new_prefix || "$::new_prefix" eq "" );
|
||||
}
|
||||
elsif ($::action eq "reset_alias" && !defined $::first_dev) {
|
||||
die( "Please specify the old prefix. $::usage")
|
||||
if (!defined $::old_prefix || "$::old_prefix" eq "");
|
||||
}
|
||||
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
our $telnet = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
|
||||
$::telnet->open( Host => $::lfmgr_host,
|
||||
Port => $::lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$::telnet->waitfor("/btbits\>\>/");
|
||||
|
||||
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
$::utils->telnet($::telnet); # Set our telnet object.
|
||||
if ($::quiet eq "yes") {
|
||||
$::utils->cli_send_silent(1); # Do show input to CLI
|
||||
$::utils->cli_rcv_silent(1); # Repress output from CLI ??
|
||||
}
|
||||
else {
|
||||
$utils->cli_send_silent(0); # Do show input to CLI
|
||||
$utils->cli_rcv_silent(0); # Repress output from CLI ??
|
||||
}
|
||||
|
||||
my $in_bounds = 0;
|
||||
my @port_names = ();
|
||||
my @sorted_names;
|
||||
my @matching_devices = ();
|
||||
my %port_map = ();
|
||||
my $port_name;
|
||||
my $port;
|
||||
my $cmd;
|
||||
my $alias;
|
||||
my @ports;
|
||||
if ($::action eq "set_alias" || $::action eq "reset_alias") {
|
||||
@ports = $::utils->getPortListing($::shelf_num, $::resource);
|
||||
}
|
||||
else {
|
||||
die("Actions are set_alias and reset_alias.");
|
||||
}
|
||||
|
||||
for (my $i = 0; $i<@ports; $i++) {
|
||||
$port_name = $ports[$i]->dev();
|
||||
push(@port_names, $port_name);
|
||||
$port_map{ $port_name } = $i;
|
||||
}
|
||||
@sorted_names = sort { lc($a) cmp lc($b) } @port_names;
|
||||
for $port_name (@sorted_names) {
|
||||
my $i = $port_map{ $port_name };
|
||||
$port = $ports[ $i ];
|
||||
$alias = $port->alias();
|
||||
if (defined $::first_dev && defined $::last_dev) {
|
||||
if ($port_name eq $::first_dev || $alias eq $::first_dev) {
|
||||
$in_bounds = 1;
|
||||
}
|
||||
if ($in_bounds) {
|
||||
push(@matching_devices, $port);
|
||||
}
|
||||
if ($port_name eq $::last_dev || $alias eq $::last_dev) {
|
||||
$in_bounds = 0;
|
||||
}
|
||||
}
|
||||
if (defined $::old_prefix && "$::old_prefix" ne "") {
|
||||
print "\nchecking $port_name ($alias)" if ($quiet eq "no");
|
||||
if ($alias =~ /^$::old_prefix\d+/) {
|
||||
print "* " if ($quiet eq "no");
|
||||
push(@matching_devices, $port);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
## Note that alias is for mvlans, nothing will be found #
|
||||
## $cmd = $::utils->fmt_cmd("set_port_alias", $::shelf_num, #
|
||||
## $::resource, $parname, $mac, $alias); #
|
||||
## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
|
||||
for $port (@matching_devices) {
|
||||
$port_name = $port->dev();
|
||||
my $portno = $port->port_id();
|
||||
my ($suffix) = $port_name =~/^.*?(\d+)$/;
|
||||
|
||||
if ($::action eq "set_alias" ) {
|
||||
$alias = "$::new_prefix$suffix";
|
||||
}
|
||||
else {
|
||||
$alias = $port->dev();
|
||||
}
|
||||
# set_port shelf resource port ip_addr netmask gateway
|
||||
# cmd_flags current_flags MAC MTU tx_queue_len alias interest
|
||||
$cmd = $::utils->fmt_cmd("set_port", $::shelf_num, $::resource, $portno,
|
||||
"NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA",
|
||||
$alias, 0x1000);
|
||||
$::utils->doCmd($cmd);
|
||||
}
|
||||
|
||||
#
|
||||
299
lf_staggered_dl.sh
Executable file
299
lf_staggered_dl.sh
Executable file
@@ -0,0 +1,299 @@
|
||||
#!/bin/bash
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
# This script starts a series of Layer-3 connections across a series of stations #
|
||||
# each station will wait $nap seconds, download $quantity KB and then remove #
|
||||
# its old CX. #
|
||||
# #
|
||||
# INSTALL #
|
||||
# Copy this script to to /home/lanforge/scripts/lf_staggered_dl.sh #
|
||||
# If you are copying this via DOS/Windows, follow these steps: #
|
||||
# 1) copy using samba or pscp or winscp or whatever this script to #
|
||||
# /home/lanforge/scripts/lf_staggered_dl.sh #
|
||||
# 2) in a terminal on the LANforge, run dos2unix and #
|
||||
# $ cd /home/lanforge/sripts #
|
||||
# $ dos2unix lf_staggered_dl.sh #
|
||||
# 3) make the script executable: #
|
||||
# $ chmod a+x lf_staggered_dl.sh #
|
||||
# #
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
# . lanforge.profile
|
||||
[ ! -f lf_firemod.pl ] && echo "Unable to find lf_firemod.pl." && exit 1
|
||||
|
||||
#set -e
|
||||
q="'"
|
||||
Q='"'
|
||||
manager=localhost # :m
|
||||
resource=1 # :m
|
||||
first_sta= # :f
|
||||
upstream=x # :u
|
||||
last_sta=x # :l
|
||||
num_sta=x # :n
|
||||
naptime=x # :z
|
||||
payload_kb=x # :s
|
||||
tx_rate=x # :t
|
||||
check_naptime=1.0 # seconds between lf_firemod check on endpoint stats
|
||||
timer=1000 # report timer
|
||||
|
||||
|
||||
function term_procs() {
|
||||
echo -en "\nCleaning up background tasks: ";
|
||||
for pid in "${childprocs[@]}"; do
|
||||
echo -n "$pid, "
|
||||
kill -9 $pid &>/dev/null || true
|
||||
done
|
||||
echo " done"
|
||||
}
|
||||
trap term_procs EXIT
|
||||
|
||||
function usage() {
|
||||
cat <<__EOF__
|
||||
${0}: starts a series of layer-3 connections and makes each start
|
||||
downloading a fixed amount of data after a naptime.
|
||||
-m # lanforge manager (defaults to localhost)
|
||||
-r # lanforge resource (defaults to 1)
|
||||
-f # first station/port
|
||||
-n # number of stations/ports
|
||||
-z # naptime before beginning download
|
||||
-u # upstream port that will transmit
|
||||
-t # transmit bps
|
||||
-p # payload size in KB
|
||||
|
||||
Example: # 20 stations (sta100-sta120) nap 3 seconds before downloading 200KB
|
||||
${0} -m 192.168.1.101 -r 1 -f sta100 -n 20 -z 3 -u eth1 -p 250 -t 1500000
|
||||
|
||||
__EOF__
|
||||
}
|
||||
|
||||
while getopts ":f:m:n:p:r:t:u:z:" opt; do
|
||||
case "${opt}" in
|
||||
f)
|
||||
first_sta="${OPTARG}"
|
||||
;;
|
||||
m)
|
||||
manager="${OPTARG}"
|
||||
;;
|
||||
n)
|
||||
num_sta="${OPTARG}"
|
||||
;;
|
||||
p)
|
||||
payload_kb="${OPTARG}"
|
||||
;;
|
||||
r)
|
||||
resource="${OPTARG}"
|
||||
;;
|
||||
t)
|
||||
tx_rate="${OPTARG}"
|
||||
;;
|
||||
u)
|
||||
upstream="${OPTARG}"
|
||||
;;
|
||||
z)
|
||||
naptime="${OPTARG}"
|
||||
;;
|
||||
*)
|
||||
usage
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
done
|
||||
shift $(( OPTIND - 1 ));
|
||||
|
||||
[ -z "$manager" -o "$manager" == x ] \
|
||||
&& echo "Please specify LANforge manager ip or hostname." && usage && exit 1
|
||||
|
||||
[ -z "$resource" -o "$resource" == x ] \
|
||||
&& echo "Please specify LANforge resource for stations." && usage && exit 1
|
||||
|
||||
[ -z "$first_sta" -o "$first_sta" == x ] \
|
||||
&& echo "Please specify first station or port in series to download " && usage && exit 1
|
||||
|
||||
[ -z "$num_sta" -o "$num_sta" == x ] \
|
||||
&& echo "Please specify number of stations to put connections on." && usage && exit 1
|
||||
|
||||
[ -z "$naptime" -o "$naptime" == x ] \
|
||||
&& echo "Please specify number of seconds to wait before transmitting." && usage && exit 1
|
||||
|
||||
[ -z "$payload_kb" -o "$payload_kb" == x ] \
|
||||
&& echo "Please specify kilobytes to transfer per connection." && usage && exit 1
|
||||
|
||||
[ -z "$upstream" -o "$upstream" == x ] \
|
||||
&& echo "Please specify upstream port to transmit from" && usage && exit 1
|
||||
|
||||
[ -z "$tx_rate" -o "$tx_rate" == x ] \
|
||||
&& echo "Please specify transmit rate in bps" && usage && exit 1
|
||||
|
||||
declare -a childprocs
|
||||
declare -a stations
|
||||
declare -a cx_names
|
||||
declare -a cx_create_endp
|
||||
declare -a cx_create_cx
|
||||
declare -a cx_mod_endp
|
||||
declare -a cx_start_cx
|
||||
declare -a cx_started
|
||||
declare -a cx_finished
|
||||
declare -a cx_destroy_cx
|
||||
declare -A map_destroy_cx
|
||||
|
||||
sta_pref=${first_sta//[0-9]/}
|
||||
sta_start=${first_sta//[A-Za-z]/}
|
||||
[ -z "$sta_pref" ] && echo "Unable to determine beginning station prefix" && exit 1
|
||||
[ -z "$sta_start" -o $sta_start -lt 0 ] && echo "Unable to determine beginning station number." && exit 1
|
||||
[ $num_sta -lt 1 ] && echo "Unable to deterine number of stations to create." && exit 1
|
||||
|
||||
packets=$(( 1 + $(( $payload_kb * 1000 / 1460 )) ))
|
||||
[ -z "$packets" -o $packets -lt 2 ] && echo "Unable to calculate packets for transfer." && exit 1
|
||||
# 111 is a trick number that we'll truncate to three digits later
|
||||
|
||||
expon=`echo "111 * 10^${#sta_start}" | bc -l`
|
||||
counter=$(( expon + $sta_start ))
|
||||
limit=$(( expon + $sta_start + $num_sta -1 ))
|
||||
for i in `seq $counter $limit` ; do
|
||||
stations+=("${sta_pref}${counter#111}")
|
||||
cx_names+=("c-${upstream}-${sta_pref}${counter#111}");
|
||||
counter=$(( counter + 1 ))
|
||||
done
|
||||
_act="./lf_firemod.pl --mgr $manager --resource $resource --quiet yes --action"
|
||||
_cmd="./lf_firemod.pl --mgr $manager --resource $resource --quiet yes --cmd"
|
||||
counter=0
|
||||
for cx in "${cx_names[@]}"; do
|
||||
cx_create_endp+=("$_act create_endp --endp_name ${cx}-A --speed $tx_rate --endp_type lf_tcp --port_name ${upstream} --report_timer $timer")
|
||||
cx_create_endp+=("sleep 0.1")
|
||||
cx_create_endp+=("$_act create_endp --endp_name ${cx}-B --speed 0 --endp_type lf_tcp --port_name ${stations[$counter]} --report_timer $timer")
|
||||
cx_create_endp+=("sleep 0.1")
|
||||
|
||||
cx_create_cx+=("$_act create_cx --cx_name ${cx} --cx_endps ${cx}-A,${cx}-B --report_timer $timer")
|
||||
cx_create_cx+=("sleep 0.2")
|
||||
|
||||
cx_mod_endp+=("${cx}-A NA NA NA ${packets}")
|
||||
|
||||
nap=$(( $naptime * $counter ))
|
||||
|
||||
cx_start_cx+=("sleep $nap; $_cmd ${Q}set_cx_state all ${cx} RUNNING${Q} &>/dev/null")
|
||||
|
||||
cx_destroy_cx+=("$_act delete_cx --cx_name ${cx}")
|
||||
cx_destroy_cx+=("sleep 0.1")
|
||||
cx_destroy_cx+=("$_act delete_endp --endp_name ${cx}-A")
|
||||
cx_destroy_cx+=("$_act delete_endp --endp_name ${cx}-B")
|
||||
cx_destroy_cx+=("sleep 0.1")
|
||||
|
||||
map_destroy_cx[${cx}]="$_act delete_cx --cx_name ${cx}; sleep 0.1; $_act delete_endp --endp_name ${cx}-A; $_act delete_endp --endp_name ${cx}-B";
|
||||
counter=$(( counter + 1 ))
|
||||
done
|
||||
echo -n "Removing previous connections..."
|
||||
for command in "${cx_destroy_cx[@]}" ; do
|
||||
$command
|
||||
done
|
||||
sleep 1
|
||||
|
||||
echo "done"
|
||||
|
||||
echo -n "Creating new endpoints..."
|
||||
for command in "${cx_create_endp[@]}" ; do
|
||||
$command
|
||||
done
|
||||
echo "done"
|
||||
|
||||
echo -n "Creating new cross connects..."
|
||||
sleep $(( 2 + $(( $counter /2 )) ))
|
||||
for command in "${cx_create_cx[@]}" ; do
|
||||
$command
|
||||
done
|
||||
./lf_firemod.pl --mgr $manager --quiet yes --cmd "nc_show_endp all" > /tmp/ep_count.txt
|
||||
echo "done"
|
||||
|
||||
echo -n "Configuring payload sizes..."
|
||||
outf="/tmp/cmd.$$.txt"
|
||||
for command in "${cx_mod_endp[@]}" ; do
|
||||
result=1
|
||||
rm -f $outf
|
||||
while [ $result -ne 0 ]; do
|
||||
ep=${command%% *}
|
||||
#$_cmd "nc_show_endp $ep"
|
||||
$_cmd "set_endp_details $command" > $outf
|
||||
result=$(awk '/RSLT:/{print $2}' $outf)
|
||||
if [ $result -ne 0 ]; then
|
||||
cat $outf
|
||||
sleep 5
|
||||
fi
|
||||
done
|
||||
#sleep 0.1
|
||||
done
|
||||
echo "done"
|
||||
|
||||
echo -n "Starting staggered transmissions..."
|
||||
sleep $(( 2 + $(( $counter /2 )) ))
|
||||
for command in "${cx_start_cx[@]}" ; do
|
||||
bash -c "$command" &
|
||||
childprocs+=($!)
|
||||
sleep 0.1
|
||||
done
|
||||
echo "done"
|
||||
|
||||
echo "Monitoring staggered downloads for ports:"
|
||||
echo -e "\t${cx_names[@]}"
|
||||
echo "_R_unning _Q_uiesce _N_ot Running (Tx Packets/Requested Packets)"
|
||||
echo "--------------------------------------------------------------"
|
||||
counter=1
|
||||
while [ $counter -ne 0 ]; do
|
||||
messages=()
|
||||
#echo -en ""
|
||||
for cx in "${cx_names[@]}"; do
|
||||
while read L ; do
|
||||
endp_report+=("$L")
|
||||
done < <($_act show_endp --endp_name ${cx}-A)
|
||||
|
||||
state="?"
|
||||
for i in `seq 0 $((${#endp_report[@]}-1))`; do
|
||||
ine="${endp_report[$i]}";
|
||||
h=($ine);
|
||||
case "${ine}" in
|
||||
"Endpoint "*)
|
||||
state="${h[2]:1:-1}"
|
||||
;;
|
||||
"Tx Pkts: "*)
|
||||
txpkts="${h[3]}";
|
||||
;;
|
||||
esac
|
||||
done
|
||||
|
||||
if [[ " ${cx_started[@]} " =~ " ${cx} " ]]; then # can inspect for finishing
|
||||
if [[ ! " ${cx_finished[@]} " =~ " ${cx} " ]]; then
|
||||
if [ ${txpkts} -ge ${packets} -a ${state} = "NOT_RUNNING" ] ; then
|
||||
cx_finished+=(${cx})
|
||||
messages+=("$cx: finished running")
|
||||
cmd=${map_destroy_cx[${cx}]};
|
||||
#messages+=(" CMD[ $cmd ]");
|
||||
bash -c "$cmd"
|
||||
cx_started=(${cx_started[@]/$cx})
|
||||
fi
|
||||
fi
|
||||
elif [[ " ${cx_finished[@]} " =~ " ${cx} " ]]; then
|
||||
:
|
||||
else
|
||||
if [ ${txpkts} -gt 0 ]; then
|
||||
messages+=("$cx: started running")
|
||||
cx_started+=(${cx})
|
||||
fi
|
||||
fi
|
||||
case $state in
|
||||
"RUNNING") st="R";;
|
||||
"NOT_RUNNING") st="N";;
|
||||
"QUIESCE") st="Q";;
|
||||
*)
|
||||
esac
|
||||
echo -en "${cx}: ${st} ${txpkts}/${packets} "
|
||||
done
|
||||
echo ""
|
||||
for m in "${messages[@]}"; do
|
||||
echo -e "\t${m}"
|
||||
done
|
||||
|
||||
# compare the number of finished stations to total number of stations
|
||||
[ ${#cx_finished[@]} -eq ${#cx_names[@]} ] && break;
|
||||
|
||||
sleep $check_naptime
|
||||
done
|
||||
echo "Waiting for background jobs to finish..."
|
||||
wait
|
||||
|
||||
#eof
|
||||
257
lf_stress1.pl
Executable file
257
lf_stress1.pl
Executable file
@@ -0,0 +1,257 @@
|
||||
#!/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.
|
||||
|
||||
# This script sets up connections of types:
|
||||
# lf, lf_udp, lf_tcp, custom_ether, custom_udp, and custom_tcp
|
||||
# across 3 ports on 2 machines.
|
||||
# It then continously starts and stops the connections.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# This sets up connections between 2 LANforge machines
|
||||
my $lf1 = 1;
|
||||
my $lf2 = 2;
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
my @lf1_ports = ( 1, 2, 3 );
|
||||
my @lf2_ports = ( 1, 2, 3 );
|
||||
|
||||
my @lf1_port_ips = ( "172.1.1.2", "172.1.2.2", "172.1.2.200" );
|
||||
my @lf2_port_ips = ( "172.1.1.3", "172.1.2.3", "172.1.2.201" );
|
||||
|
||||
my @lf1_port_gws = ( "172.1.1.1", "172.1.2.1", "172.1.2.1" );
|
||||
my @lf2_port_gws = ( "172.1.1.1", "172.1.2.1", "172.1.2.1" );
|
||||
|
||||
# Set up one CX of each of these types on each port pair.
|
||||
my @cx_types =
|
||||
( "lf", "lf_udp", "lf_tcp", "custom_ether", "custom_udp", "custom_tcp" );
|
||||
my @min_pkt_szs = ( 64, 1, 1, 64, 1, 1 );
|
||||
my @max_pkt_szs = ( 1514, 12000, 13000, 1514, 2048, 2048 );
|
||||
|
||||
my $min_rate = 512000;
|
||||
my $max_rate = 1024000;
|
||||
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 100;
|
||||
my $run_for_time = 120; # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Run for XX seconds..then will be stopped again
|
||||
my $report_timer = 3000; # 3 seconds
|
||||
|
||||
########################################################################
|
||||
# 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\>\>/' );
|
||||
|
||||
$t->open(
|
||||
Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10
|
||||
);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
my $loops = 0;
|
||||
for ( $loop = 0 ; $loop < $loop_max ; $loop++ ) {
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "\n\n***** Starting loop: $loop at: $dt *****\n\n";
|
||||
|
||||
initToDefaults();
|
||||
|
||||
#exit(0);
|
||||
|
||||
# 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();
|
||||
|
||||
my $rl = 0;
|
||||
for ( $rl = 0 ; $rl < $start_stop_iterations ; $rl++ ) {
|
||||
if ( ( $rl % 2 ) == 0 ) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ( $q = 0 ; $q < @cx_names ; $q++ ) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if ( ( $rl % 2 ) == 0 ) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ( $q = 0 ; $q < @cx_names ; $q++ ) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
|
||||
} # For some amount of start_stop iterations...
|
||||
} # for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
sub initPortsToDefault {
|
||||
|
||||
# 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_num $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lf2 $tmp2 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
}
|
||||
|
||||
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_num $lf1 $tmp "
|
||||
. $lf1_port_ips[$i]
|
||||
. " 255.255.255.0 "
|
||||
. $lf1_port_gws[$i]
|
||||
. " NA NA NA";
|
||||
doCmd($cmd);
|
||||
$cmd =
|
||||
"set_port $shelf_num $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";
|
||||
if ( $min_rate != $max_rate ) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ( $min_pkt_szs[$i] != $max_pkt_szs[$i] ) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ( $cx_types[$i] =~ /custom/ ) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "endp-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = ( @endpoint_names, $ep1, $ep2 );
|
||||
|
||||
my $cmd =
|
||||
"add_endp $ep1 $shelf_num $lf1 "
|
||||
. $lf1_ports[$j] . " "
|
||||
. @cx_types[$i]
|
||||
. " -1 $burst $min_rate $max_rate $szrnd "
|
||||
. $min_pkt_szs[$i] . " "
|
||||
. $max_pkt_szs[$i]
|
||||
. " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd =
|
||||
"add_endp $ep2 $shelf_num $lf2 "
|
||||
. $lf2_ports[$j] . " "
|
||||
. @cx_types[$i]
|
||||
. " -1 $burst $min_rate $max_rate $szrnd "
|
||||
. $min_pkt_szs[$i] . " "
|
||||
. $max_pkt_szs[$i]
|
||||
. " $pattern NO";
|
||||
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('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
|
||||
#sleep(1);
|
||||
}
|
||||
234
lf_stress2.pl
Executable file
234
lf_stress2.pl
Executable file
@@ -0,0 +1,234 @@
|
||||
#!/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.
|
||||
|
||||
# This creates a few fast connections between 3 ports on two machines.
|
||||
# It then starts/stops them with a fairly lengthy run between them..
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# This sets up connections between 2 LANforge machines (card 1 and card 2)
|
||||
my $lf1 = 1;
|
||||
my $lf2 = 2;
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
my @lf1_ports = (1, 2, 3);
|
||||
my @lf2_ports = (1, 2, 3);
|
||||
|
||||
my @lf1_port_ips = ("172.1.1.2", "172.1.2.2", "172.1.2.200");
|
||||
my @lf2_port_ips = ("172.1.1.3", "172.1.2.3", "172.1.2.201");
|
||||
|
||||
my @lf1_port_gws = ("172.1.1.1", "172.1.2.1", "172.1.2.1");
|
||||
my @lf2_port_gws = ("172.1.1.1", "172.1.2.1", "172.1.2.1");
|
||||
|
||||
# Set up one CX of each of these types on each port pair.
|
||||
my @cx_types = ("lf_udp", "lf_tcp");
|
||||
my @min_pkt_szs = (8000, 8000);
|
||||
my @max_pkt_szs = (12000, 12000);
|
||||
|
||||
my $min_rate = 10000000;
|
||||
my $max_rate = 10000000;
|
||||
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 100;
|
||||
my $run_for_time = 1200; # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Stop for XX seconds, before running again
|
||||
my $report_timer = 5000; # XX/1000 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# 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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
my $loops = 0;
|
||||
for ($loop = 0; $loop<$loop_max; $loop++) {
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "\n\n***** Starting loop: $loop at: $dt *****\n\n";
|
||||
|
||||
initToDefaults();
|
||||
#exit(0);
|
||||
|
||||
# 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();
|
||||
|
||||
my $rl = 0;
|
||||
for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
|
||||
}# For some amount of start_stop iterations...
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub initPortsToDefault {
|
||||
# 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_num $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lf2 $tmp2 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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_num $lf1 $tmp " . $lf1_port_ips[$i] . " 255.255.255.0 " .
|
||||
$lf1_port_gws[$i] . " NA NA NA";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_port $shelf_num $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";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "endp-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf_num $lf1 " . $lf1_ports[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf_num $lf2 " . $lf2_ports[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
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('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
#sleep(1);
|
||||
}
|
||||
297
lf_stress3.pl
Executable file
297
lf_stress3.pl
Executable file
@@ -0,0 +1,297 @@
|
||||
#!/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.
|
||||
|
||||
# This script is used to test 4 high-end machines. Two of them have
|
||||
# GigE NICs in them, and will be configured to run back-to-back. Two
|
||||
# other machines have a 4-port NIC and 2 single-port NICs. These ports
|
||||
# will be configured to talk to each other..
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
my $lfmgr_host = "lanf3";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $lanf1 = 1;
|
||||
my $lanf2 = 2;
|
||||
my $lanf3 = 3;
|
||||
my $lanf4 = 4;
|
||||
|
||||
my $test_mgr = "whoi";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 100;
|
||||
my $run_for_time = (60 * 60 * 24); # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Stop for XX seconds..then will be started again
|
||||
my $report_timer = 3000; # 3 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# 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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
# Do some thing over and over again...
|
||||
my $loops = 0;
|
||||
for ($loop = 0; $loop<$loop_max; $loop++) {
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "\n\n***** Starting loop: $loop at: $dt *****\n\n";
|
||||
|
||||
# Remove any existing configuration information
|
||||
initToDefaults();
|
||||
|
||||
print " ***Sleeping 8 seconds for ports to initialize to defaults...\n";
|
||||
sleep(8);
|
||||
|
||||
#exit(0);
|
||||
|
||||
# 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();
|
||||
|
||||
print " ***Sleeping 8 seconds for ports to initialize to current values...\n";
|
||||
sleep(8);
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
my $rl = 0;
|
||||
for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
|
||||
}# For some amount of start_stop iterations...
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub initPortsToDefault {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
|
||||
# All have 3 ports
|
||||
for ($i = 1; $i<=3; $i++) {
|
||||
doCmd("set_port $shelf_num $lanf1 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf3 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf4 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
|
||||
# lanf1, lanf3 have 6 ports total...
|
||||
for ($i = 4; $i<=6; $i++) {
|
||||
doCmd("set_port $shelf_num $lanf1 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf3 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub initIpAddresses {
|
||||
# Set all ports we are messing with to known state.
|
||||
|
||||
# Syntax for setting port info is:
|
||||
# set_port [shelf] [card] [port] [ip] [mask] [gateway] [cmd-flags] [cur-flags] [MAC]
|
||||
# NOTE: Just use NA for the flags for now...not tested otherwise.
|
||||
|
||||
# Set up GigE ports, they will talk to each other for now...
|
||||
doCmd("set_port $shelf_num $lanf2 3 172.25.3.2 255.255.255.0 172.25.3.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf4 3 172.25.3.4 255.255.255.0 172.25.3.1 NA NA NA");
|
||||
|
||||
# Set up the 2 10/100 ports on the GigE machines. They will be set up to talk to
|
||||
# each other too.
|
||||
doCmd("set_port $shelf_num $lanf2 1 172.25.7.2 255.255.255.0 172.25.7.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 2 172.25.8.2 255.255.255.0 172.25.8.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf4 1 172.25.7.4 255.255.255.0 172.25.7.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf4 2 172.25.8.4 255.255.255.0 172.25.8.1 NA NA NA");
|
||||
|
||||
|
||||
# Set up the ports NICs on lanf1. They should be connected to an ether-switch that also
|
||||
# connects to the ports on lanf3. These will all be on the same subnet, but LANforge
|
||||
# (Linux, really) magic will make them act as separate machines.
|
||||
|
||||
doCmd("set_port $shelf_num $lanf1 1 172.25.5.2 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf1 2 172.25.5.3 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf1 3 172.25.5.4 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf1 4 172.25.5.5 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf1 5 172.25.5.6 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf1 6 172.25.5.7 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
|
||||
|
||||
# Set up the ports on lanf3
|
||||
|
||||
doCmd("set_port $shelf_num $lanf3 1 172.25.5.102 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf3 2 172.25.5.103 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf3 3 172.25.5.104 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf3 4 172.25.5.105 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf3 5 172.25.5.106 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf3 6 172.25.5.107 255.255.255.0 172.25.5.1 NA NA NA");
|
||||
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
# Syntax for adding an endpoint is:
|
||||
# add_endp [alias] [shelf] [card] [port] [type] [IP-port] [bursty] [min_rate] [max_rate]
|
||||
# [pkt_sz_random] [min_pkt] [max_pkt] [pattern] [use_checksum]
|
||||
|
||||
# Set up first 50Mbps full duplex UDP link on the GigE ports.
|
||||
doCmd("add_endp udp-gig1-TX $shelf_num $lanf4 3 lf_udp -1 NO 50000000 50000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_endp udp-gig1-RX $shelf_num $lanf2 3 lf_udp -1 NO 50000000 50000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_cx udp-gig1 $test_mgr udp-gig1-TX udp-gig1-RX");
|
||||
@endpoint_names = (@endpoint_names, "udp-gig1-TX", "udp-gig1-RX");
|
||||
@cx_names = (@cx_names, "udp-gig1");
|
||||
|
||||
# Set up first 50Mbps full duplex TCP link on the GigE ports.
|
||||
doCmd("add_endp tcp-gig1-TX $shelf_num $lanf4 3 lf_tcp -1 NO 50000000 50000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_endp tcp-gig1-RX $shelf_num $lanf2 3 lf_tcp -1 NO 50000000 50000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_cx tcp-gig1 $test_mgr tcp-gig1-TX tcp-gig1-RX");
|
||||
@endpoint_names = (@endpoint_names, "tcp-gig1-TX", "tcp-gig1-RX");
|
||||
@cx_names = (@cx_names, "tcp-gig1");
|
||||
|
||||
|
||||
# Set up first 50Mbps - 1Mbps asymetric TCP link
|
||||
doCmd("add_endp tcp-gig2-TX $shelf_num $lanf4 3 lf_tcp -1 NO 50000000 50000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_endp tcp-gig2-RX $shelf_num $lanf2 3 lf_tcp -1 NO 10000000 10000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_cx tcp-gig2 $test_mgr tcp-gig2-TX tcp-gig2-RX");
|
||||
@endpoint_names = (@endpoint_names, "tcp-gig2-TX", "tcp-gig2-RX");
|
||||
@cx_names = (@cx_names, "tcp-gig2");
|
||||
|
||||
# Set up second 50Mbps - 1Mbps asymetric TCP link
|
||||
doCmd("add_endp tcp-gig3-TX $shelf_num $lanf4 3 lf_tcp -1 NO 50000000 50000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_endp tcp-gig3-RX $shelf_num $lanf2 3 lf_tcp -1 NO 10000000 10000000 NO 12000 12000 increasing NO");
|
||||
doCmd("add_cx tcp-gig3 $test_mgr tcp-gig3-TX tcp-gig3-RX");
|
||||
@endpoint_names = (@endpoint_names, "tcp-gig3-TX", "tcp-gig3-RX");
|
||||
@cx_names = (@cx_names, "tcp-gig3");
|
||||
|
||||
|
||||
# Set up 6 cross-connects between lanf1 and lanf3
|
||||
my $i = 1;
|
||||
my $tp = "tcp";
|
||||
my $tp2 = "lf_tcp";
|
||||
my $rate = 6000000; # 6Mbps
|
||||
|
||||
for ($i = 1; $i<=6; $i++) {
|
||||
my $tx_nm = "${tp}-qp${i}-TX";
|
||||
my $rx_nm = "${tp}-qp${i}-RX";
|
||||
|
||||
doCmd("add_endp $tx_nm $shelf_num $lanf1 $i $tp2 -1 NO $rate $rate NO 4000 4000 random_fixed NO");
|
||||
|
||||
my $rt = $rate / 2; # Non-symetric cross-connect
|
||||
|
||||
doCmd("add_endp $rx_nm $shelf_num $lanf3 $i $tp2 -1 NO $rt $rt NO 4000 4000 decreasing NO");
|
||||
|
||||
my $cx_nm = "${tp}-qp${i}";
|
||||
# Add cross-connect
|
||||
doCmd("add_cx $cx_nm $test_mgr $tx_nm $rx_nm");
|
||||
|
||||
@endpoint_names = (@endpoint_names, $rx_nm, $tx_nm);
|
||||
@cx_names = (@cx_names, $cx_nm);
|
||||
}
|
||||
|
||||
|
||||
# Set up 6 cross-connects between lanf1 and lanf3
|
||||
$i = 1;
|
||||
$tp = "udp";
|
||||
$tp2 = "lf_udp";
|
||||
$rate = 9000000; # 9Mbps
|
||||
|
||||
for ($i = 1; $i<=6; $i++) {
|
||||
my $tx_nm = "${tp}-qp${i}-TX";
|
||||
my $rx_nm = "${tp}-qp${i}-RX";
|
||||
|
||||
doCmd("add_endp $tx_nm $shelf_num $lanf1 $i $tp2 -1 NO $rate $rate NO 4000 4000 random_fixed NO");
|
||||
|
||||
my $rt = $rate / 2; # Non-symetric cross-connect
|
||||
|
||||
doCmd("add_endp $rx_nm $shelf_num $lanf3 $i $tp2 -1 NO $rt $rt NO 4000 4000 decreasing NO");
|
||||
|
||||
my $cx_nm = "${tp}-qp${i}";
|
||||
# Add cross-connect
|
||||
doCmd("add_cx $cx_nm $test_mgr $tx_nm $rx_nm");
|
||||
|
||||
@endpoint_names = (@endpoint_names, $rx_nm, $tx_nm);
|
||||
@cx_names = (@cx_names, $cx_nm);
|
||||
}
|
||||
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
|
||||
print ">>> $cmd\n";
|
||||
|
||||
$t->print($cmd);
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
#sleep(1);
|
||||
}
|
||||
230
lf_stress4.pl
Executable file
230
lf_stress4.pl
Executable file
@@ -0,0 +1,230 @@
|
||||
#!/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.
|
||||
|
||||
# This specifically is designed for two machines with 3 data-generating ports each.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use Net::Telnet ();
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# Specify 'card' numbers for this configuration.
|
||||
my $lanf1 = 1;
|
||||
my $lanf2 = 2;
|
||||
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 100;
|
||||
my $run_for_time = (60 * 60 * 24); # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Stop for XX seconds..then will be started again
|
||||
my $report_timer = 3000; # 3 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# 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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
# Do some thing over and over again...
|
||||
my $loops = 0;
|
||||
for ($loop = 0; $loop<$loop_max; $loop++) {
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "\n\n***** Starting loop: $loop at: $dt *****\n\n";
|
||||
|
||||
# Remove any existing configuration information
|
||||
initToDefaults();
|
||||
|
||||
print " ***Sleeping 3 seconds for ports to initialize to defaults...\n";
|
||||
sleep(3);
|
||||
|
||||
#exit(0);
|
||||
|
||||
# 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();
|
||||
|
||||
print " ***Sleeping 3 seconds for ports to initialize to current values...\n";
|
||||
sleep(3);
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
my $rl = 0;
|
||||
for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
sleep($stop_for_time);
|
||||
|
||||
}# For some amount of start_stop iterations...
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub initPortsToDefault {
|
||||
# Set all ports we are messing with to known state.
|
||||
my $i = 0;
|
||||
|
||||
# All have 3 ports
|
||||
for ($i = 1; $i<=3; $i++) {
|
||||
doCmd("set_port $shelf_num $lanf1 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 $i 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub initIpAddresses {
|
||||
# Set all ports we are messing with to known state.
|
||||
|
||||
# Syntax for setting port info is:
|
||||
# set_port [shelf] [card] [port] [ip] [mask] [gateway] [cmd-flags] [cur-flags] [MAC]
|
||||
# NOTE: Just use NA for the flags for now...not tested otherwise.
|
||||
|
||||
# Set up the 3 10/100 ports. They will be set up to talk to
|
||||
# each other.
|
||||
doCmd("set_port $shelf_num $lanf1 1 172.25.7.2 255.255.255.0 172.25.7.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf1 2 172.25.8.2 255.255.255.0 172.25.8.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf1 3 172.25.8.4 255.255.255.0 172.25.8.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 1 172.25.7.4 255.255.255.0 172.25.7.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 2 172.25.8.3 255.255.255.0 172.25.8.1 NA NA NA");
|
||||
doCmd("set_port $shelf_num $lanf2 3 172.25.8.5 255.255.255.0 172.25.8.1 NA NA NA");
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
# Syntax for adding an endpoint is:
|
||||
# add_endp [alias] [shelf] [card] [port] [type] [IP-port] [bursty] [min_rate] [max_rate]
|
||||
# [pkt_sz_random] [min_pkt] [max_pkt] [pattern] [use_checksum]
|
||||
|
||||
# Set up 3 TCP cross-connects between lanf1 and lanf2
|
||||
my $i = 1;
|
||||
my $tp = "tcp";
|
||||
my $tp2 = "lf_tcp";
|
||||
my $rate = 6000000; # 6Mbps
|
||||
|
||||
for ($i = 1; $i<=3; $i++) {
|
||||
my $tx_nm = "${tp}-qp${i}-TX";
|
||||
my $rx_nm = "${tp}-qp${i}-RX";
|
||||
|
||||
doCmd("add_endp $tx_nm $shelf_num $lanf1 $i $tp2 -1 NO $rate $rate NO 4000 4000 random_fixed NO");
|
||||
|
||||
my $rt = $rate / 2; # Non-symetric cross-connect
|
||||
|
||||
doCmd("add_endp $rx_nm $shelf_num $lanf2 $i $tp2 -1 NO $rt $rt NO 4000 4000 decreasing NO");
|
||||
|
||||
my $cx_nm = "${tp}-qp${i}";
|
||||
# Add cross-connect
|
||||
doCmd("add_cx $cx_nm $test_mgr $tx_nm $rx_nm");
|
||||
|
||||
@endpoint_names = (@endpoint_names, $rx_nm, $tx_nm);
|
||||
@cx_names = (@cx_names, $cx_nm);
|
||||
}
|
||||
|
||||
|
||||
# Set up 3 UDP cross-connects between lanf1 and lanf2
|
||||
my $i = 1;
|
||||
my $tp = "udp";
|
||||
my $tp2 = "lf_udp";
|
||||
my $rate = 6000000; # 6Mbps
|
||||
|
||||
for ($i = 1; $i<=3; $i++) {
|
||||
my $tx_nm = "${tp}-qp${i}-TX";
|
||||
my $rx_nm = "${tp}-qp${i}-RX";
|
||||
|
||||
doCmd("add_endp $tx_nm $shelf_num $lanf2 $i $tp2 -1 NO $rate $rate NO 4000 4000 random_fixed NO");
|
||||
|
||||
my $rt = $rate / 2; # Non-symetric cross-connect
|
||||
|
||||
doCmd("add_endp $rx_nm $shelf_num $lanf1 $i $tp2 -1 NO $rt $rt NO 4000 4000 decreasing NO");
|
||||
|
||||
my $cx_nm = "${tp}-qp${i}";
|
||||
# Add cross-connect
|
||||
doCmd("add_cx $cx_nm $test_mgr $tx_nm $rx_nm");
|
||||
|
||||
@endpoint_names = (@endpoint_names, $rx_nm, $tx_nm);
|
||||
@cx_names = (@cx_names, $cx_nm);
|
||||
}
|
||||
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
|
||||
print ">>> $cmd\n";
|
||||
|
||||
$t->print($cmd);
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
#sleep(1);
|
||||
}
|
||||
823
lf_verify.pl
Executable file
823
lf_verify.pl
Executable file
@@ -0,0 +1,823 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
# This program is used to verify LANforge configuration sub-systems.
|
||||
# It uses the LANforge::Endpoint perl module to parse output from
|
||||
# the CLI.
|
||||
|
||||
# This script sets up connections of types:
|
||||
# lf, lf_udp, lf_tcp, custom_ether, custom_udp, and custom_tcp
|
||||
# across 3 ports on 2 machines.
|
||||
# It then changes values and checks to see if the values set correctly.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf_num = 1;
|
||||
|
||||
# This sets up connections between 2 LANforge machines
|
||||
my $lf1 = 1;
|
||||
my $lf2 = 4;
|
||||
|
||||
# Port pairs. These are the ports that should be talking to each other.
|
||||
# Ie, the third column in lf1_ports talks to the third column in lf2_ports.
|
||||
my @lf1_ports = (4, 5, 2); # ,7);
|
||||
my @lf2_ports = (5, 6, 4); # ,5);
|
||||
|
||||
my $ports_are_connected = 1; # Connected to each other. If true, we can test some
|
||||
# ethernet driver settings more precisely.
|
||||
|
||||
my $manual_check = 0; # If this is true, then user input will be asked for each time
|
||||
# there is a test failure. Good for manually checking the script, etc.
|
||||
|
||||
my $ip_base = "172.1";
|
||||
|
||||
# Set up one CX of each of these types on each port pair.
|
||||
my @cx_types = ("lf", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp");
|
||||
my @min_pkt_szs = (64, 20, 20, 1, 1);
|
||||
my @max_pkt_szs = (1514, 65507, 65535, 2048, 2048);
|
||||
|
||||
my $min_rate = 0;
|
||||
my $max_rate = 1024000;
|
||||
|
||||
my $test_mgr = "ben_tm";
|
||||
|
||||
my $report_timer = 3000; # 3 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
my $usage = "$0 [--host {lanforge-mgr-host}]
|
||||
|
||||
Example:
|
||||
$0 --host localhost\n";
|
||||
|
||||
my $i = 0;
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'host|h=s' => \$lfmgr_host,
|
||||
) || die("$usage");
|
||||
|
||||
|
||||
my @endpoint_names = (); #will be added to as they are created
|
||||
my @cx_names = ();
|
||||
|
||||
my $fail_msg = "";
|
||||
|
||||
# Open connection to the LANforge server.
|
||||
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$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 = "";
|
||||
|
||||
# Do discovery to make sure the server knows about all servers. Good for when
|
||||
# you just restarted all the servers and want to run the test real fast now!
|
||||
$utils->doCmd("discover");
|
||||
sleep(2);
|
||||
$utils->doCmd("discover");
|
||||
sleep(2);
|
||||
|
||||
|
||||
initToDefaults();
|
||||
|
||||
print "Sleeping 3 seconds to let port initialization complete.\n";
|
||||
sleep(3); # Let everything settle down a bit...
|
||||
|
||||
# Now, add back the test manager we will be using
|
||||
$utils->doCmd("add_tm $test_mgr");
|
||||
$utils->doCmd("tm_register $test_mgr default"); #Add default user
|
||||
$utils->doCmd("tm_register $test_mgr default_gui"); #Add default GUI user
|
||||
|
||||
# $utils->doCmd("log_level 63");
|
||||
|
||||
# Change all kinds of things on the ports, they should end up configured
|
||||
# and ready for endpoints to be added.
|
||||
testPortModification();
|
||||
|
||||
testCxModification();
|
||||
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "\n\n\nCompleted at: $dt\n\n";
|
||||
|
||||
if (length($fail_msg) > 0) {
|
||||
print "Some sub-tests failed:\n$fail_msg\n";
|
||||
}
|
||||
else {
|
||||
print "All tests passed successfully.\n";
|
||||
}
|
||||
|
||||
exit(0);
|
||||
|
||||
|
||||
sub initToDefaults {
|
||||
# Clean up database if stuff exists
|
||||
|
||||
$utils->doCmd("rm_cx $test_mgr all");
|
||||
$utils->doCmd("rm_endp YES_ALL");
|
||||
$utils->doCmd("rm_test_mgr $test_mgr");
|
||||
|
||||
initPortsToDefault();
|
||||
}#initToDefaults
|
||||
|
||||
|
||||
sub initPortsToDefault {
|
||||
# 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];
|
||||
$utils->doCmd("set_port $shelf_num $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
$utils->doCmd("set_port $shelf_num $lf2 $tmp2 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
|
||||
}
|
||||
}
|
||||
|
||||
sub testFailed {
|
||||
my $msg = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
if (defined($should_fail) && ($should_fail eq "YES")) {
|
||||
print "\nGOOD: SUB-TEST FAILED correctly: $msg\n";
|
||||
$fail_msg .= "GOOD (should fail): $msg";
|
||||
}
|
||||
else {
|
||||
print "\nSUB-TEST FAILED: $msg\n";
|
||||
$fail_msg .= $msg;
|
||||
|
||||
if ($manual_check) {
|
||||
#$utils->doCmd("log_level 7");
|
||||
print "Press enter to continue with test: ";
|
||||
<STDIN>;
|
||||
}
|
||||
}
|
||||
}#testFailed
|
||||
|
||||
sub testPortModification {
|
||||
# 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 $tmp_ip = $i + 2;
|
||||
my $tmp_ip2 = $i + 102;
|
||||
|
||||
my $cmd = "set_port $shelf_num $lf1 $tmp $ip_base.1.$tmp_ip 255.255.255.0 $ip_base.1.1 NA NA NA";
|
||||
$utils->doCmd($cmd);
|
||||
sleep(1);
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
|
||||
# Tell the port what it is so it decodes the right one..
|
||||
$utils->updatePort($p1, $shelf_num, $lf1, $tmp);
|
||||
|
||||
verifyPortAttributes($p1, $shelf_num, $lf1, $tmp, "$ip_base.1.$tmp_ip", "255.255.255.0",
|
||||
"$ip_base.1.1");
|
||||
testMacSettability($p1);
|
||||
testMtuSettability($p1);
|
||||
testQlenSettability($p1);
|
||||
|
||||
$cmd = "set_port $shelf_num $lf2 $tmp2 $ip_base.1.$tmp_ip2 255.255.255.0 $ip_base.1.1 NA NA NA";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
my $p2 = new LANforge::Port();
|
||||
|
||||
# Tell the port what it is so it decodes the right one..
|
||||
$utils->updatePort($p2, $shelf_num, $lf2, $tmp2);
|
||||
|
||||
verifyPortAttributes($p2, $shelf_num, $lf2, $tmp2, "$ip_base.1.$tmp_ip2", "255.255.255.0",
|
||||
"$ip_base.1.1");
|
||||
|
||||
testMacSettability($p2);
|
||||
testMtuSettability($p2);
|
||||
testQlenSettability($p2);
|
||||
|
||||
testRateSettability($p1, $p2);
|
||||
|
||||
}
|
||||
}#testPortModification
|
||||
|
||||
|
||||
sub testCxModification {
|
||||
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";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
my $pattern = "INCREASING";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "CUSTOM";
|
||||
}
|
||||
|
||||
my $ep1 = "endp-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "endp-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf_num $lf1 " . $lf1_ports[$j] . " " . $cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
my $endp1 = new LANforge::Endpoint();
|
||||
$utils->updateEndpoint($endp1, $ep1);
|
||||
verifyEndpointAttributes($endp1, $ep1, $shelf_num, $lf1, $lf1_ports[$j], $cx_types[$i], -1, $burst,
|
||||
$min_rate, $max_rate, $szrnd, $min_pkt_szs[$i], $max_pkt_szs[$i], $pattern,
|
||||
"NO"); # last is use_checksum
|
||||
testEndpointSettability($endp1);
|
||||
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf_num $lf2 " . $lf2_ports[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
my $endp2 = new LANforge::Endpoint();
|
||||
$utils->updateEndpoint($endp2, $ep2);
|
||||
verifyEndpointAttributes($endp2, $ep2, $shelf_num, $lf2, $lf2_ports[$j], $cx_types[$i], -1, $burst,
|
||||
$min_rate, $max_rate, $szrnd, $min_pkt_szs[$i], $max_pkt_szs[$i], $pattern,
|
||||
"NO"); # last is use_checksum
|
||||
testEndpointSettability($endp2);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "cx-${cx}";
|
||||
$cmd = "add_cx $cx_name $test_mgr $ep1 $ep2";
|
||||
$utils->doCmd($cmd);
|
||||
$utils->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 testQlenSettability {
|
||||
my $p1 = shift;
|
||||
testQlenSettabilityHelper($p1, "100");
|
||||
testQlenSettabilityHelper($p1, "800");
|
||||
testQlenSettabilityHelper($p1, "400");
|
||||
}#testQlenSettability
|
||||
|
||||
sub testMtuSettability {
|
||||
my $p1 = shift;
|
||||
testMtuSettabilityHelper($p1, "1500");
|
||||
testMtuSettabilityHelper($p1, "1400");
|
||||
testMtuSettabilityHelper($p1, "1496");
|
||||
|
||||
# It is not un-usual for these to fail
|
||||
testMtuSettabilityHelper($p1, "1504");
|
||||
testMtuSettabilityHelper($p1, "4096");
|
||||
testMtuSettabilityHelper($p1, "8192");
|
||||
|
||||
# This should work, set it back to defaults.
|
||||
testMtuSettabilityHelper($p1, "1500");
|
||||
}#testMtuSettability
|
||||
|
||||
|
||||
sub testMtuSettabilityHelper {
|
||||
my $p1 = shift;
|
||||
my $mtu = shift;
|
||||
|
||||
$p1->mtu($mtu);
|
||||
my $cmd = $p1->getSetMtuCmd();
|
||||
$utils->doCmd($cmd);
|
||||
$utils->updatePort($p1);
|
||||
my $p = $p1->toStringBrief();
|
||||
|
||||
if ($p1->mtu() ne $mtu) {
|
||||
# Give one more chance for things to be right, maybe the driver is slow...
|
||||
print (" *** WARNING: $p: Failed to set MTU correctly, tried: $mtu got: " .
|
||||
$p1->mtu() . "\n Going to wait 2 seconds and update the port again..\n");
|
||||
sleep(2);
|
||||
$utils->updatePort($p1);
|
||||
}
|
||||
|
||||
($p1->mtu() eq $mtu) or testFailed("$p: Failed to set MTU correctly, tried: $mtu got: " .
|
||||
$p1->mtu() . "\n");
|
||||
}#testMtuSettability
|
||||
|
||||
sub testQlenSettabilityHelper {
|
||||
my $p1 = shift;
|
||||
my $val = shift;
|
||||
|
||||
$p1->tx_q_len($val);
|
||||
my $cmd = $p1->getSetTxQueueLenCmd();
|
||||
$utils->doCmd($cmd);
|
||||
$utils->updatePort($p1);
|
||||
my $p = $p1->toStringBrief();
|
||||
|
||||
if ($p1->tx_q_len() ne $val) {
|
||||
# Give one more chance for things to be right, maybe the driver is slow...
|
||||
print (" *** WARNING: $p: Failed to set Tx-Queue-Length correctly, tried: $val got: " .
|
||||
$p1->tx_q_len() . "\n Going to wait 2 seconds and update the port again..\n");
|
||||
sleep(2);
|
||||
$utils->updatePort($p1);
|
||||
}
|
||||
|
||||
$p1->tx_q_len() eq $val or testFailed("$p: Failed to set Tx-Queue-Length correctly, tried: $val got: " .
|
||||
$p1->tx_q_len() . "\n");
|
||||
}
|
||||
|
||||
|
||||
sub testRateSettability {
|
||||
my $p1 = shift;
|
||||
my $p2 = shift;
|
||||
|
||||
testSolitaryPortSettability($p1);
|
||||
testSolitaryPortSettability($p2);
|
||||
|
||||
if ($ports_are_connected) {
|
||||
# TODO: Test partner flags
|
||||
}
|
||||
}#testRateSettability
|
||||
|
||||
|
||||
sub testSolitaryPortSettability {
|
||||
my $p1 = shift;
|
||||
|
||||
my $gbfd = "";
|
||||
my $gbhd = "";
|
||||
my $fc = "";
|
||||
if ($p1->supported_flags() =~ /1000bt/) {
|
||||
$gbfd = " 1000bt-FD";
|
||||
$gbhd = " 1000bt-HD";
|
||||
}
|
||||
|
||||
if ($p1->supported_flags() =~ /FLOW-CONTROL/) {
|
||||
$fc = " FLOW-CONTROL";
|
||||
}
|
||||
|
||||
advertTestHelper($p1, "10bt-HD 10bt-FD 100bt-HD 100bt-FD" . $gbhd . $gbfd . $fc);
|
||||
advertTestHelper($p1, "10bt-HD 10bt-FD 100bt-HD 100bt-FD" . $fc);
|
||||
advertTestHelper($p1, "10bt-HD 10bt-FD 100bt-HD 100bt-FD");
|
||||
advertTestHelper($p1, "10bt-HD 10bt-FD 100bt-HD");
|
||||
advertTestHelper($p1, "10bt-HD 10bt-FD");
|
||||
advertTestHelper($p1, "10bt-HD");
|
||||
advertTestHelper($p1, "100bt-FD");
|
||||
advertTestHelper($p1, "100bt-HD");
|
||||
advertTestHelper($p1, "10bt-FD");
|
||||
advertTestHelper($p1, "10bt-HD");
|
||||
advertTestHelper($p1, "10bt-HD 10bt-FD 100bt-HD 100bt-FD" . $gbhd . $gbfd . $fc);
|
||||
|
||||
if ($gbfd ne "") {
|
||||
fixedTestHelper($p1, "1000bt-FD");
|
||||
fixedTestHelper($p1, "1000bt-HD");
|
||||
}
|
||||
fixedTestHelper($p1, "100bt-FD");
|
||||
fixedTestHelper($p1, "100bt-HD");
|
||||
fixedTestHelper($p1, "10bt-FD");
|
||||
fixedTestHelper($p1, "10bt-HD");
|
||||
|
||||
advertTestHelper($p1, "10bt-HD 10bt-FD 100bt-HD 100bt-FD" . $gbhd . $gbfd . $fc);
|
||||
}#testSolitaryPortSettability
|
||||
|
||||
|
||||
sub fixedTestHelper {
|
||||
my $p1 = shift;
|
||||
my $adv = shift;
|
||||
|
||||
$p1->setRate($adv);
|
||||
my $cmd = $p1->getSetRateCmd();
|
||||
$utils->doCmd($cmd);
|
||||
sleep(2); # Give the hardware a chance to do what it needs.
|
||||
$utils->updatePort($p1);
|
||||
|
||||
if (!$p1->isCurrent($adv)) {
|
||||
# Give one more chance for things to be right, maybe the driver is slow...
|
||||
print (" *** WARNING: $p: Failed to set fixed rate correctly, tried: $adv got: " .
|
||||
$p1->cur_flags() . "\n Going to wait 2 seconds and update the port again..\n");
|
||||
sleep(2);
|
||||
$utils->updatePort($p1);
|
||||
}
|
||||
|
||||
my $p = $p1->toStringBrief();
|
||||
$p1->isCurrent($adv) or testFailed("$p: Failed to set fixed rate correctly, tried: $adv got: " .
|
||||
$p1->cur_flags() . "\n");
|
||||
}#fixedTestHelper
|
||||
|
||||
|
||||
sub advertTestHelper {
|
||||
my $p1 = shift;
|
||||
my $adv = shift;
|
||||
|
||||
$p1->setRate("auto");
|
||||
$p1->advert_flags("$adv");
|
||||
my $cmd = $p1->getSetRateCmd();
|
||||
$utils->doCmd($cmd);
|
||||
$utils->updatePort($p1);
|
||||
my $p = $p1->toStringBrief();
|
||||
$p1->isAdvertising($adv) or testFailed("$p: Failed to set advertise rates correctly, tried: $adv got: " .
|
||||
$p1->advert_flags() . "\n");
|
||||
}#advertTestHelper
|
||||
|
||||
|
||||
sub testMacSettability {
|
||||
my $port = shift;
|
||||
|
||||
# Get & save the original MAC
|
||||
my $mac = $port->mac_addr();
|
||||
my $sn = $port->shelf_id();
|
||||
my $cn = $port->card_id();
|
||||
my $pn = $port->port_id();
|
||||
|
||||
my $new_mac = "00:11:22:$sn$sn:$cn$cn:$pn$pn";
|
||||
$port->mac_addr($new_mac);
|
||||
$cmd = $port->getSetCmd();
|
||||
$utils->doCmd($cmd);
|
||||
$utils->updatePort($port);
|
||||
my $p = $port->toStringBrief();
|
||||
$port->mac_addr() eq $new_mac or testFailed("$p: Could not set MAC addr, current: " . $port->mac_addr()
|
||||
. " desired: $new_mac\n");
|
||||
# Set it back to original value
|
||||
$port->mac_addr($mac);
|
||||
$cmd = $port->getSetCmd();
|
||||
$utils->doCmd($cmd);
|
||||
$utils->updatePort($port);
|
||||
$p = $port->toStringBrief();
|
||||
$port->mac_addr() eq $mac or testFailed("$p: Could not set MAC addr, current: " . $port->mac_addr()
|
||||
. " desired: $mac\n");
|
||||
|
||||
print "Setting MAC for Port $sn.$cn.$pn verified as correct!\n";
|
||||
|
||||
}#testMacSettability
|
||||
|
||||
|
||||
sub verifyPortAttributes {
|
||||
my $port = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $ip = shift;
|
||||
my $msk = shift;
|
||||
my $gw = shift;
|
||||
|
||||
my $_sn = $port->shelf_id();
|
||||
my $_cn = $port->card_id();
|
||||
my $_pn = $port->port_id();
|
||||
my $_ipa = $port->ip_addr();
|
||||
|
||||
my $p = $port->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n");
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n");
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n");
|
||||
$_ipa eq $ip or testFailed("$p: IP Address: $_ipa does not match: $ip\n");
|
||||
$port->ip_mask() eq $msk or testFailed("$p: IP Mask: " . $port->ip_mask() . " does not match: $msk\n");
|
||||
$port->ip_gw() eq $gw or testFailed("$p: IP Gateway: " . $port->ip_gw() . " does not match: $gw\n");
|
||||
|
||||
print "$p verified as correct!\n";
|
||||
}#verifyPortAttributes
|
||||
|
||||
|
||||
sub verifyEndpointAttributes {
|
||||
my $endp = shift;
|
||||
my $name = shift;
|
||||
my $sn = shift;
|
||||
my $cn = shift;
|
||||
my $pn = shift;
|
||||
my $type = shift;
|
||||
my $ip_port = shift;
|
||||
my $bursty = shift;
|
||||
my $min_rate = shift;
|
||||
my $max_rate = shift;
|
||||
my $szrnd = shift;
|
||||
my $min_pkt_sz = shift;
|
||||
my $max_pkt_sz = shift;
|
||||
my $pattern = shift;
|
||||
my $using_csum = shift;
|
||||
my $tos = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
my $_sn = $endp->shelf_id();
|
||||
my $_cn = $endp->card_id();
|
||||
my $_pn = $endp->port_id();
|
||||
|
||||
my $p = $endp->toStringBrief();
|
||||
|
||||
$_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n", $should_fail);
|
||||
$_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n", $should_fail);
|
||||
$_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n", $should_fail);
|
||||
$endp->isOfType($type) or testFailed("$p: Type: " . $endp->ep_type() . " does not match: $type\n", $should_fail);
|
||||
if ($ip_port ne -1) {
|
||||
$endp->ip_port() eq $ip_port or testFailed("$p: IP-Port: " . $endp->ip_port() .
|
||||
" does not match: $ip_port\n", $should_fail);
|
||||
}
|
||||
$endp->getBursty() eq $bursty or testFailed("$p: Bursty: " . $endp->getBursty() .
|
||||
" does not match: $bursty\n", $should_fail);
|
||||
|
||||
$endp->min_tx_rate() eq $min_rate or testFailed("$p: Min-Tx-Rate: " . $endp->min_tx_rate() .
|
||||
" does not match: $min_rate\n", $should_fail);
|
||||
$endp->max_tx_rate() eq $max_rate or testFailed("$p: Max-Tx-Rate: " . $endp->max_tx_rate() .
|
||||
" does not match: $max_rate\n", $should_fail);
|
||||
|
||||
if ($endp->isCustom()) {
|
||||
($endp->size_random() eq "NO") or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" but we are CUSTOM!!\n", $should_fail);
|
||||
}
|
||||
else {
|
||||
$endp->size_random() eq $szrnd or testFailed("$p: Size-Random: " . $endp->size_random() .
|
||||
" does not match: $szrnd\n", $should_fail);
|
||||
}
|
||||
|
||||
if (! $endp->isCustom()) {
|
||||
$endp->min_pkt_size() eq $min_pkt_sz or testFailed("$p: Min-Packet-Size: " . $endp->min_pkt_size() .
|
||||
" does not match: $min_pkt_sz\n", $should_fail);
|
||||
$endp->max_pkt_size() eq $max_pkt_sz or testFailed("$p: Max-Packet-Size: " . $endp->max_pkt_size() .
|
||||
" does not match: $max_pkt_sz\n", $should_fail);
|
||||
}
|
||||
$endp->pattern() eq $pattern or testFailed("$p: Pattern: " . $endp->pattern() .
|
||||
" does not match: $pattern\n", $should_fail);
|
||||
$endp->checksum() eq $using_csum or testFailed("$p: Using-Checksum: " . $endp->checksum() .
|
||||
" does not match: $using_csum\n", $should_fail);
|
||||
|
||||
if (defined($tos)) {
|
||||
$endp->ip_tos() eq $tos or testFailed("$p: ToS: " . $endp->ip_tos() .
|
||||
" does not match: $tos\n", $should_fail);
|
||||
}
|
||||
|
||||
}#verifyEndpointAttributes
|
||||
|
||||
|
||||
sub testEndpointSettability {
|
||||
my $endp = shift;
|
||||
|
||||
print "\n*****\n >>Testing " . $endp->toStringBrief() . " rate settability.\n";
|
||||
|
||||
# Test setting the rates
|
||||
testEndpRateSet($endp, 0, 0, "NO");
|
||||
testEndpRateSet($endp, 2000, 2000, "NO");
|
||||
testEndpRateSet($endp, 0, 10000000, "YES");
|
||||
testEndpRateSet($endp, 65000, 128000, "YES");
|
||||
testEndpRateSet($endp, 512000, 1024000, "YES");
|
||||
testEndpRateSet($endp, 1024000, 512000, "NO", "YES"); # Should fail
|
||||
testEndpRateSet($endp, 512000, 1024000, "YES");
|
||||
|
||||
if ($endp->usesIP()) {
|
||||
testEndpTosSet($endp, 0x01, "YES");
|
||||
testEndpTosSet($endp, 0x02, "NO");
|
||||
testEndpTosSet($endp, 0x04, "YES");
|
||||
testEndpTosSet($endp, 0x06, "NO");
|
||||
testEndpTosSet($endp, 0x0a, "NO");
|
||||
testEndpTosSet($endp, 0x12, "NO");
|
||||
testEndpTosSet($endp, 0x02, "NO");
|
||||
testEndpTosSet($endp, "DONT-SET", "NO");
|
||||
}
|
||||
|
||||
# Test payload & payload size changes
|
||||
if ($endp->isCustom()) {
|
||||
testEndpPldSet($endp);
|
||||
}
|
||||
else {
|
||||
testEndpPldSizeSet($endp, 67, 1457, "YES");
|
||||
testEndpPldSizeSet($endp, 500, 457, "YES", "YES"); # should fail
|
||||
testEndpPldSizeSet($endp, 500, 500, "NO");
|
||||
testEndpPldSizeSet($endp, -1, 70000000, "YES", "YES"); #should fail
|
||||
testEndpPldSizeSet($endp, 128, 1500, "YES");
|
||||
}
|
||||
|
||||
# TODO: Change & check stuff
|
||||
}#testEndpointSettability
|
||||
|
||||
|
||||
sub testEndpPldSet {
|
||||
my $endp = shift;
|
||||
|
||||
my $pld = "00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff";
|
||||
|
||||
testEndpPldSetHelper($endp, $pld);
|
||||
|
||||
$pld = genRandomHex(2048);
|
||||
if ($endp->ep_type() =~ /CUSTOM_ETHER/) {
|
||||
testEndpPldSetHelper($endp, $pld, "YES"); # Should fail
|
||||
}
|
||||
else {
|
||||
testEndpPldSetHelper($endp, $pld, "NO"); #Shouldn't fail
|
||||
}
|
||||
|
||||
$pld = genRandomHex(17);
|
||||
if ($endp->ep_type() =~ /CUSTOM_ETHER/) { # Too short for ethernet, should fail.
|
||||
testEndpPldSetHelper($endp, $pld, "YES");
|
||||
}
|
||||
else {
|
||||
testEndpPldSetHelper($endp, $pld, "NO");
|
||||
}
|
||||
$pld = genRandomHex(1000);
|
||||
testEndpPldSetHelper($endp, $pld);
|
||||
|
||||
$pld = genRandomHex(2049);
|
||||
testEndpPldSetHelper($endp, $pld, "YES"); # Payload is too long, only support 2000 bytes at this time.
|
||||
|
||||
$pld = "00 11 22 gg 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff";
|
||||
|
||||
testEndpPldSetHelper($endp, $pld, "YES"); # Should fail, has 'gg' in it, which is not hex!
|
||||
|
||||
$pld = "zz 11 22 gg 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff";
|
||||
|
||||
testEndpPldSetHelper($endp, $pld, "YES"); # Should fail, has 'zz' in it, which is not hex!
|
||||
|
||||
$pld = "00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee ff 00 11 22 33 44 55 66 77 88 99 aa bb cc dd ee zz";
|
||||
|
||||
testEndpPldSetHelper($endp, $pld, "YES"); # Should fail, has 'zz' in it, which is not hex!
|
||||
|
||||
$pld = genRandomHex(1000);
|
||||
testEndpPldSetHelper($endp, $pld);
|
||||
|
||||
}#testEndpPldSet
|
||||
|
||||
sub testEndpPldSetHelper {
|
||||
my $endp = shift;
|
||||
my $pld = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
$endp->payload($pld);
|
||||
|
||||
my $cmd = $endp->getSetPayloadCmd();
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
$utils->updateEndpoint($endp);
|
||||
|
||||
my $p = $endp->toStringBrief();
|
||||
if ($endp->payload() ne $pld) {
|
||||
if (defined($should_fail) && ($should_fail eq "YES")) {
|
||||
# This is very verbose if the payload is printed out, so not going to print it all here,
|
||||
# but just the lengths instead. This is also expected behaviour (notice the should_fail == YES).
|
||||
testFailed("$p: Payload does not match, lengths: " . length($endp->payload()) . " "
|
||||
. length($pld) . "\n", $should_fail);
|
||||
}
|
||||
else {
|
||||
testFailed("$p: Payload:\n-:" . $endp->payload() . ":- does not match:\n-:$pld:-\n", $should_fail);
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (defined($should_fail) && ($should_fail eq "YES")) {
|
||||
testFailed("$p: Payload:\n-:" . $endp->payload() . ":- does match (and should have failed)\n");
|
||||
}
|
||||
}
|
||||
}#testEndpPldSetHelper
|
||||
|
||||
|
||||
sub testEndpPldSizeSet {
|
||||
my $endp = shift;
|
||||
my $min = shift;
|
||||
my $max = shift;
|
||||
my $rand = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
my $en = $endp->name();
|
||||
my $sn = $endp->shelf_id();
|
||||
my $cn = $endp->card_id();
|
||||
my $pn = $endp->port_id();
|
||||
my $et = $endp->ep_type();
|
||||
my $ipp = $endp->ip_port();
|
||||
my $minrt = $endp->min_tx_rate();
|
||||
my $mxrt = $endp->max_tx_rate();
|
||||
my $pt = $endp->pattern();
|
||||
my $cs = $endp->checksum();
|
||||
my $burst = $endp->getBursty();
|
||||
my $tos = $endp->ip_tos();
|
||||
|
||||
$endp->min_pkt_size($min);
|
||||
$endp->max_pkt_size($max);
|
||||
$endp->setRandom($rand);
|
||||
|
||||
my @cmds = $endp->getSetCmds();
|
||||
my $i;
|
||||
for ($i = 0; $i<@cmds; $i++) {
|
||||
$utils->doCmd($cmds[$i]);
|
||||
}
|
||||
|
||||
$utils->updateEndpoint($endp);
|
||||
|
||||
verifyEndpointAttributes($endp, $en, $sn, $cn, $pn, $et, $ipp, $burst, $minrt, $mxrt, $rand,
|
||||
$min, $max, $pt, $cs, $tos, $should_fail);
|
||||
}#testEndpPldSizeSet
|
||||
|
||||
|
||||
sub testEndpRateSet {
|
||||
my $endp = shift;
|
||||
my $min = shift;
|
||||
my $max = shift;
|
||||
my $burst = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
my $en = $endp->name();
|
||||
my $sn = $endp->shelf_id();
|
||||
my $cn = $endp->card_id();
|
||||
my $pn = $endp->port_id();
|
||||
my $et = $endp->ep_type();
|
||||
my $ipp = $endp->ip_port();
|
||||
my $tos = $endp->ip_tos();
|
||||
|
||||
my $sr = $endp->size_random();
|
||||
my $minpkt = $endp->min_pkt_size();
|
||||
my $mxpkt = $endp->max_pkt_size();
|
||||
my $pt = $endp->pattern();
|
||||
my $cs = $endp->checksum();
|
||||
|
||||
$endp->min_tx_rate($min);
|
||||
$endp->max_tx_rate($max);
|
||||
$endp->setBursty($burst);
|
||||
|
||||
my @cmds = $endp->getSetCmds();
|
||||
my $i;
|
||||
for ($i = 0; $i<@cmds; $i++) {
|
||||
$utils->doCmd($cmds[$i]);
|
||||
}
|
||||
|
||||
$utils->updateEndpoint($endp);
|
||||
|
||||
verifyEndpointAttributes($endp, $en, $sn, $cn, $pn, $et, $ipp, $burst, $min, $max, $sr,
|
||||
$minpkt, $mxpkt, $pt, $cs, $tos, $should_fail);
|
||||
|
||||
}#testEndpRateSet
|
||||
|
||||
|
||||
sub testEndpTosSet {
|
||||
my $endp = shift;
|
||||
my $tos = shift;
|
||||
my $should_fail = shift;
|
||||
|
||||
my $en = $endp->name();
|
||||
my $sn = $endp->shelf_id();
|
||||
my $cn = $endp->card_id();
|
||||
my $pn = $endp->port_id();
|
||||
my $et = $endp->ep_type();
|
||||
my $ipp = $endp->ip_port();
|
||||
|
||||
my $sr = $endp->size_random();
|
||||
my $minpkt = $endp->min_pkt_size();
|
||||
my $mxpkt = $endp->max_pkt_size();
|
||||
my $pt = $endp->pattern();
|
||||
my $cs = $endp->checksum();
|
||||
|
||||
$endp->ip_tos($tos);
|
||||
|
||||
my @cmds = $endp->getSetCmds();
|
||||
my $i;
|
||||
for ($i = 0; $i<@cmds; $i++) {
|
||||
$utils->doCmd($cmds[$i]);
|
||||
}
|
||||
|
||||
$utils->updateEndpoint($endp);
|
||||
|
||||
verifyEndpointAttributes($endp, $en, $sn, $cn, $pn, $et, $ipp, $burst, $min, $max, $sr,
|
||||
$minpkt, $mxpkt, $pt, $cs, $tos, $should_fail);
|
||||
|
||||
}#testEndpTosSet
|
||||
|
||||
|
||||
sub genRandomHex {
|
||||
my $bytes = shift;
|
||||
|
||||
my @tbl = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f");
|
||||
my $i;
|
||||
my $pld = "";
|
||||
for ($i = 0; $i<$bytes; $i++) {
|
||||
$pld .= $tbl[(rand() * 1000.0) % 16] . $tbl[(rand() * 1000.0) % 16]; #Generate some hex the hard way!
|
||||
if ($i != ($bytes - 1)) {
|
||||
$pld .= " ";
|
||||
}
|
||||
}
|
||||
|
||||
return $pld;
|
||||
}#genRandomHex
|
||||
882
lf_voip.pl
Executable file
882
lf_voip.pl
Executable file
@@ -0,0 +1,882 @@
|
||||
#!/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.
|
||||
|
||||
# This script sets up connections of types:
|
||||
# lf, lf_udp, lf_tcp, custom_ether, custom_udp, and custom_tcp
|
||||
# across 1 real port and manny macvlan ports on 2 machines.
|
||||
# It then continously starts and stops the connections.
|
||||
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use strict;
|
||||
|
||||
use Net::Telnet ();
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
|
||||
#my $lfmgr_host = "localhost";
|
||||
my $lfmgr_host = "localhost";
|
||||
my $lfmgr_port = 4001;
|
||||
|
||||
my $shelf = 1;
|
||||
|
||||
# set $STARTSTOP_LOOP = 1; to start and stop ALL endpoints after script finishes
|
||||
# populating the database.
|
||||
my $STARTSTOP_LOOP = 0;
|
||||
|
||||
# This sets up connections between 2 LANforge machines
|
||||
#my $lf1 = 4; my $lf2 = 15; my @lf1_ports = (0); my @lf2_ports = (0);
|
||||
|
||||
# This sets up connections between 2 ports of a single machine;
|
||||
# $lf1 and $lf2 are the minor number of the EIDs of the resource/card.
|
||||
#my $lf1 = 4; my $lf2 = 4; my @lf1_ports = ("eth1"); my @lf2_ports = ("eth2");
|
||||
my $lf1 = 16; my $lf2 = 16; my @lf1_ports = ("eth2"); my @lf2_ports = ("eth3");
|
||||
|
||||
my @mac3 = (1, 2);
|
||||
|
||||
|
||||
my $ignore_phys_ports = 1; # If 1, just muck with mac-vlans instead.
|
||||
my $ip_base = "172.1";
|
||||
my $ip_lsb = 2;
|
||||
my $ip_c = 2;
|
||||
my $msk = "255.255.0.0";
|
||||
|
||||
# The number of macvlans is dependant on the number for port used.
|
||||
# e.g. if two ports used, eth2 and eth3 then the number of vlans
|
||||
# for 120 virtual hosts would be 60 since they will be evenly distributed
|
||||
# between eth2 and eth3.
|
||||
my $num_macvlans = 60;
|
||||
my $codec = "g729a"; # Other options: G711U, SPEEX, g726-16, g726-24, g726-32, g726-40
|
||||
#my $codec = "G711U"; # Other options: G711U, SPEEX, g726-16, g726-24, g726-32, g726-40
|
||||
|
||||
my $mn_icg = 3; # minimum intercall gap
|
||||
my $mx_icg = 3; # maximum intercall gap
|
||||
my $min_call_duration = 0; # set to zero for 'file'
|
||||
my $max_call_duration = 0; # Set to zero for 'file'
|
||||
|
||||
my $no_send_rtp = 0; # Set to zero to send RTP traffic, 1 to suppress RTP
|
||||
my $use_VAD = 0; # Set to zero to not use VAD, 1 to use VAD
|
||||
my $vad_timer = 500; # how much silence (ms) before we start VAD (Silence Suppression)
|
||||
my $vad_fs = 3000; # how often (ms) to force an rtp pkt send even if we are in VAD
|
||||
my $use_PESQ = 0; # Set to 1 for PESQ, zero for not PESQ
|
||||
my $pesq_server = "127.0.0.1";
|
||||
my $pesq_server_port = 3998;
|
||||
my $vproto = "SIP";
|
||||
#my $vproto = "H323";
|
||||
|
||||
# If zero, will have one of EACH of the cx types on each port.
|
||||
#my $one_cx_per_port = 1;
|
||||
my $one_cx_per_port = 0;
|
||||
|
||||
#my @cx_types = ("", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4");
|
||||
#my @min_pkt_szs = (64, 1, 1, 1, 1, 0);
|
||||
#my @max_pkt_szs = (1514, 12000, 13000, 2048, 2048, 0);
|
||||
|
||||
# Layer-4 only
|
||||
#my @cx_types = ("l4", "l4");
|
||||
#my @min_pkt_szs = (0, 0);
|
||||
#my @max_pkt_szs = (0, 0);
|
||||
|
||||
# VOIP only
|
||||
#my @cx_types = ("voip", "voip", "voip", "voip");
|
||||
#my @min_pkt_szs = (0, 0, 0, 0);
|
||||
#my @max_pkt_szs = (0, 0, 0, 0);
|
||||
my @cx_types = ("voip");
|
||||
my @min_pkt_szs = (0);
|
||||
my @max_pkt_szs = (0);
|
||||
|
||||
my $peer_to_peer_voip = 1; # Don't register with SIP proxy, but just call peer to peer.
|
||||
|
||||
my @src_sound_files = ("media/female_voice_8khz.wav");
|
||||
|
||||
# URL will be acted on from machine $lf1
|
||||
#my $l4_url = "http://172.1.5.75";
|
||||
my $l4_url = "http://172.1.2.3"; # not used in lf_voip.pl script but makes it work
|
||||
|
||||
my $min_rate = 64000; # not used in lf_voip.pl script but makes it work
|
||||
my $max_rate = 512000; # not used in lf_voip.pl script but makes it work
|
||||
|
||||
my $test_mgr = "voip_tm";
|
||||
|
||||
my $loop_max = 100;
|
||||
my $start_stop_iterations = 100;
|
||||
my $run_for_time = 1200; # Run for XX seconds..then will be stopped again
|
||||
my $stop_for_time = 5; # Run for XX seconds..then will be stopped again
|
||||
my $report_timer = 5000; # 8 seconds
|
||||
|
||||
|
||||
########################################################################
|
||||
# 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\>\>/');
|
||||
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 45);
|
||||
|
||||
$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";
|
||||
|
||||
initToDefaults();
|
||||
#exit(0);
|
||||
|
||||
# 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
|
||||
|
||||
addMacVlans();
|
||||
|
||||
# Add some IP addresses to the ports
|
||||
initIpAddresses();
|
||||
|
||||
# Add our endpoints
|
||||
addCrossConnects();
|
||||
|
||||
if ($STARTSTOP_LOOP) {
|
||||
my $rl = 0;
|
||||
for ($rl = 0; $rl<$start_stop_iterations; $rl++) {
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all RUNNING");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " RUNNING";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
print "Done starting endpoints...sleeping $run_for_time seconds.\n";
|
||||
sleep($run_for_time);
|
||||
|
||||
# Now, stop them...
|
||||
|
||||
if (($rl % 2) == 0) {
|
||||
doCmd("set_cx_state $test_mgr all STOPPED");
|
||||
}
|
||||
else {
|
||||
# Do one at a time
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@cx_names; $q++) {
|
||||
my $cmd = "set_cx_state $test_mgr " . $cx_names[$q] . " STOPPED";
|
||||
doCmd($cmd);
|
||||
}
|
||||
}
|
||||
sleep($stop_for_time);
|
||||
}# For some amount of start_stop iterations...
|
||||
}# STARTSTOP_LOOP
|
||||
else {
|
||||
$dt = `date`;
|
||||
chomp($dt);
|
||||
print "Done at: $dt\n\n";
|
||||
exit(0);
|
||||
}# STARTSTOP_LOOP
|
||||
}# for some amount of loop iterations
|
||||
|
||||
$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
|
||||
|
||||
|
||||
sub addMacVlans {
|
||||
my $i;
|
||||
my $q;
|
||||
|
||||
my $v;
|
||||
my $lsb = 10;
|
||||
my $lsb2 = 10;
|
||||
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<@lf1_ports; $q++) {
|
||||
my $pnum1 = $lf1_ports[$q];
|
||||
my $pnum2 = $lf2_ports[$q];
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
|
||||
$lsb++;
|
||||
if ($lsb > 99) {
|
||||
$lsb2++;
|
||||
$lsb = 2;
|
||||
}
|
||||
|
||||
my $s2 = $shelf+10;
|
||||
my $c2 = $lf1+10;
|
||||
my $p2 = $mac3[0] + 10;
|
||||
my $mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf1 $pnum1 $mc");
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$c2 = $lf2+10;
|
||||
$p2 = $mac3[1] + 10;
|
||||
$mc = "00:$s2:$c2:$p2:$lsb2:$lsb";
|
||||
doCmd("add_mvlan $shelf $lf2 $pnum2 $mc");
|
||||
|
||||
# Throttle ourself so we don't over-run the poor LANforge system.
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $pnum1);
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $pnum2);
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
doCmd("probe_ports");
|
||||
|
||||
# Wait untill we discover all the ports...
|
||||
|
||||
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};
|
||||
}
|
||||
|
||||
for ($i = 0; $i<$num_macvlans; $i++) {
|
||||
while (1) {
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$i");
|
||||
if ($lf2 ne "") {
|
||||
$utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i");
|
||||
}
|
||||
if ($p1->isPhantom() || (($lf2 ne "") && $p2->isPhantom())) {
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}#addMacVlans
|
||||
|
||||
|
||||
# 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, 0);
|
||||
}#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.
|
||||
if (!$ignore_phys_ports) {
|
||||
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++) {
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
my $tmp = $lf1_ports[$i];
|
||||
my $tmp2 = $lf2_ports[$i];
|
||||
my $cmd = "";
|
||||
if (!$ignore_phys_ports) {
|
||||
$cmd = "set_port $shelf $lf1 $tmp $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$cmd = "set_port $shelf $lf2 $tmp2 $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
}
|
||||
}
|
||||
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $tmp);
|
||||
my $pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
my $throttle = 25;
|
||||
my $since_throttle = 0;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf1 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA NA 400";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
$ip_lsb++;
|
||||
|
||||
if ($lf2 ne "") {
|
||||
$p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $tmp2);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
$cmd = "set_port $shelf $lf2 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " .
|
||||
"$ip_base.1.1 NA NA NA NA 400";
|
||||
doCmd($cmd);
|
||||
$ip_lsb++;
|
||||
|
||||
if ($ip_lsb > 250) {
|
||||
$ip_c++;
|
||||
$ip_lsb = 2;
|
||||
}
|
||||
|
||||
if ($since_throttle++ > $throttle) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, "$pname\#$q");
|
||||
$since_throttle = 0;
|
||||
}
|
||||
}
|
||||
}# If we have an LF-2 defined.
|
||||
}
|
||||
}
|
||||
|
||||
sub addCrossConnects {
|
||||
my $ep = 0;
|
||||
my $cx = 0;
|
||||
my $i = 0;
|
||||
|
||||
my $voip_phone = 3000; # Start here and count on up as needed.
|
||||
my $rtp_port = 10000; # Starting RTP port.
|
||||
my $sound_file_idx = 0;
|
||||
|
||||
my @all_ports1 = @lf1_ports;
|
||||
my $j;
|
||||
my $pname;
|
||||
for ($j = 0; $j<@lf1_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports1 = (@all_ports1, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
|
||||
my @all_ports2 = @lf2_ports;
|
||||
if ($lf2 ne "") {
|
||||
for ($j = 0; $j<@lf2_ports; $j++) {
|
||||
my $p1 = new LANforge::Port();
|
||||
$utils->updatePort($p1, $shelf, $lf2, $lf2_ports[$j]);
|
||||
$pname = $p1->{dev};
|
||||
|
||||
my $q;
|
||||
for ($q = 0; $q<$num_macvlans; $q++) {
|
||||
@all_ports2 = (@all_ports2, "$pname\#$q");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print "About to start endpoints, all_ports1:\n" . join(" ", @all_ports1) .
|
||||
"\nall_ports2: " . join(" ", @all_ports2) . "\n\n";
|
||||
|
||||
if ($one_cx_per_port) {
|
||||
my $j = 0;
|
||||
my $cxcnt = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
my $i = $cxcnt % @cx_types;
|
||||
$cxcnt++;
|
||||
|
||||
my $cxt = $cx_types[$i];
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "l4e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_l4e-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l4-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);
|
||||
}
|
||||
elsif ($cxt eq "voip") {
|
||||
# Create VOIP endpoint
|
||||
|
||||
my $ep1 = "rtpe-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "rtpe-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_voip_endp $ep2 $shelf $lf2 " . $all_ports2[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep2 $vad_timer $vad_fs";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_voip_info $ep2 NA $mn_icg $mx_icg NA $codec $vproto NA NA $min_call_duration $max_call_duration /dev/null 20000 NA $pesq_server $pesq_server_port NA";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep2 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep2 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
if ($no_send_rtp) {
|
||||
$cmd = "set_endp_flag $ep2 nosendrtp 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($use_VAD) {
|
||||
$cmd = "set_endp_flag $ep2 VAD 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($use_PESQ) {
|
||||
$cmd = "set_endp_flag $ep2 pesq 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_voip_endp $ep1 $shelf $lf1 " . $all_ports1[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep1 $vad_timer $vad_fs";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_voip_info $ep1 NA $mn_icg $mx_icg NA $codec $vproto NA NA $min_call_duration $max_call_duration /dev/null 20000 NA $pesq_server $pesq_server_port NA";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep1 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep1 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep1 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
if ($no_send_rtp) {
|
||||
$cmd = "set_endp_flag $ep1 nosendrtp 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
if ($use_VAD) {
|
||||
$cmd = "set_endp_flag $ep1 VAD 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($use_PESQ) {
|
||||
$cmd = "set_endp_flag $ep1 pesq 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "rtp-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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "l3e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "l3e-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l3-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
|
||||
}#one_cx_per_port
|
||||
else {
|
||||
my $j = 0;
|
||||
for ($j ; $j<@all_ports1; $j++) {
|
||||
for ($i = 0; $i<@cx_types; $i++) {
|
||||
my $cxt = $cx_types[$i];
|
||||
|
||||
if ($cxt eq "l4") {
|
||||
# Create layer-4 endpoint
|
||||
|
||||
my $ep1 = "l4e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "D_l4e-${ep}-TX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
# Add the dummy endpoint
|
||||
my $cmd = "add_l4_endp $ep2 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 0 0 ' ' ' '";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 unmanaged 1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " l4_generic 0 10000 100 '" .
|
||||
"dl $l4_url /tmp/$ep1' ' '";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l4-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);
|
||||
}
|
||||
elsif ($cxt eq "voip") {
|
||||
# Create VOIP endpoint
|
||||
|
||||
my $ep1 = "RTPE-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "RTPE-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_voip_endp $ep2 $shelf $lf2 " . $all_ports2[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep2 $vad_timer $vad_fs";
|
||||
doCmd($cmd);
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
$cmd = "set_voip_info $ep2 NA $mn_icg $mx_icg NA $codec $vproto NA NA $min_call_duration $max_call_duration /dev/null 20000 NA $pesq_server $pesq_server_port NA";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep2 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep2 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep2 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($no_send_rtp) {
|
||||
$cmd = "set_endp_flag $ep2 nosendrtp 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($use_VAD) {
|
||||
$cmd = "set_endp_flag $ep2 VAD 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($use_PESQ) {
|
||||
$cmd = "set_endp_flag $ep2 pesq 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
my $cmd = "add_voip_endp $ep1 $shelf $lf1 " . $all_ports1[$j] .
|
||||
" $voip_phone $rtp_port AUTO " .
|
||||
$src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
" " . $src_sound_files[$sound_file_idx % @src_sound_files] .
|
||||
".$ep1";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_voip_info $ep1 NA $mn_icg $mx_icg NA $codec $vproto NA NA $min_call_duration $max_call_duration /dev/null 20000 NA $pesq_server $pesq_server_port NA";
|
||||
doCmd($cmd);
|
||||
|
||||
$cmd = "set_endp_flag $ep1 SavePCM 0";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($peer_to_peer_voip) {
|
||||
$cmd = "set_endp_flag $ep1 DoNotRegister 1";
|
||||
doCmd($cmd);
|
||||
$cmd = "set_endp_flag $ep1 BindSIP 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
if ($no_send_rtp) {
|
||||
$cmd = "set_endp_flag $ep1 nosendrtp 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($use_VAD) {
|
||||
$cmd = "set_endp_flag $ep1 VAD 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
if ($use_PESQ) {
|
||||
$cmd = "set_endp_flag $ep1 pesq 1";
|
||||
doCmd($cmd);
|
||||
}
|
||||
|
||||
$voip_phone++;
|
||||
$rtp_port += 2;
|
||||
$sound_file_idx++;
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "rtp-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);
|
||||
}
|
||||
else {
|
||||
my $burst = "NO";
|
||||
if ($min_rate != $max_rate) {
|
||||
$burst = "YES";
|
||||
}
|
||||
my $szrnd = "NO";
|
||||
if ($min_pkt_szs[$i] != $max_pkt_szs[$i]) {
|
||||
$szrnd = "YES";
|
||||
}
|
||||
|
||||
my $pattern = "increasing";
|
||||
if ($cx_types[$i] =~ /custom/) {
|
||||
$pattern = "custom";
|
||||
}
|
||||
|
||||
my $ep1 = "l3e-${ep}-TX";
|
||||
$ep++;
|
||||
my $ep2 = "l3e-${ep}-RX";
|
||||
$ep++;
|
||||
|
||||
@endpoint_names = (@endpoint_names, $ep1, $ep2);
|
||||
|
||||
my $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " . $max_pkt_szs[$i] .
|
||||
" $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
if ($lf2 == "") {
|
||||
die("Must lave lf2 defined if using non-l4 endpoints.");
|
||||
}
|
||||
|
||||
$cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] .
|
||||
" -1 $burst $min_rate $max_rate $szrnd " . $min_pkt_szs[$i] . " " .
|
||||
$max_pkt_szs[$i] . " $pattern NO";
|
||||
doCmd($cmd);
|
||||
|
||||
# Now, add the cross-connects
|
||||
my $cx_name = "l3-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 cx types
|
||||
}#for each port
|
||||
}# each cx per port
|
||||
|
||||
}#addCrossConnects
|
||||
|
||||
|
||||
sub doCmd {
|
||||
my $cmd = shift;
|
||||
|
||||
print ">>> $cmd\n";
|
||||
|
||||
$t->print($cmd);
|
||||
|
||||
my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/');
|
||||
print "**************\n @rslt ................\n\n";
|
||||
#sleep(1);
|
||||
}
|
||||
1121
lf_voip_test.pl
Executable file
1121
lf_voip_test.pl
Executable file
File diff suppressed because it is too large
Load Diff
374
lf_vue_mod.sh
Executable file
374
lf_vue_mod.sh
Executable file
@@ -0,0 +1,374 @@
|
||||
#!/bin/bash
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
# vUE operations script actions:
|
||||
# create a station
|
||||
# print out stations attributes
|
||||
# print list of station names
|
||||
# print list of connections
|
||||
# bring a station up/down
|
||||
# create L3/L4 connection
|
||||
# start/stop connection
|
||||
# print packets rx/tx for station
|
||||
# print packets rx/tx for connection
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
Q='"'
|
||||
A="'"
|
||||
SCRIPTDIR="/home/lanforge/scripts"
|
||||
|
||||
function usage() {
|
||||
echo "$0:
|
||||
--create_sta --name <name> --radio <wiphyX> --security <open|wpa2> --ssid <ssid> --passphrase <wpa2 pass>
|
||||
--delete_sta --name <name>
|
||||
--show_port --name <name>
|
||||
--list_ports
|
||||
--list_cx
|
||||
--list_l4
|
||||
--log_cli <filename>
|
||||
--poll_endp --name <name> [--endp_vals tx_bytes,tx_pkts,rx_bytes,rx_pkts]
|
||||
--up --name <name>
|
||||
--down --name <name>
|
||||
--create_cx --name <name> --sta <name> --port <name> --tcp|--udp --bps <speed-a>,<speed-b>
|
||||
--create_l4 --name <name> --sta <name> --url <name> --utm <urls/10 min> --l4bps <speed>
|
||||
--start_cx --name <cx name>
|
||||
--start_l4 --name <l4 name>
|
||||
--stop_cx --name <cx name>
|
||||
--stop_l4 --name <l4 name>
|
||||
--mgr <localhost or ip>
|
||||
--resource <1=manager, 2+:resource>
|
||||
|
||||
Examples:
|
||||
$0 --list_ports --mgr 192.168.1.102 --resource 2
|
||||
$0 --create_sta --resource 2 --name sta100 --radio wiphy0 --security wpa2 --ssid jedtest --passphrase jedtest1
|
||||
$0 --delete_sta --resource 2 --name sta100
|
||||
$0 --up --name sta100
|
||||
$0 --create_cx --name tcp10 --sta sta100 --port eth1 --tcp --bps 1000000
|
||||
$0 --create_l4 --name web10 --sta sta100 --url http://www.example.com --utm 2400 --l4bps 1000000
|
||||
$0 --poll_endp --name tcp10 --endp_vals tx_pkts,rx_pkts
|
||||
Use --log_cli to print out CLI commands
|
||||
Use --log_cli /tmp/clilog.txt to log CLI commands to /tmp/clilog.txt
|
||||
* Stations created with WPA2 and DHCP by default
|
||||
"
|
||||
}
|
||||
## M A I N
|
||||
OPTS="`getopt -o hm:r:n:ud -l help,mgr:,resource:,quiet:,\
|
||||
create_sta,delete_sta,ip:,radio:,name:,ssid:,passphrase:,security:,\
|
||||
list_ports,list_cx,list_l4,\
|
||||
show_port,endp_vals:,poll_endp,log_cli:,\
|
||||
create_cx,port:,sta:,tcp,udp,bps:,\
|
||||
create_l4,url:,utm:,l4bps:,\
|
||||
up,down,start_cx,start_l4,stop_cx,stop_l4 \
|
||||
--name \"$0\" -- \"$@\"`"
|
||||
if [ $? != 0 ]; then
|
||||
usage
|
||||
exit 1
|
||||
fi
|
||||
#echo "OPTS: $OPTS"
|
||||
eval set -- "$OPTS"
|
||||
|
||||
# defualts
|
||||
resource="1"
|
||||
mgr="localhost"
|
||||
action="list"
|
||||
ip="DHCP"
|
||||
security="wpa2"
|
||||
proto="lf_udp"
|
||||
bps=2000000
|
||||
l4bps=0
|
||||
utm=2400
|
||||
clilog=''
|
||||
quiet="--quiet yes"
|
||||
|
||||
function do_firemod() {
|
||||
echo "./lf_firemod.pl --mgr \"$manager\" --resource \"$resource\" $clilog $quiet $@"
|
||||
./lf_firemod.pl --mgr "$manager" --resource "$resource" $clilog $quiet $@
|
||||
}
|
||||
|
||||
function do_portmod() {
|
||||
echo "./lf_portmod.pl --manager \"$manager\" --card \"$resource\" $clilog $quiet $@"
|
||||
./lf_portmod.pl --manager "$manager" --card "$resource" $clilog $quiet $@
|
||||
}
|
||||
|
||||
function do_associate() {
|
||||
echo "./lf_associate_ap.pl --mgr \"$manager\" --resource \"$resource\" $clilog $quiet $@"
|
||||
./lf_associate_ap.pl --mgr "$manager" --resource "$resource" $clilog $quiet $@
|
||||
}
|
||||
|
||||
function do_cmd() {
|
||||
newcmd=""
|
||||
for c in "$@"; do
|
||||
newcmd="$newcmd '$c'"
|
||||
done
|
||||
./lf_firemod.pl --mgr "$manager" --resource "$resource" $quiet $clilog --action do_cmd --cmd "$newcmd"
|
||||
}
|
||||
|
||||
while true; do
|
||||
case "$1" in
|
||||
--name)
|
||||
name="$2"
|
||||
shift 2;;
|
||||
--ssid)
|
||||
ssid="$2"
|
||||
shift 2;;
|
||||
--passphrase)
|
||||
passphrase="$2"
|
||||
shift 2;;
|
||||
--security)
|
||||
security="$2"
|
||||
shift 2;;
|
||||
--radio)
|
||||
radio="$2"
|
||||
shift 2;;
|
||||
--ip)
|
||||
ip="$2"
|
||||
shift 2;;
|
||||
--show_port)
|
||||
action="show_port"
|
||||
shift;;
|
||||
--list_ports)
|
||||
action="list_ports"
|
||||
shift;;
|
||||
--list_cx)
|
||||
action="list_cx"
|
||||
shift;;
|
||||
--poll_endp)
|
||||
action="poll_endp"
|
||||
shift;;
|
||||
--endp_vals)
|
||||
endp_vals="$2"
|
||||
shift 2;;
|
||||
--list_l4)
|
||||
action="list_l4"
|
||||
shift;;
|
||||
--create_sta)
|
||||
action="create_sta"
|
||||
shift;;
|
||||
--delete_sta)
|
||||
action="delete_sta"
|
||||
shift;;
|
||||
--sta)
|
||||
sta="$2"
|
||||
shift 2;;
|
||||
--port)
|
||||
port="$2"
|
||||
shift 2;;
|
||||
--up)
|
||||
action="up"
|
||||
shift;;
|
||||
--down)
|
||||
action="down"
|
||||
shift;;
|
||||
--create_cx)
|
||||
action="create_cx"
|
||||
shift;;
|
||||
--tcp)
|
||||
proto="lf_tcp"
|
||||
shift;;
|
||||
--udp)
|
||||
proto="lf_udp"
|
||||
shift;;
|
||||
--bps)
|
||||
IFS=',' read -a speeds <<< "$2"
|
||||
#if [ ${#speeds} -gt 1 ] ; then
|
||||
# echo "found TWO speeds: ${speeds[0]}, ${speeds[1]}"
|
||||
#fi
|
||||
shift 2;;
|
||||
--l4bps)
|
||||
l4bps="$2"
|
||||
shift 2;;
|
||||
--create_l4)
|
||||
action="create_l4"
|
||||
shift;;
|
||||
--url)
|
||||
url="$2"
|
||||
shift 2;;
|
||||
--utm)
|
||||
utm="$2"
|
||||
shift 2;;
|
||||
--start_cx)
|
||||
action="start_cx"
|
||||
shift;;
|
||||
--stop_cx)
|
||||
action="stop_cx"
|
||||
shift;;
|
||||
--start_l4)
|
||||
action="start_l4"
|
||||
shift;;
|
||||
--stop_l4)
|
||||
action="stop_l4"
|
||||
shift;;
|
||||
--mgr)
|
||||
manager="$2"
|
||||
shift 2;;
|
||||
--resource)
|
||||
resource="$2"
|
||||
shift 2;;
|
||||
--log_cli)
|
||||
if [[ $2 != --* ]]; then
|
||||
clilog="--log_cli ${2}"
|
||||
shift 2;
|
||||
else
|
||||
clilog="--log_cli"
|
||||
shift;
|
||||
fi
|
||||
;;
|
||||
--quiet)
|
||||
quiet="--quiet $2"
|
||||
shift 2;;
|
||||
--help)
|
||||
usage; exit 0;;
|
||||
-h)
|
||||
usage; exit 0;;
|
||||
--) shift;
|
||||
break;;
|
||||
*) echo "Unknown Option [$1]"
|
||||
exit 1;;
|
||||
esac
|
||||
done
|
||||
#echo "Action: $action Mgr $manager Resource $resource Name $name IP $ip SSID $ssid"
|
||||
|
||||
if [ -z "$action" ]; then
|
||||
usage
|
||||
echo "No action specified."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -z "$manager" ]; then
|
||||
usage
|
||||
echo "No LANforge Manager specified."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ -z "$resource" ]; then
|
||||
usage
|
||||
echo "No resource specified."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
cd $SCRIPTDIR
|
||||
case "$action" in
|
||||
list_ports)
|
||||
do_firemod --action list_ports
|
||||
;;
|
||||
|
||||
list_cx)
|
||||
do_firemod --action list_cx
|
||||
;;
|
||||
|
||||
list_l4)
|
||||
do_firemod --action list_endp | grep -v UN-MANAGED
|
||||
;;
|
||||
|
||||
show_port)
|
||||
[ -z "$name" ] && usage && echo "No station name specified." && exit 1
|
||||
do_portmod --port_name "$name" --show_port
|
||||
;;
|
||||
|
||||
poll_endp)
|
||||
[ -z "$name" ] && usage && echo "No station name specified." && exit 1
|
||||
do_firemod --action list_endp | egrep -q " \[${name}\] "
|
||||
if [ $? -ne 0 ]; then
|
||||
do_firemod --action list_endp
|
||||
echo "Endpoint $name not found."
|
||||
exit 1
|
||||
fi
|
||||
echo "Press <control-c> to stop."
|
||||
while true; do
|
||||
if [ ! -z "$endp_vals" ]; then
|
||||
do_firemod --action show_endp --endp_name "$name" --endp_vals "$endp_vals"
|
||||
else
|
||||
do_firemod --action show_endp --endp_name "$name" | egrep -v '>>'
|
||||
fi
|
||||
sleep 3
|
||||
done
|
||||
;;
|
||||
|
||||
create_sta)
|
||||
[ -z "$name" ] && usage && echo "No station name specified." && exit 1
|
||||
[ -z "$ssid" ] && usage && echo "No SSID specified." && exit 1
|
||||
[ -z "$security" ] && usage && echo "No WiFi security specified." && exit 1
|
||||
[ -z "$radio" ] && usage && echo "No radio specified." && exit 1
|
||||
[ "$ip" != "DHCP" ] && echo "$0 --ip option only supports DHCP, use lf_portmod.pl or lf_associate_ap.pl to do advanced station creation" && exit 1
|
||||
do_associate --action add \
|
||||
--radio "$radio" --security "$security" --ssid "$ssid" --passphrase "$passphrase" \
|
||||
--first_sta "$name" --first_ip "$ip" --num_stations 1
|
||||
;;
|
||||
|
||||
delete_sta)
|
||||
[ -z "$name" ] && usage && echo "No station name specified." && exit 1
|
||||
do_associate --action del --port_del "$name"
|
||||
;;
|
||||
|
||||
create_cx)
|
||||
[ -z "$name" ] && usage && echo "No connection name specified." && exit 1
|
||||
[ -z "$sta" ] && usage && echo "No station name specified." && exit 1
|
||||
[ -z "$port" ] && usage && echo "No upstream port name specified." && exit 1
|
||||
[ -z "$proto" ] && usage && echo "No connection protocol (tcp|udp) specified" && exit 1
|
||||
[ -z "${speeds[0]}" ] && usage && echo "No bitrate provided for L3 connection" && exit 1
|
||||
if [ -z "${speeds[1]}" ]; then
|
||||
speeds+=(${speeds[0]})
|
||||
fi
|
||||
#echo "Speed-a: ${speeds[0]} Speed-b: ${speeds[1]}"
|
||||
|
||||
do_firemod \
|
||||
--action create_endp --endp_name "${name}-A" --speed "${speeds[0]}" \
|
||||
--endp_type "$proto" --port_name "$sta" || exit 1
|
||||
|
||||
do_firemod \
|
||||
--action create_endp --endp_name "${name}-B" --speed "${speeds[1]}" \
|
||||
--endp_type "$proto" --port_name "$port" || exit 1
|
||||
|
||||
do_firemod --action create_cx --cx_name "$name" --cx_endps "${name}-A,${name}-B"
|
||||
;;
|
||||
|
||||
create_l4)
|
||||
[ -z "$name" ] && usage && echo "No connection name specified." && exit 1
|
||||
[ -z "$url" ] && usage && echo "No URL specified." && exit 1
|
||||
[ -z "$utm" ] && usage && echo "No requests/10min rate define (--utm)." && exit 1
|
||||
|
||||
# remember do_cmd is alias for ./lf_firemod --action do_cmd --cmd
|
||||
url2="dl $url /dev/null"
|
||||
do_cmd add_l4_endp "$name" 1 "$resource" "$sta" l4_generic 0 10000 "$utm" "$url2" NA NA 'ca-bundle.crt' NA 0 0 60 "$l4bps" 512 ' ' 0.0.0.0
|
||||
do_cmd set_endp_tos "$name" DONT-SET 0
|
||||
do_cmd set_endp_flag "$name" L4Enable404 0
|
||||
do_cmd set_endp_report_timer "$name" 5000
|
||||
do_cmd set_endp_flag "$name" ClearPortOnStart 0
|
||||
do_cmd set_endp_quiesce "$name" 3
|
||||
do_cmd add_cx "CX_$name" default_tm "$name"
|
||||
;;
|
||||
|
||||
start_cx)
|
||||
[ -z "$name" ] && usage && echo "No connection name specified." && exit 1
|
||||
do_cmd set_cx_state default_tm $name RUNNING
|
||||
;;
|
||||
|
||||
stop_cx)
|
||||
[ -z "$name" ] && usage && echo "No connection name specified." && exit 1
|
||||
do_cmd set_cx_state default_tm $name STOPPED
|
||||
;;
|
||||
|
||||
start_l4)
|
||||
[ -z "$name" ] && usage && echo "No connection name specified." && exit 1
|
||||
do_cmd set_cx_state default_tm CX_$name RUNNING
|
||||
;;
|
||||
|
||||
stop_l4)
|
||||
[ -z "$name" ] && usage && echo "No connection name specified." && exit 1
|
||||
do_cmd set_cx_state default_tm CX_$name STOPPED
|
||||
;;
|
||||
|
||||
down)
|
||||
[ -z "$name" ] && usage && echo "No port name specified." && exit 1
|
||||
do_portmod --port_name $name --set_ifstate down --quiet 1
|
||||
;;
|
||||
|
||||
up)
|
||||
[ -z "$name" ] && usage && echo "No port name specified." && exit 1
|
||||
do_portmod --port_name $name --set_ifstate up --quiet 1
|
||||
;;
|
||||
|
||||
*)
|
||||
echo "Unimplemented Action. Please contact support@candelatech.com"
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
# eof
|
||||
574
lf_wifi_rest_example.pl
Executable file
574
lf_wifi_rest_example.pl
Executable file
@@ -0,0 +1,574 @@
|
||||
#!/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.
|
||||
|
||||
# If Net::Telnet is not found, try: yum install "perl(Net::Telnet)"
|
||||
|
||||
# If the LANforge libraries are not found, make sure you are running
|
||||
# from the /home/lanforge directory (or where-ever you installed LANforge)
|
||||
|
||||
# Contact: support@candelatech.com if you have any questions or suggestions
|
||||
# for improvement.
|
||||
|
||||
# Written by Candela Technologies Inc.
|
||||
# Updated by: greearb@candelatech.com
|
||||
#
|
||||
#
|
||||
# This script creates some stations, creates some connections on them, runs them, gathers
|
||||
# some upload/download results, and then stops the connections. It is a good example of
|
||||
# how to call other LANforge scripts to more easily get work done.
|
||||
#
|
||||
#
|
||||
# You may need to install perl-JSON: dnf install perl-JSON
|
||||
#
|
||||
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
#use Carp;
|
||||
# Un-buffer output
|
||||
$| = 1;
|
||||
|
||||
use LANforge::Endpoint;
|
||||
use LANforge::Port;
|
||||
use LANforge::Utils;
|
||||
use Net::Telnet ();
|
||||
use Getopt::Long;
|
||||
use JSON;
|
||||
use Data::Dumper;
|
||||
use LANforge::GuiJson qw(GuiResponseToHash GetHeaderMap GetRecordsMatching GetFields);
|
||||
|
||||
#use constant NL => "\n";
|
||||
my $lfmgr_port = 4001;
|
||||
my $shelf_num = 1;
|
||||
# Specify 'card' numbers for this configuration.
|
||||
|
||||
my $amt_resets_sofar = 0;
|
||||
my $report_timer = 1000; # 1 second report timer, hard-coded for now.
|
||||
|
||||
# Default values for ye ole cmd-line args.
|
||||
|
||||
my $lfmgr_host = "localhost";
|
||||
my $card = 1;
|
||||
my $upstream = "eth1";
|
||||
my $port_name = "";
|
||||
my $station_count = "";
|
||||
my $radio = "wiphy0";
|
||||
our $quiet = 0;
|
||||
my $amt_resets = 1;
|
||||
my $min_sleep = 30;
|
||||
my $max_sleep = 30;
|
||||
my $fail_msg = "";
|
||||
my $manual_check = 0;
|
||||
my $show_port = undef;
|
||||
my @port_stats = ();
|
||||
my $cmd_log_name = ""; #= "lf_portmod.txt";
|
||||
my $set_speed = "NA";
|
||||
my $wifi_mode = "NA";
|
||||
my $security = "open";
|
||||
my $passwd = "NA";
|
||||
my $ssid = "NA";
|
||||
my $ap = "NA";
|
||||
my $eap_identity = "NA";
|
||||
my $eap_passwd = "NA";
|
||||
my $cx_type = "udp";
|
||||
my $speedA = "64000";
|
||||
my $speedB = "64000";
|
||||
my $log_file = "";
|
||||
my $NOT_FOUND = "-not found-";
|
||||
my $load = "";
|
||||
|
||||
########################################################################
|
||||
# Nothing to configure below here, most likely.
|
||||
########################################################################
|
||||
|
||||
|
||||
my $usage = "$0 --port_name {name | number}
|
||||
[--manager { network address of LANforge manager} ]
|
||||
[--amt_resets { number (0 means forever) } ]
|
||||
[--upstream { port-name } ]
|
||||
[--radio { radio-name } ]
|
||||
[--station_count { number } ]
|
||||
[--cx_type { lf_tcp, lf_udp, lf_tcp6, lf_udp6 } ]
|
||||
[--speedA { transmit speed for endpoint A }
|
||||
[--speedB { transmit speed for endpoint B }
|
||||
[--min_sleep { minimum number (seconds) to run the connections } ]
|
||||
[--max_sleep { maximum number (seconds) to run the connections} ]
|
||||
[--load { db-name } ]
|
||||
[--card { card-id } ]
|
||||
[--quiet { level } ]
|
||||
[--set_ifstate {up | down} ]
|
||||
[--show_port [key,key,key]]
|
||||
# show all port stats or just those matching /key:value/
|
||||
[--set_speed {wifi port speed, see GUI port-modify drop-down for possible values. Common
|
||||
examples: 'OS Defaults', '6 Mbps a/g', '1 Stream /n', '2 Streams /n', MCS-0 (x1 15 M), MCS-10 (x2 90 M),
|
||||
'v-MCS-0 (x1 32.5 M)', 'v-1 Stream /AC', 'v-2 Streams /AC', ... }
|
||||
[--wifi_mode {wifi mode: 0: AUTO, 1: 802.11a, 2: b, 3: g, 4: abg, 5: abgn,
|
||||
6: bgn 7: bg, 8: abgnAC, 9 anAC, 10 an}
|
||||
# wifi-mode option is applied when --set_speed is used.
|
||||
[--security {open|wep|wpa|wpa2}
|
||||
[--passwd {WiFi WPA/WPA2/ password}
|
||||
[--ssid {WiFi SSID}
|
||||
[--ap {BSSID of AP, or 'DEFAULT' for any.}
|
||||
[--eap_identity {value|[BLANK]}]
|
||||
[--eap_passwd {value|[BLANK]}]
|
||||
[--log_file {value}] # disabled by default
|
||||
|
||||
Examples:
|
||||
./lf_wifi_rest_example.pl --manager localhost --card 1 --port_name sta010 --station_count 5 --ssid Lede-apu2-AC \
|
||||
--radio wiphy0 --quiet 1 --upstream eth5 --speedB 15000000
|
||||
";
|
||||
|
||||
my $i = 0;
|
||||
my $log_cli = 'unset';
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'ap=s' => \$ap,
|
||||
'port_name|e=s' => \$port_name,
|
||||
'upstream=s' => \$upstream,
|
||||
'radio=s' => \$radio,
|
||||
'station_count=s' => \$station_count,
|
||||
'cx_type=s' => \$cx_type,
|
||||
'manager|m=s' => \$lfmgr_host,
|
||||
'load|L=s' => \$load,
|
||||
'quiet|q=s' => \$::quiet,
|
||||
'card|C=i' => \$card,
|
||||
'amt_resets=i' => \$amt_resets,
|
||||
'min_sleep=i' => \$min_sleep,
|
||||
'max_sleep=i' => \$max_sleep,
|
||||
'passwd=s' => \$passwd,
|
||||
'set_speed=s' => \$set_speed,
|
||||
'speedA=s' => \$speedA,
|
||||
'speedB=s' => \$speedB,
|
||||
'ssid=s' => \$ssid,
|
||||
'show_port:s' => \$show_port,
|
||||
'port_stats=s{1,}' => \@port_stats,
|
||||
'eap_identity|i=s' => \$eap_identity,
|
||||
'eap_passwd|p=s' => \$eap_passwd,
|
||||
'log_file|l=s' => \$log_file,
|
||||
'log_cli=s{0,1}' => \$log_cli,
|
||||
'wifi_mode=i' => \$wifi_mode,
|
||||
) || (print($usage) && exit(1));
|
||||
|
||||
if ($::quiet eq "0") {
|
||||
$::quiet = "no";
|
||||
}
|
||||
elsif ($::quiet eq "1") {
|
||||
$::quiet = "yes";
|
||||
}
|
||||
|
||||
# Configure logging...
|
||||
if (defined $log_cli) {
|
||||
if ($log_cli ne "unset") {
|
||||
# here is how we reset the variable if it was used as a flag
|
||||
if ($log_cli eq "") {
|
||||
$ENV{'LOG_CLI'} = 1;
|
||||
}
|
||||
else {
|
||||
$ENV{'LOG_CLI'} = $log_cli;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Open connection to the LANforge server. We use this for direct
|
||||
# calls to the LANforge CLI.
|
||||
my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
|
||||
$t->open(Host => $lfmgr_host,
|
||||
Port => $lfmgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
|
||||
my $dt = "";
|
||||
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
$::utils->telnet($t);
|
||||
if ($::utils->isQuiet()) {
|
||||
if (defined $ENV{'LOG_CLI'} && $ENV{'LOG_CLI'} ne "") {
|
||||
$::utils->cli_send_silent(0);
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(1); # Do not show input to telnet
|
||||
}
|
||||
$::utils->cli_rcv_silent(1); # Repress output from telnet
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(0); # Show input to telnet
|
||||
$::utils->cli_rcv_silent(0); # Show output from telnet
|
||||
}
|
||||
$::utils->log_cli("# $0 ".`date "+%Y-%m-%d %H:%M:%S"`);
|
||||
if (defined $log_file && ($log_file ne "")) {
|
||||
open(CMD_LOG, ">$log_file") or die("Can't open $log_file for writing...\n");
|
||||
$cmd_log_name = $log_file;
|
||||
if (!$::utils->isQuiet()) {
|
||||
print "History of all commands can be found in $log_file\n";
|
||||
}
|
||||
}
|
||||
|
||||
if (length($port_name) == 0) {
|
||||
print "ERROR: Must specify port name.\n";
|
||||
die("$usage");
|
||||
}
|
||||
|
||||
# Create a file in which we can store data for generating graphs and such.
|
||||
my $data_fname = "_graph_data.csv";
|
||||
open(PLOT_DATA, ">$data_fname");
|
||||
|
||||
|
||||
# Load an initial DB if requested.
|
||||
if ($load ne "") {
|
||||
my $cli_cmd = "load $load overwrite";
|
||||
$utils->doAsyncCmd($cli_cmd);
|
||||
my @rslt = $t->waitfor("/LOAD-DB: Load attempt has been completed./");
|
||||
if (!$utils->isQuiet()) {
|
||||
print @rslt;
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
|
||||
# lf_associate names ports thus, and we need to access these ports,
|
||||
# so build the names here. This is one place where 'internal' changes
|
||||
# to lf_associate could cause issues.
|
||||
my $offset = 100;
|
||||
if ($port_name =~ /^.*?(\d+)\s*$/) {
|
||||
$offset = $1;
|
||||
}
|
||||
my @stations = ();
|
||||
my @cxs = ();
|
||||
my @epa = ();
|
||||
my @epb = ();
|
||||
|
||||
for ($i = 0; $i < $station_count; $i++) {
|
||||
my $suffix = 0 + $i + $offset;
|
||||
$stations[$i] = sprintf("sta%03d", $suffix);
|
||||
$cxs[$i] = sprintf("cx-%03d", $suffix);
|
||||
$epa[$i] = sprintf("ep-A%03d", $suffix);
|
||||
$epb[$i] = sprintf("ep-B%03d", $suffix);
|
||||
}
|
||||
|
||||
# Create some stations using the lf_associate.pl script.
|
||||
my $cmd = "./lf_associate_ap.pl --mgr $lfmgr_host --mgr_port $lfmgr_port --resource $card " .
|
||||
"--action add --radio $radio --ssid $ssid --first_sta $port_name --first_ip DHCP --num_stations " .
|
||||
" $station_count --passphrase \"$passwd\" --security $security --wifi_mode $wifi_mode --log_cli";
|
||||
my $rslt = run_cmd($cmd);
|
||||
|
||||
if ($set_speed ne "NA") {
|
||||
# lf-associate cannot set the speed currently, so use lf_portmod.pl
|
||||
for ($i = 0; $i<@stations; $i++) {
|
||||
$cmd = "./lf_portmod.pl --manager $lfmgr_host --card $card --port_name " . $stations[$i] . " --set_speed \"$set_speed\"";
|
||||
$rslt = run_cmd($cmd);
|
||||
}
|
||||
}
|
||||
|
||||
# Make sure stations are admin up, in case they were previously created and admin-down.
|
||||
for ($i = 0; $i<@stations; $i++) {
|
||||
$cmd = "./lf_portmod.pl --manager $lfmgr_host --card $card --port_name " . $stations[$i] . " --set_ifstate up";
|
||||
$rslt = run_cmd($cmd);
|
||||
}
|
||||
|
||||
# Create some Layer-3 connections for data generation.
|
||||
for ($i = 0; $i<@stations; $i++) {
|
||||
# Remove any old ones first
|
||||
# A-side connection on station.
|
||||
$cmd = "rm_cx all " . $cxs[$i];
|
||||
$utils->doCmd($cmd);
|
||||
$cmd = "rm_endp " . $epa[$i];
|
||||
$utils->doCmd($cmd);
|
||||
$cmd = "rm_endp " . $epb[$i];
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
# And create some new ones...
|
||||
# A-side connection on station.
|
||||
$cmd = "./lf_firemod.pl --mgr $lfmgr_host --mgr_port $lfmgr_port --resource $card --action create_endp --endp_name "
|
||||
. $epa[$i] . " --speed $speedA --endp_type $cx_type --report_timer $report_timer --port_name " . $stations[$i];
|
||||
$rslt = run_cmd($cmd);
|
||||
|
||||
# B-side connection on upstream port
|
||||
$cmd = "./lf_firemod.pl --mgr $lfmgr_host --mgr_port $lfmgr_port --resource $card --action create_endp --endp_name "
|
||||
. $epb[$i] . " --speed $speedB --endp_type $cx_type --report_timer $report_timer --port_name $upstream";
|
||||
$rslt = run_cmd($cmd);
|
||||
|
||||
# Create a connection.
|
||||
$cmd = "./lf_firemod.pl --mgr $lfmgr_host --mgr_port $lfmgr_port --resource $card --report_timer $report_timer --action create_cx --cx_name "
|
||||
. $cxs[$i] . " --cx_endps " . $epa[$i] . "," . $epb[$i];
|
||||
$rslt = run_cmd($cmd);
|
||||
}
|
||||
|
||||
# Wait for ports to associate.
|
||||
my $max_wait = 30;
|
||||
for ($i = 0; ; $i++) {
|
||||
my $q;
|
||||
my $not_assoc = 0;
|
||||
my $no_ip = 0;
|
||||
for ($q = 0; $q < @stations; $q++) {
|
||||
$cmd = "./lf_portmod.pl --manager $lfmgr_host --card $card -q yes --port_name " . $stations[$q] . " --show_port AP,IP";
|
||||
$rslt = run_cmd($cmd);
|
||||
if ($rslt =~ /Not-Associated/) {
|
||||
$not_assoc++;
|
||||
}
|
||||
if ($rslt =~ /IP:\s+0.0.0.0/) {
|
||||
$no_ip++;
|
||||
}
|
||||
}
|
||||
if ($not_assoc || $no_ip) {
|
||||
if ($i > $max_wait) {
|
||||
print("ERROR: Could not connect or get IPs for all stations, continuing...\n");
|
||||
last;
|
||||
}
|
||||
sleep(1);
|
||||
}
|
||||
else {
|
||||
print("All ports are associated and have IP...\n");
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Start with slow speed previously set so ARP can complete easily....
|
||||
# Start our cross-connects by directly calling into LANforge CLI.
|
||||
for ($i = 0; $i<@cxs; $i++) {
|
||||
my $cmd = "set_cx_state all " . $cxs[$i] . " running";
|
||||
$utils->doAsyncCmd($cmd);
|
||||
}
|
||||
|
||||
print("Sleeping 5 seconds to let connections initialize...\n");
|
||||
sleep(5);
|
||||
|
||||
# Clear port counters, this will make their running averages more accurate,
|
||||
# and any byte/pkt totals gathered at the end would also be more useful.
|
||||
for ($i = 0; $i<@stations; $i++) {
|
||||
my $cmd = "clear_port_counters $shelf_num $card " . $stations[$i];
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
|
||||
$cmd = "clear_port_counters $shelf_num $card $upstream";
|
||||
$utils->doCmd($cmd);
|
||||
|
||||
# Set connections to desired speed and clear counters.
|
||||
for ($i = 0; $i<@cxs; $i++) {
|
||||
my $cmd = "add_endp " . $epa[$i] . " NA NA NA NA NA NA NA $speedA";
|
||||
$utils->doAsyncCmd($cmd);
|
||||
$cmd = "add_endp " . $epb[$i] . " NA NA NA NA NA NA NA $speedB";
|
||||
$utils->doAsyncCmd($cmd);
|
||||
|
||||
$cmd = "clear_cx " . $cxs[$i];
|
||||
$utils->doAsyncCmd($cmd);
|
||||
}
|
||||
|
||||
my $start = time();
|
||||
|
||||
# Calculate how long to run the connections.
|
||||
my $run_time = $min_sleep;
|
||||
if ($max_sleep > $min_sleep) {
|
||||
$run_time += int(rand($max_sleep - $min_sleep));
|
||||
}
|
||||
|
||||
my $total_dl;
|
||||
my $total_ul;
|
||||
do {
|
||||
# Gather some stats. Note that connections do not start exactly
|
||||
# at the same time, nor exactly when we ask them to, so we query the
|
||||
# connection for the 'running-for' time and calculate stats based on that
|
||||
# for best precision. Once a connection has been running for at least 60 seconds,
|
||||
# then we can just use the pre-calculated 60-second running average.
|
||||
#
|
||||
# For LANforge 5.3.6 and earlier, the 'RunningFor' output is in whole seconds only,
|
||||
# so there will be some rounding errors when we have only been running for a few seconds.
|
||||
# LANforge 5.3.7 and above will provide a fractional-second output to make the stats
|
||||
# more precise.
|
||||
my $total_dl = 0;
|
||||
my $total_ul = 0;
|
||||
my $total_dl_bps = 0;
|
||||
my $total_ul_bps = 0;
|
||||
|
||||
for ($i = 0; $i<@cxs; $i++) {
|
||||
|
||||
# Grab stats for endpoint A. This could be made into a method call to
|
||||
# decrease duplicated code.
|
||||
$rslt = $utils->doAsyncCmd("nc_show_endp " . $epa[$i] . "\n");
|
||||
if ($rslt =~ /Rx Bytes:\s+Total: (\d+)\s+Time: 60s\s+Cur: (\d+)\s+(\d+)\/s/) {
|
||||
my $bytes = $1;
|
||||
my $cur = $2;
|
||||
my $per_min = $3;
|
||||
my $rf = -1;
|
||||
my $avg = 0;
|
||||
if (($rslt =~ /RunningFor:\s+(\d+)s/) ||
|
||||
($rslt =~ /RunningFor:\s+(\d+.\d+)s/)) {
|
||||
$rf = $1;
|
||||
}
|
||||
if ($rf < 60) {
|
||||
if ($rf > 0) {
|
||||
$avg = (($cur * 8) / $rf);
|
||||
}
|
||||
else {
|
||||
$avg = 0;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$avg = $per_min * 8;
|
||||
}
|
||||
#print("endp: " . $epa[$i] . " rx-bytes: $bytes running-for: $rf avg-bps: $avg\n");
|
||||
$total_dl += ($bytes * 8);
|
||||
$total_dl_bps += $avg;
|
||||
}
|
||||
else {
|
||||
print("ERROR: Cannot parse result: $rslt\n");
|
||||
}
|
||||
|
||||
# Grab stats for endpoint B
|
||||
$rslt = $utils->doAsyncCmd("nc_show_endp " . $epb[$i] . "\n");
|
||||
if ($rslt =~ /Rx Bytes:\s+Total: (\d+)\s+Time: 60s\s+Cur: (\d+)\s+(\d+)\/s/) {
|
||||
my $bytes = $1;
|
||||
my $cur = $2;
|
||||
my $per_min = $3;
|
||||
my $rf = -1;
|
||||
my $avg = 0;
|
||||
if (($rslt =~ /RunningFor:\s+(\d+)s/) ||
|
||||
($rslt =~ /RunningFor:\s+(\d+.\d+)s/)) {
|
||||
$rf = $1;
|
||||
}
|
||||
if ($rf < 60) {
|
||||
if ($rf > 0) {
|
||||
$avg = (($cur * 8) / $rf);
|
||||
}
|
||||
else {
|
||||
$avg = 0;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$avg = $per_min * 8;
|
||||
}
|
||||
|
||||
#print(" endp: " . $epb[$i] . " rx-bytes: $bytes running-for: $rf avg-bps: $avg\n");
|
||||
$total_ul += ($bytes * 8);
|
||||
$total_ul_bps += $avg;
|
||||
}
|
||||
else {
|
||||
print("ERROR: Cannot parse result: $rslt\n");
|
||||
}
|
||||
}
|
||||
|
||||
# Print and store bps data for this loop iteration.
|
||||
my $now = time();
|
||||
print("$now: 60-sec running average: total-download-bps: $total_dl_bps total-upload-bps: $total_ul_bps\n");
|
||||
my $rel_t = $now - $start;
|
||||
if ($rel_t) { # Skip 0 time, no data available.
|
||||
# Convert to mbps
|
||||
$total_dl_bps /= 1000000;
|
||||
$total_ul_bps /= 1000000;
|
||||
my $tot_ul_dl = $total_dl_bps + $total_ul_bps;
|
||||
print PLOT_DATA "$rel_t\t$total_dl_bps\t$total_ul_bps\t$tot_ul_dl\n";
|
||||
}
|
||||
|
||||
sleep(1);
|
||||
} while (time() < ($start + $run_time));
|
||||
|
||||
|
||||
# Stop our cross-connects by directly calling into LANforge CLI.
|
||||
for ($i = 0; $i<@cxs; $i++) {
|
||||
my $cmd = "set_cx_state all " . $cxs[$i] . " stopped";
|
||||
$utils->doCmd($cmd);
|
||||
}
|
||||
|
||||
# Gather some stats using JSON. This assumes the GUI is running on the local machine on port 8080
|
||||
# [lanforge@lf0313-6477 LANforgeGUI_5.3.7]$ pwd
|
||||
# /home/lanforge/LANforgeGUI_5.3.7
|
||||
# [lanforge@lf0313-6477 LANforgeGUI_5.3.7]$ ./lfclient.bash -httpd 8080
|
||||
#
|
||||
|
||||
# Get a JSON dump of all rows and columns on the LANforge GUI Ports Tab.
|
||||
my $port_tab = `curl -sq http://localhost:8080/PortTab`;
|
||||
my $ports_data = GuiResponseToHash($port_tab);
|
||||
#my $ports_data = decode_json($port_tab);
|
||||
#print Dumper($ports_data);
|
||||
|
||||
# Grab data for these fields for all of our ports in use in this test.
|
||||
my @field_names = ("bps TX", "bps RX", "TX-Rate", "RX-Rate", "AP", "Channel", "CX Time.*");
|
||||
my @port_names = (@stations, $upstream);
|
||||
my $ra_fields = GetFields($ports_data, 'Device', \@port_names, \@field_names);
|
||||
|
||||
# And print out the JSON data on the console. This is just an example, you may
|
||||
# instead wish to grab different data and graph it and/or poke it into some long-term
|
||||
# storage for future comparisons.
|
||||
print "Fields (".join(", ", @field_names).") from records matching Device (".join(", ", @port_names)."):\n";
|
||||
print Dumper($ra_fields);
|
||||
|
||||
|
||||
# Create some gnuplot graphs. Probably there is a more clever way to do this by
|
||||
# passing arguments to gnuplot, but I am faster at perl than understanding gnuplot
|
||||
# at this point...
|
||||
|
||||
my $gp_base = "# gnuplot script file for plotting bandwidth over time
|
||||
#!/usr/bin/gnuplot
|
||||
reset
|
||||
set terminal png
|
||||
|
||||
set xdata time
|
||||
set timefmt \"\%s\"
|
||||
set format x \"\%M:\%S\"
|
||||
|
||||
set xlabel \"Date\"
|
||||
set ylabel \"__YLABEL__\"
|
||||
|
||||
set title \"__TITLE__\"
|
||||
set key below
|
||||
set grid
|
||||
plot \"$data_fname\" using __USING__ title \"__TITLE__\" with lines
|
||||
";
|
||||
|
||||
# Do text substitution of the gnuplot script for each graph.
|
||||
my $script_fname = "_gnuplot_script.txt";
|
||||
open(GP, ">$script_fname") || die("Can't open $script_fname for writing...\n");
|
||||
my $gpd = $gp_base;
|
||||
$gpd =~ s/__YLABEL__/Total Mbps Download/g;
|
||||
$gpd =~ s/__TITLE__/Total Mbps Download over Time/g;
|
||||
$gpd =~ s/__USING__/1\:2/g;
|
||||
|
||||
print GP $gpd;
|
||||
close(GP);
|
||||
system("gnuplot \"$script_fname\" > download_bps.png");
|
||||
|
||||
open(GP, ">$script_fname") || die("Can't open $script_fname for writing...\n");
|
||||
$gpd = $gp_base;
|
||||
$gpd =~ s/__YLABEL__/Total Mbps Upload/g;
|
||||
$gpd =~ s/__TITLE__/Total Mbps Upload over Time/g;
|
||||
$gpd =~ s/__USING__/1\:3/g;
|
||||
|
||||
print GP $gpd;
|
||||
close(GP);
|
||||
system("gnuplot \"$script_fname\" > upload_bps.png");
|
||||
|
||||
open(GP, ">$script_fname") || die("Can't open $script_fname for writing...\n");
|
||||
$gpd = $gp_base;
|
||||
$gpd =~ s/__YLABEL__/Total Mbps Upload+Download/g;
|
||||
$gpd =~ s/__TITLE__/Total Mbps Upload+Download over Time/g;
|
||||
$gpd =~ s/__USING__/1\:4/g;
|
||||
|
||||
print GP $gpd;
|
||||
close(GP);
|
||||
system("gnuplot \"$script_fname\" > ul_dl_bps.png");
|
||||
|
||||
print("See gnuplot generated files: ul_dl_bps.png, download_bps.png, upload_bps.png\n");
|
||||
|
||||
close(CMD_LOG);
|
||||
exit(0);
|
||||
|
||||
|
||||
sub run_cmd {
|
||||
my $cmd = shift;
|
||||
if (!$utils->isQuiet()) {
|
||||
print $cmd;
|
||||
print "\n";
|
||||
}
|
||||
my $rslt = `$cmd`;
|
||||
if (!$utils->isQuiet()) {
|
||||
print $rslt;
|
||||
print "\n";
|
||||
}
|
||||
return $rslt;
|
||||
}
|
||||
394
lf_zlt_binary.pl
Executable file
394
lf_zlt_binary.pl
Executable file
@@ -0,0 +1,394 @@
|
||||
#!/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);
|
||||
}
|
||||
52
list_phy_sta.sh
Executable file
52
list_phy_sta.sh
Executable file
@@ -0,0 +1,52 @@
|
||||
#!/bin/bash
|
||||
# this script lists wiphy stations per radio
|
||||
|
||||
[ -z "$MGR" ] && echo "$0 wants MGR set, bye" && exit 1
|
||||
[ -z "$RESRC" ] && echo "$0 wants RESRC set, bye" && exit 1
|
||||
[ -z "$RADIO" ] && echo "$0 wants RADIO set, bye" && exit 1
|
||||
|
||||
. ~/scripts/common.bash
|
||||
|
||||
LINKUP="link=UP"
|
||||
LINKDOWN="link=DOWN"
|
||||
LINKANY=""
|
||||
DEF_OUTFILE="${DEF_OUTFILE:-/tmp/wiphyNN-names.txt}"
|
||||
|
||||
OUTFILE="${DEF_OUTFILE/NN/$RADIO}"
|
||||
|
||||
[ -z "$OUTFILE" ] && echo "$0 wants OUTFILE set, use 'stdout' for stdout, bye" && exit 1
|
||||
|
||||
function helpquit() {
|
||||
echo "${D}MGR=localhost ${D}RESRC=1 ${D}RADIO=0 ${D}DEF_OUTFILE=$DEF_OUTFILE $0 --up|--down|--all\n"
|
||||
exit 1
|
||||
}
|
||||
|
||||
function firemod_list() {
|
||||
./lf_firemod.pl --mgr $MGR --resource $RESRC --action list_ports \
|
||||
| /usr/bin/perl -ne "/^((sta${RESRC}${RADIO}|wlan${RADIO})\d*) ${STATUS}/ && print ${Q}${D}1${N}${Q}"
|
||||
}
|
||||
|
||||
case "$1" in
|
||||
*up|*UP)
|
||||
STATUS=$LINKUP
|
||||
;;
|
||||
*down|*DOWN)
|
||||
STATUS=$LINKDOWN
|
||||
;;
|
||||
*all|*any|*ALL|*ANY)
|
||||
STATUS=$LINKANY
|
||||
;;
|
||||
*)
|
||||
helpquit
|
||||
;;
|
||||
esac
|
||||
|
||||
cd `dirname $0`
|
||||
|
||||
if [ "$OUTFILE" = "stdout" ]; then
|
||||
firemod_list | sort
|
||||
else
|
||||
firemod_list | sort > "$OUTFILE"
|
||||
fi
|
||||
|
||||
#
|
||||
257
min_max_ave_station.pl
Executable file
257
min_max_ave_station.pl
Executable file
@@ -0,0 +1,257 @@
|
||||
#!/usr/bin/perl -w
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
# This script looks for min-max-average bps for rx_rate in
|
||||
# a station csv data file
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
package main;
|
||||
$| = 1; # unbuffer output
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
use Carp;
|
||||
use Getopt::Long;
|
||||
use POSIX qw(locale_h);
|
||||
use locale;
|
||||
use Number::Format qw(format_number);
|
||||
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
our $TimeStamp = 0;
|
||||
our $Name = 1;
|
||||
our $Resource = 3;
|
||||
our $Tx_Pkts = 4;
|
||||
our $Tx_Packets = 4;
|
||||
our $Rx_Pkts = 5;
|
||||
our $Rx_Packets = 5;
|
||||
our $Tx_Bytes = 6;
|
||||
our $Rx_Bytes = 7;
|
||||
our $Rx_Signal = 25;
|
||||
our $Link_Speed = 26;
|
||||
our $Rx_Link_Speed = 27;
|
||||
|
||||
our $filename;
|
||||
our $start_time = 0;
|
||||
our $finish_time = time() * 1000;
|
||||
|
||||
our $usage = "$0 [-f|--filename # name of staX csv file]
|
||||
[-s|--start_time # timestamp milliseconds point to begin]
|
||||
[-e|--finish_time # timestamp milliseconds point to finish]
|
||||
|
||||
Example:
|
||||
$0 -f ./sta100_1.1.5_1429826436.csv # collect all entries
|
||||
|
||||
$0 -s 1429820000 -e 1429828000 -f ./sta100_1.1.5_1429826436.csv
|
||||
|
||||
We can use expanded unix datestamps as well:
|
||||
$0 -s \`date -d \"2014/11/25 10:00:00\" \"+%s000\"\` \\
|
||||
-e \`date -d \"2014/11/25 11:00:00\" \"+%s000\"\` \\
|
||||
-f ./sta100_1.1.5_1429826436.csv
|
||||
";
|
||||
|
||||
sub do_err_exit {
|
||||
my $msg = shift;
|
||||
print $msg."\n";
|
||||
exit(1);
|
||||
}
|
||||
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
# takes a reference to a string
|
||||
sub printRow {
|
||||
my $rs_line = shift;
|
||||
#print "LINE: $$rs_line\n";
|
||||
my @hunks = split(',', $$rs_line);
|
||||
my $msg =
|
||||
"TimeStamp : $hunks[$::TimeStamp]
|
||||
Name : $hunks[$::Name]
|
||||
Resource : $hunks[$::Resource]
|
||||
Tx_Pkts : $hunks[$::Tx_Pkts]
|
||||
Rx_Pkts : $hunks[$::Rx_Pkts]
|
||||
Tx_Bytes : $hunks[$::Tx_Bytes]
|
||||
Rx_Bytes : $hunks[$::Rx_Bytes]
|
||||
Rx_Signal : $hunks[$::Rx_Signal]
|
||||
Link_Speed : $hunks[$::Link_Speed]
|
||||
Rx_Link_Speed : $hunks[$::Rx_Link_Speed]\n\n";
|
||||
|
||||
print $msg;
|
||||
}
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
# takes a reference to an array
|
||||
sub printRowAt {
|
||||
my $ra_rows = shift;
|
||||
my $index = shift;
|
||||
my $row = $ra_rows->[$index];
|
||||
printRow( \$row );
|
||||
}
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
# M A I N #
|
||||
# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- #
|
||||
GetOptions (
|
||||
'filename|f=s' => \$::filename,
|
||||
'start_time|s=i' => \$::start_time,
|
||||
'finish_time|e=i' => \$::finish_time
|
||||
) || do_err_exit("$usage");
|
||||
|
||||
if ( ! defined $::filename || $::filename eq "" ) {
|
||||
do_err_exit($::usage);
|
||||
}
|
||||
if ( ! -f $::filename ) {
|
||||
do_err_exit("file not found");
|
||||
}
|
||||
open (my $input_fh, "<", $::filename) || do_err_exit($!);
|
||||
my @lines = <$input_fh>;
|
||||
close($input_fh);
|
||||
|
||||
#my $first_line = $lines[0];
|
||||
#printRow( \$first_line );
|
||||
#printRowAt( \@lines, 0 );
|
||||
|
||||
our $Orig = 0;
|
||||
our $Min = 1;
|
||||
our $Max = 2;
|
||||
our $Tot = 3;
|
||||
our $Total = 3;
|
||||
our $Ave = 4;
|
||||
our $Avg = 4;
|
||||
our $Delta = 5;
|
||||
our $Dt = 5;
|
||||
|
||||
my @begin_rx_bytes;
|
||||
my @begin_rx_packets;
|
||||
my @begin_rx_signal;
|
||||
my $begin_time = 0;
|
||||
|
||||
my @cur_rx_bytes;
|
||||
my @cur_rx_packets;
|
||||
my @cur_rx_signal;
|
||||
|
||||
my @prev_rx_bytes;
|
||||
my @prev_rx_packets;
|
||||
my @prev_rx_signal;
|
||||
|
||||
# first entry
|
||||
#my @hunks = split(',', $lines[ 1 ]);
|
||||
my $counted = 0;
|
||||
for( my $i = 2 ; $i < $#lines ; $i++ ) {
|
||||
my @hunks = split(',', $lines[$i]);
|
||||
|
||||
#print "start time: $::start_time\nfinish time: $::finish_time\ntime stamp : $hunks[$::TimeStamp]\n";
|
||||
next if ($hunks[ $::TimeStamp ] < $::start_time );
|
||||
last if ($hunks[ $::TimeStamp ] > $::finish_time );
|
||||
|
||||
if ($counted == 0) {
|
||||
$begin_time = $hunks[$::TimeStamp];
|
||||
$begin_rx_bytes[ $::Orig ] = $hunks[$::Rx_Bytes];
|
||||
$begin_rx_bytes[ $::Min ] = $hunks[$::Rx_Bytes];
|
||||
$begin_rx_bytes[ $::Max ] = $hunks[$::Rx_Bytes];
|
||||
$begin_rx_bytes[ $::Tot ] = $hunks[$::Rx_Bytes];
|
||||
$begin_rx_bytes[ $::Ave ] = $hunks[$::Rx_Bytes];
|
||||
$begin_rx_bytes[ $::Delta ] = 0;
|
||||
|
||||
$begin_rx_packets[ $::Orig ] = $hunks[$::Rx_Packets];
|
||||
$begin_rx_packets[ $::Min ] = $hunks[$::Rx_Packets];
|
||||
$begin_rx_packets[ $::Max ] = $hunks[$::Rx_Packets];
|
||||
$begin_rx_packets[ $::Tot ] = $hunks[$::Rx_Packets];
|
||||
$begin_rx_packets[$::Delta ] = 0;
|
||||
|
||||
$begin_rx_signal[ $::Orig ] = $hunks[$::Rx_Signal];
|
||||
$begin_rx_signal[ $::Min ] = $hunks[$::Rx_Signal];
|
||||
$begin_rx_signal[ $::Max ] = $hunks[$::Rx_Signal];
|
||||
$begin_rx_signal[ $::Tot ] = $hunks[$::Rx_Signal];
|
||||
$begin_rx_signal[$::Delta ] = 0;
|
||||
@cur_rx_bytes = @begin_rx_bytes;
|
||||
@cur_rx_packets = @begin_rx_packets;
|
||||
@cur_rx_signal = @begin_rx_signal;
|
||||
}
|
||||
@prev_rx_bytes = @cur_rx_bytes;
|
||||
@prev_rx_packets = @cur_rx_packets;
|
||||
@prev_rx_signal = @cur_rx_signal;
|
||||
|
||||
#printRowAt( \@lines, $i );
|
||||
|
||||
$cur_rx_bytes[ $::Orig ] = $hunks[ $::Rx_Bytes ];
|
||||
my $diff_rx = $hunks[ $::Rx_Bytes ] - $prev_rx_bytes[ $::Orig ];
|
||||
$cur_rx_bytes[ $::Delta ] = $diff_rx;
|
||||
|
||||
if ($hunks[$::Rx_Bytes]==0) {
|
||||
print "TimeStamp $hunks[$::TimeStamp] zero bytes\n";
|
||||
$cur_rx_bytes[ $::Min ] = 0;
|
||||
}
|
||||
elsif (($diff_rx < $prev_rx_bytes[ $::Delta ]) && ($diff_rx < $prev_rx_bytes[ $::Min ])) {
|
||||
if ($diff_rx == 0) {
|
||||
print "TimeStamp $hunks[$::TimeStamp] zero bytes diff\n";
|
||||
$cur_rx_bytes[ $::Min ] = $prev_rx_bytes[ $::Delta ];
|
||||
} else {
|
||||
$cur_rx_bytes[ $::Min ] = $diff_rx;
|
||||
}
|
||||
}
|
||||
if (($diff_rx > $prev_rx_bytes[ $::Delta ]) && ($diff_rx > $prev_rx_bytes[ $::Max ])) {
|
||||
$cur_rx_bytes[ $::Max ] = $diff_rx;
|
||||
}
|
||||
$cur_rx_bytes[ $::Tot ] = $hunks[ $::Rx_Bytes ] - $begin_rx_bytes[ $::Orig];
|
||||
|
||||
|
||||
|
||||
$cur_rx_packets[ $::Orig ] = $hunks[ $::Rx_Packets ];
|
||||
$diff_rx = $hunks[ $::Rx_Packets ] - $prev_rx_packets[ $::Orig ];
|
||||
$cur_rx_packets[ $::Delta ] = $diff_rx;
|
||||
|
||||
if ($hunks[$::Rx_Packets]==0) {
|
||||
print "TimeStamp $hunks[$::TimeStamp] zero packets\n";
|
||||
$cur_rx_packets[ $::Min ] = 0;
|
||||
}
|
||||
elsif (($diff_rx < $prev_rx_packets[ $::Delta ]) && ($diff_rx < $prev_rx_packets[ $::Min ])) {
|
||||
if ($diff_rx == 0) {
|
||||
print "TimeStamp $hunks[$::TimeStamp] zero packets diff\n";
|
||||
$cur_rx_packets[ $::Min ] = $prev_rx_packets[ $::Delta ];
|
||||
} else {
|
||||
$cur_rx_packets[ $::Min ] = $diff_rx;
|
||||
}
|
||||
}
|
||||
if (($diff_rx > $prev_rx_packets[ $::Delta ]) && ($diff_rx > $prev_rx_packets[ $::Max ])) {
|
||||
$cur_rx_packets[ $::Max ] = $diff_rx;
|
||||
}
|
||||
$cur_rx_packets[ $::Tot ] = $hunks[ $::Rx_Packets ] - $begin_rx_packets[ $::Orig ];
|
||||
|
||||
|
||||
$cur_rx_signal[ $::Orig ] = $hunks[ $::Rx_Signal ];
|
||||
$cur_rx_signal[ $::Min ] = $hunks[ $::Rx_Signal ] if ( $hunks[ $::Rx_Signal ] < $prev_rx_signal[ $::Min ]);
|
||||
$cur_rx_signal[ $::Max ] = $hunks[ $::Rx_Signal ] if ( $hunks[ $::Rx_Signal ] > $prev_rx_signal[ $::Max ]);
|
||||
$cur_rx_signal[ $::Tot ] = $prev_rx_signal[ $::Tot ] + $hunks[ $::Rx_Signal ];
|
||||
|
||||
$counted++;
|
||||
}
|
||||
my $seconds = ($finish_time - $begin_time + 1000) / 1000;
|
||||
|
||||
if ($seconds <= 0 || $counted <= 0) {
|
||||
do_err_exit("No records in range");
|
||||
}
|
||||
$cur_rx_bytes[ $Ave ] = $cur_rx_bytes[ $::Tot ] / $counted;
|
||||
$cur_rx_packets[ $Ave ] = $cur_rx_packets[ $::Tot ] / $counted;
|
||||
$cur_rx_signal[ $Ave ] = $cur_rx_signal[ $::Tot ] / $counted;
|
||||
|
||||
printf "Rx Bytes: Min_Bps: %15s Max_Bps: %15s Ave_Bps: %15s Total: %15s\n",
|
||||
format_number($cur_rx_bytes[ $::Min ]),
|
||||
format_number($cur_rx_bytes[ $::Max ]),
|
||||
format_number($cur_rx_bytes[ $Ave ]),
|
||||
format_number($cur_rx_bytes[ $::Tot ]);
|
||||
|
||||
printf "Rx bits/sec Min_bps: %15s Max_bps: %15s Ave_bps: %15s\n",
|
||||
format_number($cur_rx_bytes[ $::Min ] * 8),
|
||||
format_number($cur_rx_bytes[ $::Max ] * 8),
|
||||
format_number($cur_rx_bytes[ $Ave ] * 8);
|
||||
|
||||
printf "Rx Packets: Min_Pps: %15s Max_Pps: %15s Ave_Pps: %15s Total: %15s\n",
|
||||
format_number($cur_rx_packets[ $::Min ]),
|
||||
format_number($cur_rx_packets[ $::Max ]),
|
||||
format_number($cur_rx_packets[ $Ave ]),
|
||||
format_number($cur_rx_packets[ $::Tot ]);
|
||||
|
||||
printf "Rx Signal: Min_dB: %15s Max_dB: %16s Ave_dB: %15s\n",
|
||||
format_number($cur_rx_signal[ $::Min ]),
|
||||
format_number($cur_rx_signal[ $::Max ]),
|
||||
format_number($cur_rx_signal[ $Ave ]);
|
||||
print format_number($counted)." samples in ".format_number($seconds)." seconds\n";
|
||||
##
|
||||
##
|
||||
##
|
||||
181
multi_routers.pl
Executable file
181
multi_routers.pl
Executable file
@@ -0,0 +1,181 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
|
||||
# Clean up routing tables
|
||||
|
||||
remove_local_routing_table("rddC1");
|
||||
remove_local_routing_table("rddA2");
|
||||
remove_local_routing_table("rddA1");
|
||||
remove_local_routing_table("rddB1");
|
||||
remove_local_routing_table("rddD1");
|
||||
remove_local_routing_table("rddD2");
|
||||
remove_local_routing_table("rddE1");
|
||||
remove_routing_table(1001);
|
||||
remove_routing_table(1002);
|
||||
remove_routing_table(1003);
|
||||
|
||||
do_cmd("ip ru show");
|
||||
do_cmd("ip route show table 1001");
|
||||
do_cmd("ip route show table 1002");
|
||||
|
||||
# Set up router 1001
|
||||
set_ip("rddC1", "10.0.4.1", "10.0.4.0", "24", "10.0.4.255", "10.0.4.2", 1001);
|
||||
set_ip("rddA2", "10.0.3.1", "10.0.3.0", "24", "10.0.3.255", "10.0.3.2", 1001);
|
||||
set_ip("rddD1", "10.0.5.1", "10.0.5.0", "24", "10.0.5.255", "10.0.5.2", 1001);
|
||||
do_cmd("ip rule add to 10.0.5.1 iif rddC1 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
do_cmd("ip rule add to 10.0.5.1 iif rddA2 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
do_cmd("ip rule add to 10.0.3.1 iif rddC1 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
do_cmd("ip rule add to 10.0.3.1 iif rddD1 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
do_cmd("ip rule add to 10.0.4.1 iif rddA2 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
do_cmd("ip rule add to 10.0.4.1 iif rddD1 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
|
||||
# Set up router 1002
|
||||
set_ip("rddA1", "10.0.3.2", "10.0.3.0", "24", "10.0.3.255", "10.0.3.1", 1002);
|
||||
set_ip("rddB1", "10.0.2.1", "10.0.2.0", "24", "10.0.2.255", "10.0.2.2", 1002);
|
||||
do_cmd("ip rule add to 10.0.3.2 iif rddB1 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
do_cmd("ip rule add to 10.0.2.1 iif rddA1 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
|
||||
# Set up router 1003
|
||||
set_ip("rddD2", "10.0.5.2", "10.0.5.0", "24", "10.0.5.255", "10.0.5.1", 1003);
|
||||
set_ip("rddE1", "10.0.6.1", "10.0.6.0", "24", "10.0.6.255", "10.0.6.2", 1003);
|
||||
do_cmd("ip rule add to 10.0.5.2 iif rddE1 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
do_cmd("ip rule add to 10.0.6.1 iif rddD2 lookup local pref 10"); # use local routing table if it arrives here and is destined to peer.
|
||||
|
||||
|
||||
add_subnet_route("10.0.2.0/24", "10.0.3.2", "rddA2", 1001);
|
||||
add_subnet_route("10.0.6.0/24", "10.0.5.2", "rddD1", 1001);
|
||||
|
||||
add_subnet_route("10.0.4.0/24", "10.0.3.1", "rddA1", 1002);
|
||||
add_subnet_route("10.0.5.0/24", "10.0.3.1", "rddA1", 1002);
|
||||
add_subnet_route("10.0.6.0/24", "10.0.3.1", "rddA1", 1002);
|
||||
|
||||
add_subnet_route("10.0.4.0/24", "10.0.5.1", "rddD2", 1003);
|
||||
add_subnet_route("10.0.3.0/24", "10.0.5.1", "rddD2", 1003);
|
||||
add_subnet_route("10.0.2.0/24", "10.0.5.1", "rddD2", 1003);
|
||||
|
||||
|
||||
sub add_subnet_route {
|
||||
my $sn = shift;
|
||||
my $sn_gw = shift;
|
||||
my $dev = shift;
|
||||
my $rt = shift;
|
||||
|
||||
do_cmd("ip route add $sn via $sn_gw dev $dev table $rt"); # subnet route
|
||||
}
|
||||
|
||||
|
||||
sub set_ip {
|
||||
my $dev = shift; # network device name
|
||||
my $ip = shift; # ip
|
||||
my $sn = shift; # subnet addr
|
||||
my $mbits = shift; # mask bits (ie, 24)
|
||||
my $bcast = shift; # broadcast addr
|
||||
my $sn_gw = shift; # next hot for this subnet route
|
||||
my $rt = shift; # routing table
|
||||
|
||||
# Set it's IP address.
|
||||
do_cmd("ip link set $dev down");
|
||||
do_cmd("ip link set $dev up");
|
||||
do_cmd("ip addr flush dev $dev");
|
||||
do_cmd("ip addr add $ip/$mbits broadcast $bcast dev $dev");
|
||||
do_cmd("ip rule add to $ip iif $dev lookup local pref 10"); # use local routing table if it arrives here and is destined here.
|
||||
do_cmd("ip rule add iif $dev lookup $rt pref 20"); # use this table for pkts rx on this interface.
|
||||
do_cmd("ip rule add from $ip/32 table $rt pref 30"); # use this table for pkts from this IP
|
||||
do_cmd("ip route add $sn/$mbits via $ip table $rt"); # subnet route
|
||||
# Do default gateway on a per-router basis, not per-interface.
|
||||
|
||||
# Enable arp filtering.
|
||||
do_cmd("echo 1 > /proc/sys/net/ipv4/conf/$dev/arp_filter");
|
||||
}
|
||||
|
||||
|
||||
sub remove_routing_table {
|
||||
my $tid = shift;
|
||||
|
||||
my $listing = `ip ru list`;
|
||||
my @listings = split(/\n/, $listing);
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@listings; $q++) {
|
||||
my $line = $listings[$q];
|
||||
chomp($line);
|
||||
#print "Processing ip-ru-list line -:$line:-\n";
|
||||
my $num;
|
||||
my $from;
|
||||
my $arg;
|
||||
my @rest;
|
||||
|
||||
if ($line =~ /\S+:\s+\S+\s+(\S+)\s+.*lookup\s+(\S+)/) {
|
||||
my $a = $1;
|
||||
my $mtid = $2;
|
||||
|
||||
if ($a eq "all") {
|
||||
$a = "0/0";
|
||||
}
|
||||
|
||||
if ($tid eq $mtid) {
|
||||
my $cmd = "ip ru del from $a lookup $tid";
|
||||
do_cmd("$cmd");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$listing = `ip route show table $tid`;
|
||||
@listings = split(/\n/, $listing);
|
||||
$q = 0;
|
||||
for ($q = 0; $q<@listings; $q++) {
|
||||
my $line = $listings[$q];
|
||||
chomp($line);
|
||||
#print "Processing ip-ru-list line -:$line:-\n";
|
||||
|
||||
if ($line =~ /(\S+)\s+/) {
|
||||
my $key = $1;
|
||||
|
||||
if ($a eq "all") {
|
||||
$a = "0/0";
|
||||
}
|
||||
|
||||
my $cmd = "ip route del $key table $tid";
|
||||
do_cmd("$cmd");
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub remove_local_routing_table {
|
||||
my $dev = shift;
|
||||
|
||||
my $listing = `ip ru list`;
|
||||
my @listings = split(/\n/, $listing);
|
||||
my $q = 0;
|
||||
for ($q = 0; $q<@listings; $q++) {
|
||||
my $line = $listings[$q];
|
||||
chomp($line);
|
||||
#print "Processing ip-ru-list line -:$line:-\n";
|
||||
my $num;
|
||||
my $from;
|
||||
my $arg;
|
||||
my @rest;
|
||||
|
||||
if ($line =~ /.*\s+iif $dev\s+.*/) {
|
||||
if ($line =~ /\S+:\s+\S+\s+(\S+)\s+(.*)lookup local/) {
|
||||
my $a = $1;
|
||||
my $match = $2;
|
||||
|
||||
if ($a eq "all") {
|
||||
$a = "0/0";
|
||||
}
|
||||
|
||||
my $cmd = "ip ru del from $a $match lookup local";
|
||||
do_cmd("$cmd");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub do_cmd {
|
||||
my $cmd = shift;
|
||||
print "$cmd\n";
|
||||
system("$cmd");
|
||||
}
|
||||
85
rand_nc.pl
Executable file
85
rand_nc.pl
Executable file
@@ -0,0 +1,85 @@
|
||||
#!/usr/bin/perl
|
||||
#-------------------------------------------------------------------
|
||||
# FILE: rand_nc.pl
|
||||
# AUTH: Daniel Berry - wizatta@hotmail.com
|
||||
# VERS: 1.0 beta 4/07/04
|
||||
# DESC: Simple perl script to generate random arguments for nc
|
||||
# TCP port connections.
|
||||
#
|
||||
# Command line arguments: None
|
||||
#
|
||||
# There are 3 arrays controlling target execution
|
||||
#
|
||||
# @targ = for storage of IP addresses or FQDN
|
||||
# $targs = set to number of targets in @targ
|
||||
#
|
||||
# @srcIP = for storage of source IP addresses
|
||||
# $srcIps = set to number of source IP addresses
|
||||
#
|
||||
# @port = for storage of the target TCP ports
|
||||
# $ports = set to the number of ports in @port
|
||||
#
|
||||
#
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
# Target array - either IP address format or FQDN
|
||||
@targ = ('box1.target.net','box2.target.net');
|
||||
$targs = 2;
|
||||
|
||||
# Source IP address to use--should be assigned to system
|
||||
@srcIP = ('10.1.1.1','10.1.1.2','10.1.1.3','10.1.1.4');
|
||||
$srcIPs = 4;
|
||||
|
||||
|
||||
# TCP port to connect to
|
||||
@port = ('25','110','111','135','143','161','389','514','515','1080','1433','1521','8080');
|
||||
$ports = 13;
|
||||
|
||||
# Set pause length for timing - seconds
|
||||
$pausemin = 5;
|
||||
$pausemax = 90;
|
||||
|
||||
#
|
||||
# Create output log
|
||||
`echo "Netcat random TCP connection script..." >/tmp/nc_exe.log`;
|
||||
`date >>/tmp/nc_exe.log`;
|
||||
|
||||
#
|
||||
# Setup loop -- loop is continious until terminated
|
||||
#
|
||||
my $i = 0;
|
||||
while (1) {
|
||||
#
|
||||
# Random selection of target
|
||||
my $tgt = int(rand($targs));
|
||||
$tgtip = $targ[$tgt];
|
||||
|
||||
#
|
||||
# Select source IP address
|
||||
my $sIPn = int(rand($srcIPs));
|
||||
$sIP = $srcIP[$sIPn];
|
||||
|
||||
#
|
||||
# Select target TCP port
|
||||
my $eport = int(rand($ports));
|
||||
$tport = $port[$eport];
|
||||
|
||||
# Execute netcat connection from source IP to target IP and TCP port
|
||||
|
||||
print "nc TCP Connect TARG: $i \t Src_IP: $sIP \t IP: $tgtip \t PORT: $tport \n";
|
||||
`echo "nc TCP Connect TARG: $i \t Src_IP: $sIP \t IP: $tgtip \t PORT: $tport">>/tmp/nc_exe.log`;
|
||||
|
||||
`echo "^d"|/usr/bin/nc -v -w5 -s $sIP $tgtip $tport >>/tmp/nc_exe.log`;
|
||||
|
||||
|
||||
$i++;
|
||||
$pause = $pausemin + int(rand($pausemax));
|
||||
print "Sleeping $pause ...\n";
|
||||
|
||||
sleep $pause;
|
||||
}
|
||||
|
||||
#
|
||||
# End - script will terminate normally if all works correctly
|
||||
#
|
||||
#-------------------------------------------------------------------
|
||||
70
rand_nmap.pl
Executable file
70
rand_nmap.pl
Executable file
@@ -0,0 +1,70 @@
|
||||
#!/usr/bin/perl
|
||||
#-------------------------------------------------------------------
|
||||
# FILE: rand_nmap.pl
|
||||
# AUTH: Daniel Berry - wizatta@hotmail.com
|
||||
# VERS: 1.2 beta 3/08/04
|
||||
# DESC: Simple perl script to generate random arguments for nmap
|
||||
# scans.
|
||||
#
|
||||
# NOTE: For use with LANforge 4-port traffic generators using
|
||||
# standard nmap executable.
|
||||
#
|
||||
# Command line arguments: None
|
||||
#
|
||||
# There are 2 arrays controlling target execution
|
||||
#
|
||||
# @targ = for storage of IP addresses of FQDN
|
||||
# $targs = set to number of targets in @targ
|
||||
#
|
||||
# @port = for storage of the local ethernet ports
|
||||
# $ports = set to the number of ports in @port
|
||||
#
|
||||
#
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
# Target array - either IP address format or FQDN
|
||||
@targ = ('10.1.1.1-254','10.1.2.1-254');
|
||||
$targs = 2;
|
||||
|
||||
# Ethernet port to use (eth1-4)
|
||||
@port = ('eth4#1','eth4#2','eth4#3');
|
||||
$ports = 3;
|
||||
|
||||
# Set pause length for timing - seconds
|
||||
$pause = 1800;
|
||||
|
||||
#
|
||||
# Setup loop -- loop is continious until terminated
|
||||
#
|
||||
my $i = 0;
|
||||
while (1) {
|
||||
#
|
||||
# Random selection of target
|
||||
my $tgt = int(rand($targs));
|
||||
$tgtip = $targ[$tgt];
|
||||
|
||||
#
|
||||
# Select source eth port
|
||||
my $eport = int(rand($ports));
|
||||
$srcport = $port[$eport];
|
||||
|
||||
# Execute nmap TCP Connect scan from source port to target
|
||||
|
||||
print "nmap TCP Connect scan TARG: $i \t IP: $tgtip \t ETH: $srcport \n";
|
||||
|
||||
$stuff = `/usr/bin/nmap -e $srcport -sT -o /tmp/nmap_exe.log $tgtip`;
|
||||
|
||||
# Write output of execution to log
|
||||
open (FILE, ">/tmp/nmap.log");
|
||||
print FILE $stuff;
|
||||
close (FILE);
|
||||
|
||||
$i++;
|
||||
print "Sleeping $pause ...\n";
|
||||
sleep $pause;
|
||||
}
|
||||
|
||||
#
|
||||
# End - script will terminate normally if all works correctly
|
||||
#
|
||||
#-------------------------------------------------------------------
|
||||
29
show-port-from-json.pl
Executable file
29
show-port-from-json.pl
Executable file
@@ -0,0 +1,29 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
use JSON;
|
||||
use Data::Dumper;
|
||||
use LANforge::GuiJson qw(GuiResponseToHash GetHeaderMap GetRecordsMatching GetFields);
|
||||
package main;
|
||||
|
||||
my $respdata=`curl -s http://localhost:8080/PortTab`;
|
||||
#my $ra_ports_data = decode_json($respdata);
|
||||
my $ra_resp_map = GuiResponseToHash($respdata);
|
||||
my $ra_header = GetHeaderMap($ra_resp_map->{'header'});
|
||||
#print Dumper($ra_header);
|
||||
|
||||
my $ra_matches = GetRecordsMatching($ra_resp_map, 'Port', ["eth0", "wlan0"]);
|
||||
#print "Records matching Port:\n";
|
||||
#print Dumper($ra_matches);
|
||||
|
||||
my @port_names = ("eth0", "wlan0");
|
||||
$ra_matches = GetRecordsMatching($ra_resp_map, 'Device', \@port_names);
|
||||
#print "Records matching Port:\n";
|
||||
#print Dumper($ra_matches);
|
||||
|
||||
my @field_names = ("bps TX", "bps RX");
|
||||
my $ra_fields = GetFields($ra_resp_map, 'Device', \@port_names, \@field_names);
|
||||
print "Fields (".join(", ", @field_names).") from records matching Device (".join(", ", @port_names)."):\n";
|
||||
print Dumper($ra_fields);
|
||||
46
station-toggle.sh
Executable file
46
station-toggle.sh
Executable file
@@ -0,0 +1,46 @@
|
||||
#!/bin/bash
|
||||
##### ##### ##### ##### ##### ##### ##### ##### ##### ##### #####
|
||||
## ##
|
||||
## Use this script to toggle a set of stations on or off ##
|
||||
## ##
|
||||
##### ##### ##### ##### ##### ##### ##### ##### ##### ##### #####
|
||||
|
||||
function usage() {
|
||||
echo "$0 -a up -s staX,staY,staZ..."
|
||||
echo " to turn stations on"
|
||||
echo "$0 -a down -s staX,staY,staZ..."
|
||||
echo " to turn stations off"
|
||||
}
|
||||
|
||||
action=none
|
||||
stations=""
|
||||
while getopts ":a:s:" opt ; do
|
||||
case "${opt}" in
|
||||
a) action="${OPTARG}";;
|
||||
s) stations="${OPTARG}";;
|
||||
*) exit 1;;
|
||||
esac
|
||||
done
|
||||
shift $(( OPTIND - 1 ));
|
||||
|
||||
[ -z "$stations" ] && echo "No stations specified." && usage && exit 1
|
||||
|
||||
[[ $action = none ]] && echo "No action specified." && usage && exit 1
|
||||
|
||||
scriptdir="/home/lanforge/scripts"
|
||||
portmod="$scriptdir/lf_portmod.pl"
|
||||
cd $scriptdir
|
||||
IFS=',' sta_list=($stations)
|
||||
if [[ $action = up ]] || [[ $action = down ]] ; then
|
||||
for sta in "${sta_list[@]}"; do
|
||||
echo "station $sta $action"
|
||||
$portmod --port_name $sta --set_ifstate $action --quiet 1
|
||||
done
|
||||
exit 0
|
||||
else
|
||||
echo "What does action $action mean?"
|
||||
usage
|
||||
exit 1
|
||||
fi
|
||||
|
||||
#
|
||||
9
telnet_expect_wrapper.pl
Executable file
9
telnet_expect_wrapper.pl
Executable file
@@ -0,0 +1,9 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
my $i = 0;
|
||||
while (1) {
|
||||
`/home/lanforge/telnet.expect`;
|
||||
print "Completed telnet connection $i\n";
|
||||
$i++;
|
||||
}
|
||||
|
||||
186
wait_on_ports.pl
Executable file
186
wait_on_ports.pl
Executable file
@@ -0,0 +1,186 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
|
||||
$| = 1;
|
||||
use Net::Telnet ();
|
||||
use LANforge::Utils;
|
||||
use Getopt::Long;
|
||||
|
||||
package main;
|
||||
# we want to take the list of ports on ARGV and wait until they are up
|
||||
|
||||
exit 0 if (@ARGV < 1);
|
||||
|
||||
my $card = 1;
|
||||
my $mgr = "localhost";
|
||||
my $mgr_port = "4001";
|
||||
my @port_list = ();
|
||||
our $quiet = 1;
|
||||
my $require_ip = 1;
|
||||
our $verbose = -1;
|
||||
my %down_count = ();
|
||||
my $shove_level = 4; # count at which a lf_portmod trigger gets called
|
||||
|
||||
sub help() {
|
||||
print "$0 --mgr $mgr \\
|
||||
--mgr_port $mgr_port \\
|
||||
--card $card \\
|
||||
--quiet $::quiet \\
|
||||
--require_ip $require_ip \\
|
||||
--verbose 0|1 \\
|
||||
--port sta1 -p sta2 -p sta3...\n";
|
||||
}
|
||||
|
||||
# should move to Utils
|
||||
sub fmt_port_up_down {
|
||||
my ($resource, $port_id, $state) = @_;
|
||||
|
||||
my $cur_flags = 0;
|
||||
if ($state eq "down") {
|
||||
$cur_flags |= 0x1; # port down
|
||||
}
|
||||
|
||||
# Specify the interest flags so LANforge knows which flag bits to pay attention to.
|
||||
my $ist_flags = 0;
|
||||
$ist_flags |= 0x2; # check current flags
|
||||
$ist_flags |= 0x800000; # port down
|
||||
|
||||
my $cmd = $::utils->fmt_cmd("set_port", 1, $resource, $port_id, "NA",
|
||||
"NA", "NA", "NA", "$cur_flags",
|
||||
"NA", "NA", "NA", "NA", "$ist_flags");
|
||||
return $cmd;
|
||||
}
|
||||
|
||||
|
||||
my $p = new Getopt::Long::Parser;
|
||||
$p->configure('pass_through');
|
||||
|
||||
GetOptions (
|
||||
'mgr:s' => \$mgr,
|
||||
'mgr_port:i' => \$mgr_port,
|
||||
'card|resource:i' => \$card,
|
||||
'quiet|q:s' => \$::quiet,
|
||||
'ports|p:s@' => \@port_list,
|
||||
'require_ip:i' => \$require_ip,
|
||||
'v:i' => \$verbose,
|
||||
) || die help();
|
||||
|
||||
if ($::quiet eq "0") {
|
||||
$::quiet = "no";
|
||||
}
|
||||
elsif ($::quiet eq "1") {
|
||||
$::quiet = "yes";
|
||||
}
|
||||
|
||||
my $t = new Net::Telnet(
|
||||
Prompt => '/default\@btbits\>\>/',
|
||||
Timeout => 20);
|
||||
|
||||
$t->open(Host => $mgr,
|
||||
Port => $mgr_port,
|
||||
Timeout => 10);
|
||||
|
||||
$t->waitfor("/btbits\>\>/");
|
||||
# Configure our utils.
|
||||
our $utils = new LANforge::Utils();
|
||||
$::utils->telnet($t);
|
||||
$::utils{'quiet'} = $::quiet;
|
||||
if ($::utils->isQuiet()) {
|
||||
if (defined $ENV{'LOG_CLI'} && $ENV{'LOG_CLI'} ne "") {
|
||||
$::utils->cli_send_silent(0);
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(1); # Do not show input to telnet
|
||||
}
|
||||
$::utils->cli_rcv_silent(1); # Repress output from telnet
|
||||
}
|
||||
else {
|
||||
$::utils->cli_send_silent(0); # Show input to telnet
|
||||
$::utils->cli_rcv_silent(0); # Show output from telnet
|
||||
}
|
||||
|
||||
die("No resource defined, bye.") if (! defined $card);
|
||||
my $num_ports_down = @port_list;
|
||||
my $state = undef;
|
||||
my $ip = undef;
|
||||
if ($verbose > 2) {
|
||||
print "\nWe have ".(0+@port_list)." ports: ".join(",", sort @port_list), "\n";
|
||||
}
|
||||
|
||||
while( $num_ports_down > 0 ) {
|
||||
my @ports_up = ();
|
||||
my @ports_down = ();
|
||||
for my $port (sort @port_list) {
|
||||
my $statblock = $utils->doAsyncCmd($utils->fmt_cmd("nc_show_port", 1, $card, $port));
|
||||
#print $statblock;
|
||||
|
||||
print " $port " if ($verbose > 3);
|
||||
($state) = $statblock =~ /^\s+Current:\s+([^ ]+)/m;
|
||||
($ip) = $statblock =~ /^\s+IP:\s+([^ ]+)/m;
|
||||
|
||||
if (! defined $state) {
|
||||
print "STATE undefined: $statblock\n";
|
||||
}
|
||||
if (! defined $ip) {
|
||||
print "IP undefined: $statblock\n";
|
||||
}
|
||||
|
||||
#print "\n$port is [$state] ";# if ($quiet =~ /0|no/i);
|
||||
#print "\n$ip has [$ip] " ;#if ($quiet =~ /0|no/i);
|
||||
if ($require_ip) {
|
||||
if (($state !~ /down/i) && ($ip !~ /0\.0\.0\.0/)) {
|
||||
$num_ports_down--;
|
||||
push(@ports_up, $port);
|
||||
print "+" if ($verbose > 0);
|
||||
$down_count{$port} = 0;
|
||||
}
|
||||
else {
|
||||
print "-" if ($verbose > 0);
|
||||
push(@ports_down, $port);
|
||||
$down_count{$port}++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ($state =~ /down/i) {
|
||||
push(@ports_down, $port);
|
||||
print "-" if ($verbose > 0);
|
||||
$down_count{$port}++;
|
||||
}
|
||||
else {
|
||||
$num_ports_down--;
|
||||
print "=" if ($verbose > 0);
|
||||
push(@ports_up, $port);
|
||||
$down_count{$port} = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($verbose > 1) {
|
||||
my $num_ports = @port_list;
|
||||
my $num_ports_up = @ports_up;
|
||||
print "\n\n${num_ports_up}/${num_ports} Ports up: ".join(", ", @ports_up )."\n"
|
||||
if ($verbose > 2);
|
||||
print "\n${num_ports_down}/${num_ports} Ports down: ".join(", ", @ports_down )."\n";
|
||||
}
|
||||
if ($num_ports_down > 0) {
|
||||
for my $port (sort keys %down_count) {
|
||||
my $strikes = $down_count{$port};
|
||||
if ($strikes >= $shove_level) {
|
||||
print "Shoving port $port\n";
|
||||
my $cli_cmd = fmt_port_up_down($card, $port, "down");
|
||||
$utils->doCmd($cli_cmd);
|
||||
sleep(0.5);
|
||||
$cli_cmd = fmt_port_up_down($card, $port, "up");
|
||||
$utils->doCmd($cli_cmd);
|
||||
$down_count{$port} = 0;
|
||||
}
|
||||
}
|
||||
$num_ports_down = @port_list;
|
||||
print " ";
|
||||
print "Napping...\n" if ($verbose > 1);
|
||||
sleep 4;
|
||||
}
|
||||
}
|
||||
print "All ports up.\n" if ($verbose > 0);
|
||||
#
|
||||
70
wifi-event-histo.sh
Executable file
70
wifi-event-histo.sh
Executable file
@@ -0,0 +1,70 @@
|
||||
#!/bin/bash
|
||||
set +x
|
||||
if [[ x"$1" = x ]]; then
|
||||
echo "want a filename, bye"
|
||||
exit 1
|
||||
fi
|
||||
echo -n "* WIFI-connection events: "
|
||||
grep 'connected to' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* Wifi auth events: "
|
||||
grep ' auth .* status: 0' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* Roaming attempt before association: {too_early}: "
|
||||
grep '{too_early}' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* DHCP Failure: "
|
||||
grep 'DHCP Failure' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* Skipped Roam-to-Self events: "
|
||||
fgrep 'already associated with AP' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* Roam verify failure: "
|
||||
grep 'WARNING: Requested' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* Not associated:"
|
||||
grep 'Not-Associated' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* Link Down: "
|
||||
grep 'Link DOWN' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* Link Up: "
|
||||
grep 'Link UP' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* first_page_load: "
|
||||
grep 'first_page_load' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* saw_http_redirect: "
|
||||
grep 'saw_http_redirect' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* find_redirect_url: "
|
||||
grep find_redirect_url "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* request meta redirect: "
|
||||
grep "request meta redirect" "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* redirect_response: "
|
||||
grep redirect_response "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* submitting .*guest: "
|
||||
grep 'submitting .*guest' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* response from .*guest: "
|
||||
grep 'response from .*guest' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* submitting .*securelogin: "
|
||||
grep 'submitting .*securelogin' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* response from .*securelogin: "
|
||||
grep 'response from .*securelogin' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* portal_login: OK -LOGIN: "
|
||||
grep 'portal_login: OK -LOGIN' "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* missing_redirect: "
|
||||
grep missing_redirect "$1" | sort | uniq | wc -l
|
||||
|
||||
echo -n "* submit_start_url did not see redirect: "
|
||||
grep 'submit_start_url did not see redirect' "$1" | sort | uniq | wc -l
|
||||
|
||||
#
|
||||
131
wifi-roaming-times.pl
Executable file
131
wifi-roaming-times.pl
Executable file
@@ -0,0 +1,131 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
use strict;
|
||||
use warnings;
|
||||
use diagnostics;
|
||||
use Carp;
|
||||
$SIG{__DIE__} = sub{Carp::confess(@_)};
|
||||
use Getopt::Long;
|
||||
use Time::HiRes qw(usleep);
|
||||
use List::Util qw(sum min max);
|
||||
|
||||
$| = 1;
|
||||
package main;
|
||||
our @file_lines;
|
||||
our $success_counter = 0;
|
||||
our $fail_counter = 0;
|
||||
our %station_names = ();
|
||||
our @association_times = ();
|
||||
die "Want a wpa_supplicant_log.wiphyX file please, bye.\n"
|
||||
unless(defined $ARGV[0]);
|
||||
|
||||
die "I can't find $ARGV[0], sorry."
|
||||
unless(-f $ARGV[0]);
|
||||
|
||||
die $!
|
||||
unless open(my $fh, "<", $ARGV[0]);
|
||||
@file_lines = <$fh>;
|
||||
close $fh;
|
||||
chomp(@file_lines);
|
||||
|
||||
# survey for all the station names
|
||||
#
|
||||
for (@file_lines) {
|
||||
next unless /: (sta\d+): /;
|
||||
$station_names{ $1 } = 0
|
||||
unless(defined $station_names{ $1 } );
|
||||
}
|
||||
print "Found these stations: ";
|
||||
while( my($k, $v)= each %station_names) {
|
||||
print "$k, ";
|
||||
}
|
||||
print "\n";
|
||||
|
||||
# for each station, find the BSS of the thing it's attempting to roam for
|
||||
while( my($sta, $v)= each %station_names) {
|
||||
my @lines_by_station = grep {/: $sta: /} @file_lines;
|
||||
#print "lines for $sta: ".@lines_by_station."\n";
|
||||
my $is_roam_attempt = 0;
|
||||
my $target_bss = "";
|
||||
my $prev_bss = "";
|
||||
my $time_roam_start = 0;
|
||||
my $time_roam_stop = 0;
|
||||
my $time_roam_delta = 0;
|
||||
my @roam_lines = ();
|
||||
usleep(50000);
|
||||
for (@lines_by_station) {
|
||||
#print "$sta : $is_roam_attempt, $target_bss, $prev_bss, $fail_counter, $success_counter\n";
|
||||
if (/ SME: Trying to authenticate with ([^ ]+) /) {
|
||||
if ($is_roam_attempt == 1) {
|
||||
$fail_counter ++ ;
|
||||
$prev_bss = $target_bss;
|
||||
}
|
||||
|
||||
#print "$sta trying bss $1\n";
|
||||
|
||||
$is_roam_attempt = 1;
|
||||
$target_bss = $1;
|
||||
($time_roam_start) = /^(\d+\.\d+): /;
|
||||
next;
|
||||
}
|
||||
push(@roam_lines, $_);
|
||||
# else we're in the middle of a roaming attemt
|
||||
if (/: CTRL-EVENT-CONNECTED - Connection to ([0-9A-Fa-f:]+) completed/) {
|
||||
#print "connected bss $1\n";
|
||||
die "aaaa!"
|
||||
if ($target_bss eq "");
|
||||
if ($prev_bss eq $1) {
|
||||
#print "Roam to self? $prev_bss\n";
|
||||
#print join("\n", @roam_lines)."\n";
|
||||
}
|
||||
|
||||
$is_roam_attempt = 0;
|
||||
if ($target_bss eq $1) {
|
||||
$success_counter ++ ;
|
||||
$prev_bss = $target_bss;
|
||||
}
|
||||
|
||||
($time_roam_stop) = $_ =~ /^(\d+\.\d+): /;
|
||||
$time_roam_delta = $time_roam_stop - $time_roam_start;
|
||||
die ("What an unlikely roam time you have my dear: $time_roam_delta")
|
||||
if ($time_roam_delta <= 0);
|
||||
|
||||
#print "$sta roam to $target_bss in $time_roam_delta\n";
|
||||
push(@association_times, $time_roam_delta);
|
||||
@roam_lines = ();
|
||||
$time_roam_start = 0;
|
||||
$time_roam_stop = 0;
|
||||
$time_roam_delta = 0;
|
||||
}
|
||||
#usleep(5000);
|
||||
|
||||
} # ~for
|
||||
|
||||
#my $ave = sum(@association_times)/@association_times
|
||||
# unless (@association_times < 1);
|
||||
#
|
||||
# print "$sta +$success_counter -$fail_counter > $ave\n"
|
||||
|
||||
} # ~while
|
||||
|
||||
my $ave = sum(@association_times)/@association_times
|
||||
unless (@association_times < 1);
|
||||
my $min = min(@association_times);
|
||||
my $max = max(@association_times);
|
||||
|
||||
my $i = 0;
|
||||
for (sort {$a <=> $b} @association_times) {
|
||||
print "$_ " if ($i <= 9);
|
||||
print "$_ " if ($i >= @association_times -9);
|
||||
$i++;
|
||||
}
|
||||
print "\n";
|
||||
|
||||
print "Roam Successes: $success_counter\n";
|
||||
print "Roam Failures: $fail_counter\n";
|
||||
print "Min/Ave/Max: $min $ave $max\n";
|
||||
|
||||
|
||||
# find CTRL-EVENT-CONNECTED and if we connect to that BSS we're good
|
||||
# compute a time factor, and record it
|
||||
|
||||
Reference in New Issue
Block a user