From 72712ff5487b1fe1e7c4abba09f0bf5461655155 Mon Sep 17 00:00:00 2001 From: Ben Greear Date: Fri, 6 Oct 2017 13:41:50 -0700 Subject: [PATCH] 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. --- associate_loop.sh | 158 ++++ attenuator_series.pl | 364 ++++++++ brent_showport.sh | 61 ++ create-mounts.sh | 101 +++ fanctl_lf0312.pl | 68 ++ ftp-upload.pl | 105 +++ imix.pl | 460 ++++++++++ lf_associate_ap.pl | 1659 ++++++++++++++++++++++++++++++++++++ lf_attenmod.pl | 129 +++ lf_auto_wifi_cap.pl | 259 ++++++ lf_cmc_macvlan.pl | 802 +++++++++++++++++ lf_create_bcast.pl | 291 +++++++ lf_cycle_wanlinks.pl | 52 ++ lf_endp_script.pl | 250 ++++++ lf_firemod.pl | 727 ++++++++++++++++ lf_ice.pl | 375 ++++++++ lf_icemod.pl | 194 +++++ lf_l4_auth.pl | 292 +++++++ lf_l4_reset.sh | 128 +++ lf_log_parse.pl | 22 + lf_loop_traffic.sh | 70 ++ lf_macvlan.pl | 1509 ++++++++++++++++++++++++++++++++ lf_macvlan2.pl | 654 ++++++++++++++ lf_macvlan3.pl | 630 ++++++++++++++ lf_macvlan_l4.pl | 813 ++++++++++++++++++ lf_macvlan_streams.pl | 723 ++++++++++++++++ lf_many_conn.pl | 469 ++++++++++ lf_many_conn2.pl | 423 +++++++++ lf_many_vphy.pl | 32 + lf_max_cxs_v1_3000.pl | 1749 ++++++++++++++++++++++++++++++++++++++ lf_mcast.bash | 39 + lf_monitor.pl | 267 ++++++ lf_netoptics.pl | 762 +++++++++++++++++ lf_nfs_io.pl | 1066 +++++++++++++++++++++++ lf_parse_tshark_log.pl | 87 ++ lf_port_walk.pl | 279 ++++++ lf_portmod.pl | 440 ++++++++++ lf_show_events.pl | 83 ++ lf_sta_name.pl | 190 +++++ lf_staggered_dl.sh | 299 +++++++ lf_stress1.pl | 257 ++++++ lf_stress2.pl | 234 +++++ lf_stress3.pl | 297 +++++++ lf_stress4.pl | 230 +++++ lf_verify.pl | 823 ++++++++++++++++++ lf_voip.pl | 882 +++++++++++++++++++ lf_voip_test.pl | 1121 ++++++++++++++++++++++++ lf_vue_mod.sh | 374 ++++++++ lf_wifi_rest_example.pl | 574 +++++++++++++ lf_zlt_binary.pl | 394 +++++++++ list_phy_sta.sh | 52 ++ min_max_ave_station.pl | 257 ++++++ multi_routers.pl | 181 ++++ rand_nc.pl | 85 ++ rand_nmap.pl | 70 ++ show-port-from-json.pl | 29 + station-toggle.sh | 46 + telnet_expect_wrapper.pl | 9 + wait_on_ports.pl | 186 ++++ wifi-event-histo.sh | 70 ++ wifi-roaming-times.pl | 131 +++ 61 files changed, 23383 insertions(+) create mode 100755 associate_loop.sh create mode 100755 attenuator_series.pl create mode 100755 brent_showport.sh create mode 100755 create-mounts.sh create mode 100755 fanctl_lf0312.pl create mode 100755 ftp-upload.pl create mode 100755 imix.pl create mode 100755 lf_associate_ap.pl create mode 100755 lf_attenmod.pl create mode 100755 lf_auto_wifi_cap.pl create mode 100755 lf_cmc_macvlan.pl create mode 100755 lf_create_bcast.pl create mode 100755 lf_cycle_wanlinks.pl create mode 100755 lf_endp_script.pl create mode 100755 lf_firemod.pl create mode 100755 lf_ice.pl create mode 100755 lf_icemod.pl create mode 100755 lf_l4_auth.pl create mode 100755 lf_l4_reset.sh create mode 100755 lf_log_parse.pl create mode 100755 lf_loop_traffic.sh create mode 100755 lf_macvlan.pl create mode 100755 lf_macvlan2.pl create mode 100755 lf_macvlan3.pl create mode 100755 lf_macvlan_l4.pl create mode 100755 lf_macvlan_streams.pl create mode 100755 lf_many_conn.pl create mode 100755 lf_many_conn2.pl create mode 100755 lf_many_vphy.pl create mode 100755 lf_max_cxs_v1_3000.pl create mode 100755 lf_mcast.bash create mode 100755 lf_monitor.pl create mode 100755 lf_netoptics.pl create mode 100755 lf_nfs_io.pl create mode 100755 lf_parse_tshark_log.pl create mode 100755 lf_port_walk.pl create mode 100755 lf_portmod.pl create mode 100755 lf_show_events.pl create mode 100755 lf_sta_name.pl create mode 100755 lf_staggered_dl.sh create mode 100755 lf_stress1.pl create mode 100755 lf_stress2.pl create mode 100755 lf_stress3.pl create mode 100755 lf_stress4.pl create mode 100755 lf_verify.pl create mode 100755 lf_voip.pl create mode 100755 lf_voip_test.pl create mode 100755 lf_vue_mod.sh create mode 100755 lf_wifi_rest_example.pl create mode 100755 lf_zlt_binary.pl create mode 100755 list_phy_sta.sh create mode 100755 min_max_ave_station.pl create mode 100755 multi_routers.pl create mode 100755 rand_nc.pl create mode 100755 rand_nmap.pl create mode 100755 show-port-from-json.pl create mode 100755 station-toggle.sh create mode 100755 telnet_expect_wrapper.pl create mode 100755 wait_on_ports.pl create mode 100755 wifi-event-histo.sh create mode 100755 wifi-roaming-times.pl diff --git a/associate_loop.sh b/associate_loop.sh new file mode 100755 index 000000000..9d4392bff --- /dev/null +++ b/associate_loop.sh @@ -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... -a SSIDA -b SSIDB -n -i + -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 diff --git a/attenuator_series.pl b/attenuator_series.pl new file mode 100755 index 000000000..8a850da2f --- /dev/null +++ b/attenuator_series.pl @@ -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 diff --git a/brent_showport.sh b/brent_showport.sh new file mode 100755 index 000000000..4465d7c61 --- /dev/null +++ b/brent_showport.sh @@ -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." diff --git a/create-mounts.sh b/create-mounts.sh new file mode 100755 index 000000000..dbf3d7536 --- /dev/null +++ b/create-mounts.sh @@ -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 " + 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 diff --git a/fanctl_lf0312.pl b/fanctl_lf0312.pl new file mode 100755 index 000000000..a4a854aec --- /dev/null +++ b/fanctl_lf0312.pl @@ -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"); + +# diff --git a/ftp-upload.pl b/ftp-upload.pl new file mode 100755 index 000000000..15e6397de --- /dev/null +++ b/ftp-upload.pl @@ -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 +## diff --git a/imix.pl b/imix.pl new file mode 100755 index 000000000..bc1b164bd --- /dev/null +++ b/imix.pl @@ -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 diff --git a/lf_associate_ap.pl b/lf_associate_ap.pl new file mode 100755 index 000000000..044da68ea --- /dev/null +++ b/lf_associate_ap.pl @@ -0,0 +1,1659 @@ +#!/usr/bin/perl -w +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## LANforge server script for associating virtual stations +## to an arbitrary SSID. You have options for creating a series +## of Layer-3 connections per station created. Support for various +## security modes for stations: wep, wpa, wpa2. +## +## Install: +## copy this script to /home/lanforge/scripts +## +## Preparation: +## This script expects a free radio (like wiphy0) to create +## wifi stations on. It also expects an upstream wired port to +## make tcp connections to. These ports should be able to +## communicate with each other. +## +## Usage Overview: +## Use -h to show options. +## There are two activities that this script presently performs: +## +## Step1: create 1 wifi station, pass traffic to the upstream port +## back and forth, and then disassociate. This activity could +## be split into several steps if testing traffic up- or +## down-stream only is desired. +## +## Step2: create many wifi stations, wait until we see IPs appear +## on them and then disassociate all of them. This activity could +## also be modified to test for wifi association instead of address +## aquisition. The present example uses static address assignment. +## +## add: create and delete WiFi Virtual Radios. Also has option to +## create station on specified virtual radio. +## +## (C) 2013, Candela Technologies Inc. support@candelatech.com +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +package main; +use strict; +use warnings; +use diagnostics; +use Carp; +#$SIG{ __DIE__ } = sub { Carp::confess( @_ ) }; +#$SIG{ __WARN__ } = sub { Carp::confess( @_ ) }; +use POSIX qw(ceil floor); +use Scalar::Util; #::looks_like_number; +use Getopt::Long; + +use Socket; + +# Un-buffer output +$| = 1; +use Cwd qw(getcwd); +my $cwd = getcwd(); + + # this is pedantic necessity for the following use statements +if ( $cwd =~ q(.*LANforge-Server\scripts$)) { + use lib '/home/lanforge/scripts' +} +else { + use lib '/home/lanforge/scripts'; +} +use List::Util qw(first); +use LANforge::Endpoint; +use LANforge::Port; +use LANforge::Utils; +use Net::Telnet (); + +our $num_stations = 1; +our $netmask = "255.255.0.0"; +our $default_ip_addr = "DHCP"; # or IP +my $log_cli = "unset"; # use ENV{'LOG_CLI'} + +# the upstream port should have an IP in same subnet range +# and we're assuming the port is on the same resource (1). +our $upstream_port = "eth1"; # Step 1 upstream port +our $sta_wiphy = "wiphy0"; # physical parent (radio) of virtual stations +our %wiphy_bssids = (); +our $admin_down_on_add = 0; +our $ssid; +our $first_sta = "sta100"; +our $passphrase = ''; +our $min_tx = "10000000"; +our $max_tx = "SAME"; +our $security = "open"; +our $xsec = ""; # extra 802.1* options: use-11u,use-11u-internet,use-dot1x +our %sec_options = ( + "open" => 0x0, + "wpa" => 0x10, + "wep" => 0x200, + "wpa2" => 0x400, + "no-ht40" => 0x800, # Disable ht-40 + "use-scan-ssid" => 0x1000, # Enable SCAN-SSID flag in wpa_supplicant. + "use-pasv-scan" => 0x2000, # Use passive scanning (don't send probe requests). + "no-sgi" => 0x4000, # Disable SGI (Short Guard Interval). + "use-radio-migration" => 0x8000, # OK-To-Migrate (Allow migration between LANforge radios) + "use-more-debug" => 0x10000, # Verbose-Debug: more info in wpa-supplicant and hostapd logs. + "use-11u" => 0x20000, # Enable 802.11u (Interworking) feature. + "use-11u-auto" => 0x40000, # Enable 802.11u (I...) Auto-internetworking. Always enabled currently. + "use-11u-internet" => 0x80000, # AP Provides access to internet (802.11u I...) + "use-11u-x-steps" => 0x100000, # AP requires additional step for access (802.11u I...) + "use-11u-emrg-advert" => 0x200000, # AP claims emergency services reachable (802.11u I...) + "use-11u-emrg-unauth" => 0x400000, # AP provides Unauthenticated emergency services (802.11u I...) + "use-hs20" => 0x800000, # Enable Hotspot 2.0 (HS20) feature. Req WPA-2. + "no-dgaf" => 0x1000000, # AP: Disable DGAF (used by HotSpot 2.0). + "use-dot1x" => 0x2000000, # Use 802.1x (RADIUS for AP). + "use-11r-pmska" => 0x4000000, # Enable PMSKA caching for WPA2 (Rel to 802.11r). + "no-ht80" => 0x8000000, # Disable HT80 (for AC chipset NICs only) + "use-ibss" => 0x20000000, # Station should be in IBSS mode. + "use-osen" => 0x40000000, # Enable OSEN protocol (OSU Server-only Auth) +); + +our $cx_type = "tcp"; +our %cx_types = ( + "tcp" => "lf_tcp", + "udp" => "lf_udp", + "tcp6" => "lf_tcp6", + "udp6" => "lf_udp6", +); +our $duration = 30; # seconds to transmit in step 1 +our $db_preload = ""; # use for loading before station creation +our $db_save = ""; # use for saving a scenario that we just ran +our $db_postload = ""; # use for cleanup after running/saving a scenario +our $poll_time = 5; # seconds +our $traffic_type = "separate"; # separate: download then upload, concurrent: at same time +our $default_mac_pat = "xx:xx:xx:*:*:xx"; +our $mac_pattern = $::default_mac_pat; + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- # +## Usage # +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- # +our %wifi_modes = ( + "a" => "1", + "b" => "2", + "g" => "3", + "abg" => "4", + "abgn" => "5", + "bgn" => "6", + "bg" => "7", + "abgnAC" => "8", + "anAC" => "9", + "an" => "10", +); +our $wifi_mode =""; +my $mode_list = join("|", sort keys %wifi_modes); +my $usage = qq($0 [--mgr {host-name | IP}] + [--mgr_port {ip port}] # use if on non-default management port + [--resource {resource}] # use if multiple lanforge systems; defaults to 1 + [--quiet { yes | no }] # debug output; -q + [--log_cli] # enables CLI command printing to STDOUT + # same effect when setting env var LOG_CLI=STDOUT + ## AP selection + [--radio {name}] # e.g. wiphy2 + [--ssid {ssid}] # e.g. jedtest + [--security {open|wep|wpa|wpa2}] # station authentication type, Default is open + [--xsec {comma,separated,list} ] # dot1x, 11u, other features, read script + [--passphrase {...}] # implies wpa2 if --security not set + [--wifi_mode {$mode_list}] + + ## station configuration + [--num_stations {$num_stations}] # Defaults to 1 + [--first_sta {$first_sta}] + [--first_ip {DHCP |ip address}] + [--netmask {$netmask}] + [--mac-pattern {$default_mac_pat}] + # xx : uses parent radio octet + # [0-9a-f] : use this value for octet + # * : generates random octet + # Use quotes around this argument! EG: + # --mac_pattern '00:xx:*:*:xx:xx' + + ## connection configuration + [--cxtype {tcp/tcp6/udp/udp6}] # use a tcp/udp connection, default tcp + [--upstream {name|$upstream_port}] + # could be AP or could be port on LANforge + # connected to WAN side of AP + [--bps-min {$min_tx}] # minimum tx bps + [--bps-max {SAME|bps-value}] # maximum tx bps, use SAME or omit for SAME + [--duration {$duration}] # connection duration, seconds, default 60 + [--poll-time {$poll_time}] # nap time between connection displays + [--action {step1,step2,add,del,del_all_phy}] + # step1: creates stations and L3 connections + # step2: does bringup test + # add: creates virtual radio (optional sta creation using specified virtual radio) + # del: Delete the specified port. + # del_all_phy: Delete all interfaces with the specified parent device. + + [--traffic_type {separate|concurrent}] + # for step1: separate does download then upload + # concurrent does upload and download at same time + + [--admin_down_on_add] + # when creating stations, create them admin-down + + [--db_preload {scenario name}] + # load this database before creating stations + # option intended as a cleanup step + + [--db_save {name}] + # save the state of this test scenario after running the + # connections, before --db_postload + + [--db_postload {scenario name}] + # load this database after running connections, + # option intended as a cleanup step + + ## virtual radio configuration + [--vrad_chan {channel}] + [--port_del {name}] # deletes port given + +Examples: +## connecting to an open AP, at 2Mbps, for 20 minutes + $0 --action step1 --radio wiphy0 --ssid ap-test-01 \\ + --bps-min 2000000 --duration 1200 --upstream eth1 + + $0 --action step2 --radio wiphy2 --ssid jedtest \\ + --first_sta sta100 --first_ip DHCP --num_stations 3 \\ + --security wpa2 --passphrase jedtest1 --mac_pattern 'xx:xx:xx:*:*:*' + +## using a second lanforge system to connect to wpa2 AP: + $0 --mgr 192.168.100.1 --resource 2 --radio wiphy2 \\ + --ssid jedtest --passphrase 'asdf1234' \\ + --num_stations 10 --first_sta sta400 \\ + --first_ip DHCP --upstream eth1 --action step1 + +## (Windows) using a beginning database and saving the resulting database: + C:\\Users\\bob> cd "c:\\Program Files (x86)\\LANforge-Server\\scripts" + C:\\Program Files (x86)\\LANforge-Server\\scripts>perl lf_associate_ap.pl --mgr jedtest \\ + --resource 2 --radio wiphy2 --first_ip DHCP \\ + --duration 10 --bps-min 10k --bps-max 20M --cxtype tcp \\ + --ssid jedtest --passphrase jedtest1 --security wpa2 \\ + --first_sta 300 --db_preload Radio2 --db_save run_results --num_stations 3 + +## connecting to wpa AP: +$0 --mgr 192.168.100.1 --radio wiphy0 \\ + --ssid jedtest --passphrase 'asdf1234' --security wep \\ + --num_stations 10 --first_sta sta400 \\ + --first_ip DHCP --upstream eth1 --action step1 + +## creating and deleting a virtual radio: + $0 --mgr 192.168.100.1 --resource 2 \\ + --radio vphy1 --vrad_chan 36 --action add + + $0 --mgr 192.168.100.1 --resource 2 \\ + --port_del vrad1 --action del + +## Adding a station to a new or existing virtual radio: + $0 --mgr 192.168.100.1 --resource 2 \\ + --radio vphy1 --first_sta sta0 --first_ip DHCP --ssid my_ssid --action add + +## Add lots of stations to a radio + + $0 --mgr ben-ota-1 --resource 2 --action add --radio wiphy0 --ssid Lede-ventana \\ + --first_sta sta100 --first_ip DHCP --num_stations 63 + +## Delete all virtual devices on wiphy0 + + $0 --mgr ben-ota-1 --resource 2 --action del_all_phy --port_del wiphy0 + +); + +my $shelf_num = 1; + +# Default values for cmd-line args. +our $report_timer = 1000; # milliseconds +our $test_mgr = "default_tm"; # name of test manager +our $resource = 1; # might be referred to as card_id +our $resource2 = 1; # might be referred to as card_id +our $begin_ip = $default_ip_addr; + +# sta_names is a set of names and static IP addresses to assign them. +# As many stations as are in the set will be created. If you want to use +# DHCP, replace the ip with "DHCP". +# example +# %sta_names = ( +# "sta1" => "192.168.0.1", +# "sta2" => "NEXT" +# "sta2" => "DHCP" +#); +our %sta_names = (); +our %cx_names = (); +our $quiet = "yes"; # debugging +our $action = "step1"; # default action +our $lfmgr_host = "localhost"; # LANforge manager IP + +# Virtual radio defaults. +our $vrad_chan = -1; # default channel (AUTO) + +# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +# Nothing to configure below here, most likely. +# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +my $lfmgr_port = 4001; # LANforge manager port +our $quiesce_sec = 3; # pretty standard + #if(Scalar::Util::looks_like_number( $hunk) && $hunk == 0); + # please use $::utils->fmt_cmd +sub fmt_cmd { + my $rv; + if ($::utils->can('fmt_cmd')) { + #print "fmt_cmd passing down to Utils::fmt_cmd()\n"; + $rv = $::utils->fmt_cmd(@_); + return $rv; + } + + 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'); + $hunk = "0" if($hunk eq "0" || $hunk eq "+0"); + + if( $hunk eq "" ) { + #print "hunk[".$hunk."] --> "; + $hunk = 'NA'; + #print "hunk[".$hunk."]\n"; + #print "fmt_cmd: warning: hunk was blank, now NA. Prev hunks: $rv\n" + } + $rv .= ( $hunk =~m/ +/) ? "'$hunk' " : "$hunk "; + } + chomp $rv; + print "cmd formatted to: $rv\n" unless($::utils->isQuiet()); + return $rv; +} + +# deprecated, please use utils->doCmd() +sub doCmd { + my $cmd = shift; + die("doCmd: Blank command, bye.") unless ($cmd); + die("doCmd: Telnet uninitialized, check that '\$t' is set. Bye." ) unless ($main::t); + + if ($::utils->can('doCmd')) { + #print "doCmd passing down to Utils::doCmd($cmd)\n"; + $::utils->doCmd($cmd); + } + else { + $main::t->print($cmd); + my @rslt = $::t->waitfor('/ \>\>RSLT:(.*)/'); + print "**************\n @rslt ................\n\n" unless($::utils->isQuiet()); + } +} + +sub db_exists { + my $db_name = shift; + die ("::db_exists: called with blank database name. Did you mean EMPTY?") if ($db_name eq ""); + print "Looking for database $db_name ..."; + my @db_names = split("\n", $::utils->doAsyncCmd("show_dbs")); + my @match = grep { /^$db_name\/$/ } @db_names; + return 1 if (@match > 0); + + print "Warning! Scenario $db_name not found among: ".join(", ", @db_names)."\n"; + sleep 5; + return 0; +} + +sub load_db { + my $db_name = shift; + die ("::load_db: called with blank database name. Did you mean EMPTY?") if ($db_name eq ""); + print "Loading database $db_name ..."; + doCmd(fmt_cmd("load", $db_name, "overwrite")); + + for (my $i = 20 ; $i>0; $i--) { + sleep(1); + my $up = 0; + my $has_tx_bytes = 0; + my $sta_cnt = 0; + my $prev_cnt = 0; + my $status = $::utils->doAsyncCmd(fmt_cmd("nc_show_ports", 1, $::resource, "ALL")); + my @status = split("\n", $status); + + foreach (@status){ + if (/^Shelf: 1, Card: \d+\s+Port: \d+\s+Type: STA\s+/) { + $sta_cnt++; + print "sta_cnt $sta_cnt up $up has_tx %has_tx_bytes\n"; + } + if ($sta_cnt > $prev_cnt) { + if ( /IP: \d+\.\d+\.\d+\.\d+ / && !/IP: 0\.0\.0\.0 /) { + $up++; + } + if ( /Txb: \d+ / && !/Txb: 0 / ) { + $has_tx_bytes ++; + } + $prev_cnt = $sta_cnt if ( /^\s*$/ ); + } + } # ~foreach + } + print "done\n"; +} + +sub save_db { + my $db_name = shift; + die ("::save_db: called with blank database name. Please debug.") if ($db_name eq ""); + print "Saving database $db_name ..."; + if (db_exists($db_name)==1){ + print "Warning: will over-write database $db_name! "; + sleep(1); + } + doCmd(fmt_cmd("save", $db_name)); + print "done\n"; +} + +sub get_radio_bssid { + my $radio_name = shift; + die ("::get_radio_bssid: blank radio name. Please debug.") if ($radio_name eq ""); + + return $::wiphy_bssids{ $radio_name } + if (exists($::wiphy_bssids{ $radio_name })); + + #print "* looking up $radio_name for bssid..."; + my @status_lines = split("\n", $::utils->doAsyncCmd(fmt_cmd("show_port", 1, $::resource, $radio_name))); + my @mac_lines = grep { / MAC: [^ ]+/ } @status_lines; + die ("::get_radio_bssid: failed to find radio bssid, no MAC lines") + if (@mac_lines < 1); + + my ($bssid) = $mac_lines[0] =~ / MAC: ([^ ]+)/; + die ("::get_radio_bssid: failed to find radio bssid, MAC was empty") + if ($bssid eq ""); + + $::wiphy_bssids{ $radio_name } = $bssid; + #print $bssid."\n"; + + return $bssid; +} + +sub new_mac_from_pattern { + my $parent_mac = shift; + my $pattern = shift; + die ("::new_mac_pattern: blank parent_mac. Please debug.") if ($parent_mac eq ""); + die ("::new_mac_pattern: blank pattern. Please debug.") if ($pattern eq ""); + + my @parent_hunks = split(":", $parent_mac); + my @pattern_hunks = split(":", $pattern); + + die ("::new_mac_pattern: parent_mac needs to be colon-separated. Please debug.") if (@parent_hunks != 6); + die ("::new_mac_pattern: pattern needs to be colon-separated. Please debug.") if (@pattern_hunks != 6); + + my @new_hunks = (); + for (my $i=0; $i < 6; $i++) { + if ($pattern_hunks[$i] =~ /xx/i) { + $new_hunks[ $i ] = $parent_hunks[ $i ]; + } + elsif ($pattern_hunks[$i] =~ /[*]+/) { + my $r=int(rand(255)); + if ($i == 0) { + $r |= 0x002; # sets the 'locally administered bit' + $r &= 0x0FE; + # use if this upstream routers squash local admin bit macs + # $r &= 0x0DF; + } + $new_hunks[ $i ] = sprintf("%02X", $r); + } + else { + $new_hunks[ $i ] = $pattern_hunks[ $i ]; + } + } + return lc(join(":", @new_hunks)); +} # ~new_mac_pattern + +sub new_random_mac { + my $rv = "00:"; + for (my $i=0; $i<5; $i++) { + $rv.=sprintf("%02X",int(rand(255))).(($i<4)?':':''); + } + return $rv; +} + +sub get_port_id { + my ($resource, $sta_wiphy) = @_; + die("get_port_id wants station name or parent station radio") unless($sta_wiphy); + + my @port_list = $::utils->getPortListing( 1, $resource); + my LANforge::Port $port; + if (@port_list < 1) { + print "::get_port_id: no ports present.\n" unless ($::utils->isQuiet()); + return ""; + }; + for my $port_item (@port_list) { + my $card_id = $port_item->card_id(); + my $dev = $port_item->dev(); + print "${sta_wiphy}? get_port_id:card_id ${card_id} dev:$dev \n" unless($::utils->isQuiet()); + if( $card_id eq $resource && $dev eq $sta_wiphy ) { + $port = $port_item; + last; + } + } + if($port) { + my $port_id = $port->port_id(); + return $port_id; + } + + print("port ${sta_wiphy} not present, ") if(!defined $port || $port eq ""); + return ""; +} + +sub fmt_vsta_cmd { + my ($resource, $sta_wiphy, $sta_name, $flags, $ssid, $passphrase, $mac, $flags_mask, $wifi_m ) = @_; + die("fmt_vsta_cmd wants sta_wiphy name, bye.") unless($sta_wiphy); + my $key = "[BLANK]"; + my $ap = "AUTO"; + my $cfg_file = "NA"; + my $mode = 8; # default to a/b/g/n/AC + my $rate = "NA"; + my $amsdu = "NA"; + my $ampdu_factor = "NA"; + my $ampdu_density = "NA"; + my $sta_br_id = "NA"; + $key = $passphrase if ($passphrase ne ""); + + if ($wifi_m ne "") { + if (exists $::wifi_modes{$wifi_m}) { + $mode = $::wifi_modes{$wifi_m}; + } + else { + print "Wifi Mode [$wifi_m] not recognised. Please use:\n"; + print join(", ", sort keys %::wifi_modes); + exit 1; + } + } + + my $port_id = get_port_id($resource, $sta_wiphy); + $flags = "+0" if ($flags == 0); # perl goes funny on zeros + $flags_mask = "+0" if ($flags_mask == 0); + $flags = "NA" if ($flags eq ""); + return fmt_cmd("add_sta", 1, $resource, $sta_wiphy, $sta_name, "$flags", + "$ssid", "NA", "$key", $ap, $cfg_file, $mac, + $mode, $rate, $amsdu, $ampdu_factor, $ampdu_density, + $sta_br_id, "$flags_mask" ); +} + +sub fmt_vrad_cmd { + my ($resource, $sta_wiphy, $vrad_chan ) = @_; + die("fmt_vrad_cmd requires sta_wiphy.") unless($sta_wiphy); + my $mode = "NA"; + my $country = "NA"; + my $frequency = "NA"; + my $frag_thresh = "NA"; + my $rate = "NA"; + my $rts = "NA"; + my $txpower = "NA"; + my $mac = "NA"; + my $antenna = "NA"; + my $flags = "0x1"; + my $flags_mask = "NA"; + return fmt_cmd("set_wifi_radio", 1, $resource, $sta_wiphy, $mode, $vrad_chan, + $country, $frequency, $frag_thresh, $rate, $rts, $txpower, + $mac, "$antenna", "$flags", "$flags_mask" ); +} + +sub createEpPair { + my $sta_name = shift; + die("createEpPair: please pass station name, bye") unless(defined $sta_name && $sta_name ne ''); + die("createEpPair: please define upstream_port, bye") unless(defined $::upstream_port && $::upstream_port ne ''); + my $port_a = $sta_name; + my $port_b = $::upstream_port; + my $cx_name = $::cx_names{$sta_name}->{"cx"}; + my $ep1 = $::cx_names{$sta_name}->{"ep1"}; + my $ep2 = $::cx_names{$sta_name}->{"ep2"}; + my %min_pkt_szs = ( + 'tcp' => [ 1460, 1460 ], + 'tcp6' => [ 1460, 1460 ], + 'udp' => [ 1472, 1472 ], + 'udp6' => [ 1472, 1472 ] + ); + my %max_pkt_szs = ( + 'tcp' => [ 1460, 1460 ], + 'tcp6' => [ 1460, 1460 ], + 'udp' => [ 1472, 1472 ], + 'udp6' => [ 1472, 1472 ] + ); + $::cx_type = "tcp" if ($::cx_type eq ""); + print "\n cxtype [$::cx_type]\n" unless($::utils->isQuiet()); + if ( ! exists $::cx_types{$::cx_type} ) { + die( "Please choose connection type: ".join(", ", keys(%::cx_types))); + } + my $cxtype = $::cx_types{$::cx_type}; + my $rate_min = "+0"; # we will set these later + my $rate_max = "+0"; # using set_endp_tx_bounds + + die("createEpPair: wants cx_name, bye.") unless(defined $cx_name && $cx_name ne ''); + die("createEpPair: wants ep1 name, bye.") unless(defined $ep1 && $ep1 ne ''); + die("createEpPair: wants ep2 name, bye.") unless(defined $ep2 && $ep2 ne ''); + + my $cmd = fmt_cmd("add_endp", $ep1, 1, $::resource, $port_a, $cxtype, + -1, "NA", "$rate_min", "$rate_max", "NA", + $min_pkt_szs{$::cx_type}[0], @{$max_pkt_szs{$::cx_type}}[0], + "increasing", "NO", "NA", "NA", "NA"); + print "EP1: $cmd\n" unless($::utils->isQuiet()); + doCmd($cmd); + + $cmd = fmt_cmd("add_endp", $ep2, 1, $::resource2, $port_b, $cxtype, + -1, "NA", "$rate_min", "$rate_max", "NA", + $min_pkt_szs{$::cx_type}[1], @{$max_pkt_szs{$::cx_type}}[1], + "increasing", "NO", "NA", "NA", "NA"); + print "EP2: $cmd\n" unless($::utils->isQuiet()); + doCmd($cmd); + + # Now, add the cross-connect + doCmd(fmt_cmd("add_cx", $cx_name, $::test_mgr, $ep1, $ep2)); + doCmd(fmt_cmd("set_cx_report_timer", $::test_mgr, $cx_name, $::report_timer)); +} + +sub fmt_port_cmd { + my($resource, $port_id, $ip_addr, $mac_addr) = @_; + my $use_dhcp = ($ip_addr eq "DHCP") ? 1 : 0; + my $ip = ($use_dhcp) ? "0.0.0.0" : $ip_addr ; + $mac_addr = die("fmt_port_cmd requires mac_addr") if(!$mac_addr); # || $mac_addr eq "NA"); + #print "fmt_port_cmd: RES $resource PORT $port_id IP_A $ip_addr MAC $mac_addr -> $ip\n" unless($::quiet eq "yes"); + my $cmd_flags = 'NA'; #0; + my $cur_flags = 0; + $cur_flags |= 0x80000000 if($use_dhcp); + #print "fmt_port_cmd: DHCP($use_dhcp) $cur_flags\n" unless($::quiet eq "yes"); + my $ist_flags = 0; + $ist_flags |= 0x2; # check current flags + $ist_flags |= 0x4 if($ip ne "NA"); + $ist_flags |= 0x8 if($::netmask ne "NA"); + $ist_flags |= 0x20 if($mac_addr ne "NA"); + $ist_flags |= 0x4000 if($use_dhcp); # what does 'including client-id' mean? + $ist_flags |= 0x800000; # port up + + my $gateway = "0.0.0.0"; + my $dns_servers = "NA"; + my $dhcp_client_id = "NONE"; + my $flags2 = "NA"; + + # Ben suggests using $sta_name before using $port_id + $cur_flags = "+0" if(!$cur_flags); + $cmd_flags = "+0" if(!$cmd_flags); + $ist_flags = "+0" if(!$ist_flags); + my $cmd = fmt_cmd("set_port", 1, $::resource, $port_id, $ip, $::netmask, + $gateway, "$cmd_flags", "$cur_flags", + "$mac_addr", "NA", "NA", "NA", "$ist_flags", $::report_timer, "$flags2", + "NA","NA","NA","NA","NA","NA","NA","NA","NA","NA","NA","NA","NA", + $dns_servers, "NA", $dhcp_client_id); + print("fmt_port_cmd: ".$cmd) unless($::utils->isQuiet()); + return $cmd; +} + +sub fmt_port_down { + my($resource, $port_id, $ip_addr, $ip_mask) = @_; + die("fmt_port_down wants resource id, bye.") unless($resource); + die("fmt_port_down wants port_id id, bye.") unless($port_id); + die("fmt_port_down wants ip_addr id, bye.") unless($ip_addr); + die("fmt_port_down wants ip_mask id, bye.") unless($ip_mask); + + my $use_dhcp = ($ip_addr eq "DHCP") ? 1 : 0; + my $ip = ($use_dhcp) ? "0.0.0.0" : $ip_addr ; + my $cmd_flags = "NA"; + my $cur_flags = 0; + $cur_flags |= 0x1; # port down + my $ist_flags = 0; + $ist_flags |= 0x2; # check current flags + $ist_flags |= 0x800000; # port down + my $dhcp_id = "NONE"; + my $netmask = "$ip_mask"; + my $gateway = "0.0.0.0"; + my $dns_servers = "NA"; + my $dhcp_client_id = "NONE"; + my $flags2 = "NA"; + + $cmd_flags = "+0" if(!$cmd_flags); # zeros are falsy in perl + $cur_flags = "+0" if(!$cur_flags); + $ist_flags = "+0" if(!$ist_flags); + my $cmd = fmt_cmd("set_port", 1, $resource, $port_id, $ip_addr, + $netmask, $gateway, "$cmd_flags", "$cur_flags", + "NA", "NA", "NA", "NA", "$ist_flags", $::report_timer, "$flags2", + "NA","NA","NA","NA","NA","NA","NA","NA","NA","NA","NA","NA","NA", + $dns_servers, "NA", $dhcp_client_id); + return $cmd; +} + +# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----# +# WiFi FLAGS # +# and please see the CLI users guide (flags can get updated) # +# http://www.candelatech.com/lfcli_ug.php # +# # +# 0x10 Enable WPA # +# 0x20 Use Custom wpa_supplicant config file. # +# 0x100 Use wpa_supplicant configured for WEP encryption. # +# 0x200 Use wpa_supplicant configured for WPA2 encryption. # +# 0x400 Disable HT-40 even if hardware and AP support it. # +# 0x800 Enable SCAN-SSID flag in wpa_supplicant. # +# 0x1000 Enable PCSC (used by WPA-SIM) # +# 0x2000 Disable SGI (Short Guard Interval). # +# 0x4000 OK-To-Migrate (Allow migration between LANforge radios) # +# 0x8000 Verbose-Debug: Increase debug info in wpa-supplicant and hostapd logs. # +# 0x10000 Enable 802.11u (Interworking) feature. # +# 0x20000 Enable 802.11u (Interworking) Auto-internetworking feature. # +# 0x40000 AP Provides access to internet (802.11u Interworking) # +# 0x80000 AP requires additional step for access (802.11u Interworking) # +# 0x100000 AP claims emergency services reachable (802.11u Interworking) # +# 0x200000 AP provides Unauthenticated emergency services (802.11u Interworking) # +# 0x400000 Enable Hotspot 2.0 (HS20) feature. Requires WPA-2. # +# 0x800000 AP: Disable DGAF (used by HotSpot 2.0). # +# 0x1000000 Use 802.1x (RADIUS for AP). # +# 0x2000000 Enable oportunistic PMSKA caching for WPA2 (Related to 802.11r). # +# # +# ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----# +sub new_wifi_station { + my $sta_name = shift; + die("new_wifi_station wants station name, bye") unless(defined $sta_name && $sta_name ne ''); + my $ip_addr = shift; + die("new_wifi_station wants ip_address, bye") unless(defined $ip_addr && $ip_addr ne ''); + my $rh_results = shift; + die("new_wifi_station wants hash ref to place results, bye.") unless(defined $rh_results); + my $wifi_m = shift; + my $sleep_amt = shift; + + my $parent_mac = get_radio_bssid($::sta_wiphy); + die("new_wifi_station: unable to find bssid of parent radio") if ($parent_mac eq ""); + my $mac_addr = new_mac_from_pattern($parent_mac, $::mac_pattern); + print "$sta_name $mac_addr; " unless($::utils->isQuiet()); + my $flags = +0; # set this to string later + my $flagsmask = +0; # set this to string later + + # To set zero value set the bit in flags to zero. + # Set the flagsmask value to 1 if you want the value to be set to 1 or 0. + if ($::passphrase eq "") { + if($::security ne "open") { + die("Passphrase not set when --security [$::security] chosen. Please set passphrase."); + } + } + else { # $::passphrase ne "" + if( $::security eq "open") { + print "Warning: ignoring passphrase for open wifi.\n"; + $::passphrase = ""; + } + } + if ( ! exists($::sec_options{$::security})) { + die( "Unknown security option [{$::security}]"); + } + $flags |= $::sec_options{$::security}; + $flagsmask |= $::sec_options{$::security}; + + if (defined $::xsec && "$::xsec" ne "") { + for my $sec_op (split(',', $::xsec)) { + next if (!defined $::sec_options{$sec_op}); + + $flags |= $::sec_options{$sec_op}; + $flagsmask |= $::sec_options{$sec_op}; + } + } + $flags = "+0" if ( $flags == 0); + $flagsmask = "+0" if ( $flagsmask == 0); + # perform the station create first, then assign IP as necessary + my $sta1_cmd = fmt_vsta_cmd($::resource, $::sta_wiphy, $sta_name, + "$flags", "$::ssid", "$::passphrase", + $mac_addr, "$flagsmask", $wifi_m); + doCmd($sta1_cmd); + $sta1_cmd = fmt_port_cmd($resource, $sta_name, $ip_addr, $mac_addr); + doCmd($sta1_cmd); + if ($::admin_down_on_add) { + my $cur_flags = 0x1; # port down + my $ist_flags = 0x800000; # port down + $sta1_cmd = fmt_cmd("set_port", 1, $resource, $sta_name, "NA", + "NA", "NA", "NA", "$cur_flags", + "NA", "NA", "NA", "NA", "$ist_flags"); + doCmd($sta1_cmd); + } + + if ($sleep_amt > 0) { + sleep $sleep_amt; + } + my $port_id = get_port_id($::resource, $sta_name); + print "Created vsta $sta_name mac $mac_addr with $port_id...\n" unless($::utils->isQuiet()); + my $data = [ $mac_addr, $port_id, $sta1_cmd ]; + $rh_results->{$sta_name} = $data; +} + +sub new_wifi_radio { + my $cmd = fmt_vrad_cmd($::resource, $::sta_wiphy, $::vrad_chan ); + doCmd($cmd); +} + +sub delete_port { + if (defined $::port_del) { + print "deleting port $::port_del\n" unless($::utils->isQuiet()); + $::utils->doCmd(fmt_cmd("rm_vlan", 1, $::resource, $::port_del)); + } +} + +sub get_sta_state { + my($rs_status) = @_; + die("is_assoc_state: wants ref to status string") unless($rs_status); + my @lines = split(/\n/, $$rs_status); + my $careful = 0; + my $name = "unknown"; + my $ip = "0.0.0.0"; + my $assoc = "unknown"; + my $first; + my $freq; + my @hunks; + my $mac; + my $gw; + my $mask; + my $channel; + my $mode; + for my $line (@lines) { + $first = "_"; + $line =~ m/^\s+(\S+?:)\s+/; + #print "}}}} $line\n"; + if ($1 && $1 eq "MAC:" ) { + @hunks = split(/: /, $line); + $mac = (split(/ /, $hunks[1]))[0]; + $name = (split(/ /, $hunks[2]))[0]; + next; + } + if ($1 && $1 eq "IP:") { + @hunks = split(/: /, $line); + $ip = (split(/ /, $hunks[1]))[0]; + $mask = (split(/ /, $hunks[2]))[0]; + $gw = (split(/ /, $hunks[3]))[0]; + next; + } + if ($1 && $1 eq "Probed:") { + @hunks = split(/: /, $line); + $careful = 1; + $mode = (split(/ /, $hunks[2]))[0]; + next; + } + if( $careful && $1 eq "Channel:" ) { + @hunks = split(/: /, $line); + $channel = (split(/ /, $hunks[1]))[0]; + $freq = (split(/ /, $hunks[3]))[0]; + $assoc = (split(/ /, $hunks[4]))[0]; + #print " assoc:".$assoc; + last; + } + } + my %rv = ( + "assoc" => $assoc, + "freq" => $freq, + "ip" => $ip, + "mask" => $mask, + "gw" => $gw, + "mac" => $mac, + "mode" => $mode, + "name" => $name ); + return %rv; +} + +sub awaitStationRemoval { + my $old_sta_count = (keys %::sta_names); + print "Waiting for $old_sta_count stations to be removed..."; + while( $old_sta_count > 0 ) { + $old_sta_count = (keys %::sta_names); + for my $sta_name (sort(keys %::sta_names)) { + print " $sta_name,"; + my $status = $::utils->doAsyncCmd(fmt_cmd("show_port", 1, $::resource, $sta_name)); + $old_sta_count-- if( $status =~ m/Could not find/); + #print "$old_sta_count..."; + sleep 1; + } + } + print " Old stations removed\n"; +} + +#~expand to multiple cross-connects +sub removeOldCrossConnects { + print "Removing old cross-connects, and endpoints ...\n"; + for my $sta_name (sort(keys(%::sta_names))) { + my $cx_name = $::cx_names{$sta_name}->{"cx"}; + my $ep1 = $::cx_names{$sta_name}->{"ep1"}; + my $ep2 = $::cx_names{$sta_name}->{"ep2"}; + doCmd("rm_cx $::test_mgr $cx_name"); + doCmd("rm_endp $ep1"); + doCmd("rm_endp $ep2"); + print " $cx_name ($ep1 - $ep2)..."; + } + sleep 1; + print " done.\n"; +} + +sub removeOldStations { + print "Deleting ports:"; + sleep 1; + foreach my $sta_name (reverse sort(keys %::sta_names)) { + print "...$sta_name "; + my $status = $::utils->doAsyncCmd(fmt_cmd("show_port", 1, $::resource, $sta_name)); + sleep 1; + my $port_id = get_port_id($::resource, $sta_name); + if($port_id) { + print "/$port_id"; + $::utils->doCmd(fmt_cmd("rm_vlan", 1, $::resource, $sta_name)); + print "..."; + } + else { + print " not found, "; + } + } + print " done.\n"; +} + +sub awaitNewStations { + print "Waiting for stations to associate..."; + my $new_sta_count = keys(%::sta_names); + my $found_stations = 0; + while( $new_sta_count > $found_stations ) { + $found_stations = 0; + my @are_assoc = (); + my @not_assoc = (); + for my $sta_name (sort(keys(%::sta_names))) { + sleep 1; + my $status = $::utils->doAsyncCmd(fmt_cmd("show_port", 1, $::resource, $sta_name)); + my %sta_status = get_sta_state(\$status); + #print " $sta_name ".$sta_status{"assoc"}; + if( $sta_status{"assoc"} ne "Not-Associated") { + push(@are_assoc, $sta_name); + } + else { + push(@not_assoc, $sta_name); + } + } #~foreach sta + $found_stations = @are_assoc; + print " $found_stations/$new_sta_count seen to associate\n"; + if ( $found_stations != $new_sta_count ){ + print " Associated:".join(", ", @are_assoc)."\n"; + print " Pending :".join(", ", @not_assoc)."\n"; + } + } # ~while +} + +sub endpointReport { + my $ep = shift; + my ($ep_name, $tx_rate, $rx_rate,$rx_bps); + die("endpointReport: should be passed name of endpoint, bye.") unless ( $ep ne '' ); + my $blob = $::utils->doAsyncCmd(fmt_cmd("nc_show_endpoints", "$ep"), "\n"); + #print "BLOB: $blob\n\n\n"; + ( $ep_name ) = ($blob =~ m/^Endpoint \[(.*?)\] /mg); + ( $tx_rate ) = ($blob =~ m/(Tx Bytes: .*$)/mg); + ( $rx_rate ) = ($blob =~ m/(Rx Bytes: .*$)/mg); + print "$ep_name:\t$tx_rate\n\t\t$rx_rate\n"; +} + +sub showEndpoints { + for my $sta_name (sort(keys(%::sta_names))) { + my $ep1 = $::cx_names{$sta_name}->{ep1}; + my $ep2 = $::cx_names{$sta_name}->{ep2}; + endpointReport($ep1); + endpointReport($ep2); + } +} + +sub createEndpointPairs { + print "\nCreating connections: "; + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + print " $cx ($sta_name - $::upstream_port), "; + createEpPair($sta_name); + } + print "done.\n"; +} + +sub evalUnits { + my $val = shift; + + if ($val =~ /^\d+$/) { + return +0+$val; + } + my $pow = 1; + if ($val =~ /(\d+)(\w+)/) { + my $pref = $1; + my $suff = $2; + if ($suff =~ /[Kk][Bbps]*$/) { + $pow = 1000; + } + elsif ($suff =~ /[Mm][Bbps]*$/) { + $pow = 1000000; + } + elsif ($suff =~ /[Gg][Bbps]*$/) { + $pow = 1000000000; + } + if ($pref == 0 || $pow == 0) { + print "Warning: speed coeficients [$pref,$pow] appear suspicious\n"; + sleep 3; + } + my $speed =0 + ($pref * $pow); + #print ">>>> setting speed to $speed <<<<\n"; + return $speed; + } + print "Warning: speed[$val] appears suspicious\n"; + sleep 3; + return $val; +} + +sub adjustForSimultaneous { + my $no_rate = "+0"; + if (lc($::min_tx) eq "same" ) { + die "--min_tx may not be 'same', please provide a number or formatted unit in K, M or G"; + } + my $rate_min = evalUnits($::min_tx); + #print "rate_min now: $rate_min\n"; + $::max_tx = $::min_tx if (lc($::max_tx) eq "same" ) ; + my $rate_max = evalUnits($::max_tx); + #print "rate_max now: $rate_max\n"; + print "Adjusting cx min/max tx for concurrent test: "; + + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + my $ep1 = $::cx_names{$sta_name}->{"ep1"}; + my $ep2 = $::cx_names{$sta_name}->{"ep2"}; + + #print "UPLOAD: ".fmt_cmd("set_endp_tx_bounds", $ep1, "$rate_min", "$rate_max")."\n"; + #print "UPLOAD: ".fmt_cmd("set_endp_tx_bounds", $ep2, "$no_rate", "$no_rate")."\n"; + + doCmd(fmt_cmd("set_endp_tx_bounds", $ep1, "$rate_min", "$rate_max")); + doCmd(fmt_cmd("set_endp_tx_bounds", $ep2, "$rate_min", "$rate_max")); + doCmd(fmt_cmd("set_endp_quiesce", $ep1, "$::quiesce_sec")); + doCmd(fmt_cmd("set_endp_quiesce", $ep2, "$::quiesce_sec")); + } + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + doCmd(fmt_cmd("set_cx_state", $::test_mgr, $cx, "RUNNING")); + print " $cx..."; + } + print "done.\n"; +} # ~adjustForDuplex + + +# adjust the transmit rate up for endpoint 1, and down for endpoint 2 +sub adjustForUpload { + my $no_rate = "+0"; + if (lc($::min_tx) eq "same" ) { + die "--min_tx may not be 'same', please provide a number or formatted unit in K, M or G"; + } + my $rate_min = evalUnits($::min_tx); + $::max_tx = $::min_tx if (lc($::max_tx) eq "same" ) ; + + my $rate_max = evalUnits($::max_tx); + + print "Adjusting cx min/max tx for upload test: "; + + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + my $ep1 = $::cx_names{$sta_name}->{"ep1"}; + my $ep2 = $::cx_names{$sta_name}->{"ep2"}; + + #print "UPLOAD: ".fmt_cmd("set_endp_tx_bounds", $ep1, "$rate_min", "$rate_max")."\n"; + #print "UPLOAD: ".fmt_cmd("set_endp_tx_bounds", $ep2, "$no_rate", "$no_rate")."\n"; + + doCmd(fmt_cmd("set_endp_tx_bounds", $ep1, "$rate_min", "$rate_max")); + doCmd(fmt_cmd("set_endp_tx_bounds", $ep2, "$no_rate", "$no_rate")); + doCmd(fmt_cmd("set_endp_quiesce", $ep1, "$::quiesce_sec")); + doCmd(fmt_cmd("set_endp_quiesce", $ep2, "$::quiesce_sec")); + } + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + doCmd(fmt_cmd("set_cx_state", $::test_mgr, $cx, "RUNNING")); + print " $cx..."; + } + print "done.\n"; +} # ~adjustForUpload + + +sub printShowEndpointStats { + my $lines = shift; + for my $line (split(/\n/, $lines)) { + if ($line =~ m/RealRxRate:/) { + my ($bps_rx) = ($line =~ m/RealRxRate: (\d+)bps /); + + if ($bps_rx >=1000000) { + $bps_rx = ceil($bps_rx / 1000000)."M"; + } + elsif ($bps_rx >= 1000) { + $bps_rx = ceil($bps_rx / 1000)."K"; + } + print " ${bps_rx}bps"; + } + if ($line =~ m/Tx Bytes:/) { + my ($tx) = ($line =~ m/Total:\s+(\d+)/); + if($tx >=(1024*1024)) { + $tx = ceil($tx / (1024*1024))."M"; + } + elsif ($tx >= 1024) { + $tx = ceil($tx / 1024)."K"; + } + print " / ${tx}B\t"; + } + } +} + +sub awaitTransfers { + my $begin_time = time; + my $end_time = $begin_time + $::duration; + my $lines; + #my $print_nap = 3; + my $passes = 0; + + for my $sta_name (sort(keys(%::sta_names))) { + my $ep1 = $::cx_names{$sta_name}->{"ep1"}; + my $ep2 = $::cx_names{$sta_name}->{"ep2"}; + print " $ep1 Rx-bps/Tx-B \t$ep2 Rx-bps/Tx-B |" + } + print "\n"; + while( time < $end_time ) { + sleep $::poll_time; + #if($passes == 0) { + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + my $ep1 = $::cx_names{$sta_name}->{"ep1"}; + my $ep2 = $::cx_names{$sta_name}->{"ep2"}; + + $lines = $::utils->doAsyncCmd(fmt_cmd("nc_show_endpoints", "$ep1"), "\n"); + printShowEndpointStats($lines); + $lines = $::utils->doAsyncCmd(fmt_cmd("nc_show_endpoints", "$ep2"), "\n"); + printShowEndpointStats($lines); + print " |"; + } + #$passes = $print_nap + 1; + print "\n"; + #} + #$passes--; + } +} # ~awaitUploads + +sub adjustForDownload { + my $no_rate = "+0"; + + if (lc($::min_tx) eq "same" ) { + die "--min_tx may not be 'same', please provide a number or formatted unit in K, M or G"; + } + my $rate_min = evalUnits($::min_tx); + $::max_tx = $::min_tx if (lc($::max_tx) eq "same" ) ; + my $rate_max = evalUnits($::max_tx); + + print "Adjusting tx_rate for download..."; + for my $sta_name (sort(keys(%::sta_names))) { + my $ep1 = $::cx_names{$sta_name}->{"ep1"}; + my $ep2 = $::cx_names{$sta_name}->{"ep2"}; + + #print "Download: ".fmt_cmd("set_endp_tx_bounds", $ep1, "$no_rate", "$no_rate")."\n"; + #print "Download: ".fmt_cmd("set_endp_tx_bounds", $ep2, "$rate_min", "$rate_max")."\n"; + + doCmd(fmt_cmd("set_endp_tx_bounds", $ep1, "$no_rate", "$no_rate")); + doCmd(fmt_cmd("set_endp_tx_bounds", $ep2, "$rate_min", "$rate_max")); + doCmd(fmt_cmd("set_endp_quiesce", $ep1, "$::quiesce_sec")); + doCmd(fmt_cmd("set_endp_quiesce", $ep2, "$::quiesce_sec")); + } + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + doCmd(fmt_cmd("set_cx_state", $::test_mgr, $cx, "RUNNING")); + print " $cx..." + } + print "done\n"; +} # ~adjustForUpload + +sub quiesceConnections { + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + doCmd(fmt_cmd("set_cx_state", $::test_mgr, $cx, "QUIESCE")); + } +} + +sub resetCounters { + for my $sta_name (sort(keys(%::sta_names))) { + my $cx = $::cx_names{$sta_name}->{"cx"}; + doCmd("clear_cx_counters $cx"); + } + doCmd("clear_endp_counters all"); +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## +## Create a virtual station and associate it with and SSID, +## then pass traffic to and from it. +## +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub doStep_1 { + my $sta_name = (sort(keys %::sta_names))[0]; + + + removeOldCrossConnects(); + sleep(2); + removeOldStations(); + sleep(1); + awaitStationRemoval(); + + sleep 1; + my $cmd; + my %results1 = (); + + # make sure that ::num_station and ::sta_names is consistent + + if ($::num_stations != (keys %::sta_names)) { + die "Unexpected difference between number of station names and num_stations, did num_stations not get set?"; + } + + # create stations + print " Creating new stations: "; + for $sta_name (sort(keys %::sta_names)) { + # sta, ip, rh, $ip_addr + print " $sta_name "; + new_wifi_station( $sta_name, $::sta_names{$sta_name}, \%results1, $::wifi_mode, 5 ); + } + print " Created $::num_stations stations\n"; + + my $new_sta_count = keys %results1; + my $found_stations = 0; + awaitNewStations(); + sleep 1; + + # we create a pair of connection endpoints and + # a cross-connect between them for every station + createEndpointPairs(); + sleep 5; + + if ($::traffic_type eq "separate") { + adjustForUpload(); + print " started uploads.\n"; + awaitTransfers(); + quiesceConnections(); + sleep 1+$::quiesce_sec; # the STOPPED signal might report short on packets because + # there might be queued packets in the backlog. If you need + # more precise readings, use the QUIESCE command which waits + # a specified number of seconds for all connections to close + + showEndpoints(); + resetCounters(); + # adjust the transmit rate down for endpoint 1, and up for endpoint 2 + adjustForDownload(); + print "\nStarted download...\n"; + awaitTransfers(); + } + elsif ($::traffic_type eq "concurrent") { + adjustForSimultaneous(); + print "\nStarted concurrent traffic...\n"; + awaitTransfers(); + } + else { + print "Unkown traffic_type $::traffic_type, exiting.\n"; + exit(1); + } + quiesceConnections(); + sleep 1+$::quiesce_sec; + showEndpoints(); +} # ~step1 + + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## +## Create a series of stations and associate them to +## the SSID. Then disassociate them. +## +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub doStep_2 { + my %results2 = (); + # delete previous stations + print "Removing old stations..."; + for my $sta_name (sort(keys %::sta_names)) { + # if we have a port eid for this station, let's delete the port so we can start fresh + my $port_id = get_port_id($::resource, $sta_name); + if( $port_id ) { + my $del_cmd = fmt_cmd("rm_vlan", 1, $::resource, $sta_name); + print "$sta_name " unless($::utils->isQuiet()); + doCmd($del_cmd); + } + } + # poll until they are gone + my $old_sta_count = (keys(%::sta_names)); + while( $old_sta_count > 0 ) { + $old_sta_count = (keys(%::sta_names)); + sleep 1; + for my $sta_name (sort(keys %::sta_names)) { + my $status = $::utils->doAsyncCmd(fmt_cmd("show_port", 1, $::resource, $sta_name)); + #print ">>status>>$status\n"; + $old_sta_count-- if( $status =~ /Could not find/); # ?? + } + } + print "Old stations removed.\n"; + print "Creating new stations..."; + + # create new stations + for my $sta_name (sort(keys %::sta_names)) { + die("misconfiguration! ") if( ref($sta_name) eq "HASH"); + my $ip = $::sta_names{$sta_name}; + print "$sta_name " unless($::utils->isQuiet()); + new_wifi_station( $sta_name, $ip, \%results2, $::wifi_mode, 5); + + # Uncomment to diagnose connection results. The IPs assigned + # are unlikely to appear instantly, but the mac and entity id + # used internally by LANforge will be set. + #my $ra_data = $results{$sta_name}}; + #my $mac = $results{$sta_name}[0]; + #my $eid = $results{$sta_name}[1]; + #print "created $sta_name, mac $mac, EID: $eid\n"; + #print "CMD: ".$results{$sta_name}[2]."\n\n"; + } + sleep 1; + my $num_stations = (keys %::sta_names); + print "Created $num_stations stations.\nPolling for association: "; + # we can view IP assignment as well as station association + my $num_assoc = 0; + my $num_ip = 0; + my $begin_time = time; + my %assoc_state = (); + for my $sta_name (sort(keys %::sta_names)) { + $assoc_state{$sta_name} = {}; + } + my $port; + + #while($num_ip < $num_stations) { # if we just cared about IPs + + while($num_assoc < $num_stations) { + sleep 1; + $num_assoc = 0; + $num_ip = 0; + for my $sta_name (sort(keys %::sta_names)) { + my $status = $::utils->doAsyncCmd(fmt_cmd("show_port", 1, $::resource, $sta_name)); + my %state = get_sta_state(\$status); + #print $state{"name"}.": ".$state{"assoc"}." "; + $num_assoc++ if($state{"assoc"} ne "Not-Associated"); + #print $state{"ip"}."/".$state{"mask"}." gw:".$state{"gw"}."\n"; + $num_ip++ if($state{"ip"} ne "0.0.0.0" ); + } + + print "$num_assoc stations associated, $num_ip stations with IPs\n"; + } + my $end_time = time; + my $delta = $end_time - $begin_time; + + print "Association took about $delta seconds\n"; + print "Bringing those stations down now: "; + for my $sta_name (keys %::sta_names) { + my $cmd = fmt_port_down($::resource, $sta_name, "0.0.0.0", "0.0.0.0"); #$::netmask + doCmd($cmd); + print "$sta_name " unless ($::utils->isQuiet()); + } + print "...stations down. Done.\n" +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## +## Create or Delete virtual radio. +## +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub doAdd { + # create virtual radio + if ($::num_stations > 0 && defined $::sta_wiphy) { + print "Creating virtual radio: $::sta_wiphy with $::num_stations stations.\n" unless($::utils->isQuiet()); + my %results2 = (); + new_wifi_radio(); + + for my $sta_name (sort(keys %::sta_names)) { + die("misconfiguration! ") if( ref($sta_name) eq "HASH"); + my $ip = $::sta_names{$sta_name}; + new_wifi_station( $sta_name, $ip, \%results2, $::wifi_mode, 0); + } + + # Wait until the are at least not phantom. + my $q; + for ($q = 0; $q < 10; $q++) { + my $all_done = 1; + my @ports = $::utils->getPortListing(1, $::resource); + for my $sta_name (sort(keys %::sta_names)) { + my $i; + my $found_it = 0; + for ($i = 0; $i < @ports; $i++) { + my $dev = $ports[$i]->dev(); + if ($dev eq $sta_name) { + if (! $ports[$i]->isPhantom()) { + $found_it = 1; + last; + } + } + } + if (!$found_it) { + print "Station: $sta_name is not found or is phantom.\n"; + $all_done = 0; + last; + } + } + if ($all_done) { + last; + } + print "Waiting for stations to be created\n"; + sleep(20); + } + } + elsif (defined $::sta_wiphy) { + print "Creating virtual radio: $::sta_wiphy.\n"; + new_wifi_radio(); + } + else { + print "Please define a radio with --radio\n"; + exit(1); + } +}# doAdd + +sub doDelWiphyVdevs { + if (defined $::port_del) { + # List ports on the resource in question, delete anything that has port_del for + # a parent. + my $q; + for ($q = 0; $q < 5; $q++) { + my @ports = $::utils->getPortListing(1, $::resource); + my $found = 0; + my $i; + for ($i = 0; $i<@ports; $i++) { + my $dev = $ports[$i]->dev(); + my $parent = $ports[$i]->parent(); + if ($parent eq $::port_del) { + print "deleting port $dev\n" unless($::utils->isQuiet()); + $::utils->doCmd(fmt_cmd("rm_vlan", 1, $::resource, $dev)); + $found++; + } + } + + if ($found == 0) { + last; + } + sleep(10); + } + } +} + +sub doDel { + if (defined $::port_del) { + #delete any port listed + delete_port(); + } +}# doDel + +sub ip2ipn { + return unpack 'N', inet_aton(shift); +} +sub ipn2ip { + return inet_ntoa( pack 'N', shift ); +} + +sub initStationAddr { + die("Zero stations cannot be very useful, bye.") if ($::num_stations < 1); + if ($::num_stations > 200 ) { + println("Over 200 stations is unlikely to work on one machine, expect over-subscription behavior."); + sleep 2; + } + + my $ip; + my $ip_obj; + if($::first_ip eq "DHCP"){ + $ip = "DHCP"; + } + else { + $ip = $::first_ip; + } + + # often people create own stations at sta0 or sta1 and + # those are really hard to sort in the Ports Tab. We shall + # start with sta100 by default. Separate the numeric suffix + # use that as offset + my $offset = 100; + if ($::first_sta =~ /^.*?(\d+)\s*$/) { + $offset = $1; + } + for( my $i=0; $i < $::num_stations ; $i++ ) { + my $suffix = 0 + $i + $offset; + my $name = sprintf("sta%03d", $suffix); + my $ep_name1 = sprintf("ep-A%03d", $suffix); + my $ep_name2 = sprintf("ep-B%03d", $suffix); + my $cx_name = sprintf("cx-%03d", $suffix); + + if ($ip ne 'DHCP' && $i > 0) { + my $val = ip2ipn($ip); + #print "ip[$ip] to int[$val]\n"; + $ip = ipn2ip( 1 + $val); + #print "ip[$ip] from int[".(1+$val)."]\n"; + } + + $::sta_names{$name} = $ip; + $::cx_names{$name} = { + ep1 => $ep_name1, + ep2 => $ep_name2, + cx => $cx_name + }; + } +} # ~initStationAddr + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## +## M A I N +## +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- + +my $help; +GetOptions +( + 'mgr|m=s' => \$::lfmgr_host, + 'mgr_port|p=i' => \$lfmgr_port, + 'resource|r=i' => \$::resource, + 'resource2|r2=i' => \$::resource2, + 'quiet|q=s' => \$::quiet, + 'radio|o=s' => \$::sta_wiphy, + 'ssid|s=s' => \$::ssid, + 'security=s' => \$::security, + 'xsec=s' => \$::xsec, + 'passphrase|h=s' => \$::passphrase, + 'first_ip|b=s' => \$::first_ip, + 'first_sta|c=s' => \$::first_sta, + 'num_stations|n=i' => \$::num_stations, + 'netmask|k=s' => \$::netmask, + 'mac-pattern|mac_pattern=s' => \$::mac_pattern, + 'cxtype|x=s' => \$::cx_type, + 'bps_min|bps-min|y=s' => \$::min_tx, + 'bps_max|bps-max|z=s' => \$::max_tx, + 'duration|e=i' => \$::duration, + 'upstream|t=s' => \$::upstream_port, + 'action|a=s' => \$action, + 'db_preload=s' => \$::db_preload, + 'db_save=s' => \$::db_save, + 'db_postload=s' => \$::db_postload, + 'poll_time|poll-time=i' => \$::poll_time, + 'wifi_mode|mode=s' => \$::wifi_mode, + 'traffic_type=s' => \$::traffic_type, + 'vrad_chan=i' => \$::vrad_chan, + 'port_del=s' => \$::port_del, + 'admin_down_on_add' => \$::admin_down_on_add, + 'log_cli=s{0,1}' => \$log_cli, # use ENV{LOG_CLI} elsewhere + 'help|?' => \$help, +) || (print($usage) && exit(1)); + +if ($help) { + print($usage) && exit(0); +} +$SIG{ __DIE__ } = sub { Carp::confess( @_ ) }; + +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; + } + } +} + +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 ($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 ($db_postload ne "" && db_exists($::db_postload)==0) { + print("Scenario [$::db_postload] does not exist. Please create it first."); + exit(1); +} + +if ($::db_preload ne "") { + if(db_exists($::db_preload)==1) { + print "Loading scenario $::db_preload..."; + load_db($::db_preload); + print "done\n"; + } + else { + print("Scenario [$::db_postload] does not exist. Please create it first."); + exit(1); + } +} + +if (!($action =~ /del/)) { # Below steps are unrelated to deleting objects + if(!defined $::first_ip || $::first_ip eq '') { + print("Please specify the first IP for stations. You may choose DHCP or an IP that will be incremented.\n"); + exit(1); + } + + if(! $::ssid ) { + print("Please configure SSID for stations to associate with.\n"); + exit(1); + } + if(! $::sta_wiphy ) { + print("Please specify the base radio port for the wifi stations. ".$usage ); + exit(1); + } +} + +if(! $action ) { + print("Please specify which test action we want: + step1: connect one station and pass upload and download traffic + step2: connect 10 wifi stations and disconnect. + add: create virtual radio.\n + del: Delete virtual radio.\n"); + exit(1); +} + +if (!($action =~ /del/)) { # Below steps are unrelated to deleting objects + if(0 == keys(%::sta_names)) { + initStationAddr(); + } + if(! %sta_names ) { + print("Please configure station list to test with.\n"); + exit(1); + } +} + +# take first station and associate it or fail +if ($action eq "step1" ) { + if ($traffic_type !~ /^(concurrent|separate)$/ ) { + print("Please specify concurrent or separate as traffic_type.\n"); + exit(1); + } + doStep_1(%sta_names, $::ssid, $sta_wiphy); + if ($db_save ne "") { + save_db($::db_save); + } + if ($::db_postload ne "") { + load_db($::db_postload); + } + +} +elsif( $action eq "step2" ) { + doStep_2(%sta_names, $::ssid, $sta_wiphy); + if ($::db_postload ne "") { + load_db($::db_preload); + } +} +elsif ($action eq "add" ) { + doAdd(); + if ($::db_postload ne "") { + load_db($::db_preload); + } +} +elsif ($action eq "del" ) { + doDel(); + if ($::db_postload ne "") { + load_db($::db_preload); + } +} +elsif ($action eq "del_all_phy" ) { + doDelWiphyVdevs(); + if ($::db_postload ne "") { + load_db($::db_preload); + } +} +elsif ($action eq "show_port") { + print $utils->doAsyncCmd(fmt_cmd("nc_show_port", 1, $resource, (sort(keys %sta_names))[0])) . "\n"; +} + +exit(0); diff --git a/lf_attenmod.pl b/lf_attenmod.pl new file mode 100755 index 000000000..c9d7133ec --- /dev/null +++ b/lf_attenmod.pl @@ -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); diff --git a/lf_auto_wifi_cap.pl b/lf_auto_wifi_cap.pl new file mode 100755 index 000000000..9cf3340a0 --- /dev/null +++ b/lf_auto_wifi_cap.pl @@ -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
over the air
funky-hardware-x
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
over-the-air to LANforge station system 5 feet away
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(/
/, $::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. + diff --git a/lf_cmc_macvlan.pl b/lf_cmc_macvlan.pl new file mode 100755 index 000000000..1fc6c73f3 --- /dev/null +++ b/lf_cmc_macvlan.pl @@ -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); +} diff --git a/lf_create_bcast.pl b/lf_create_bcast.pl new file mode 100755 index 000000000..ca72c936b --- /dev/null +++ b/lf_create_bcast.pl @@ -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 + + diff --git a/lf_cycle_wanlinks.pl b/lf_cycle_wanlinks.pl new file mode 100755 index 000000000..3e2e9f86e --- /dev/null +++ b/lf_cycle_wanlinks.pl @@ -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"); +} diff --git a/lf_endp_script.pl b/lf_endp_script.pl new file mode 100755 index 000000000..13f68f679 --- /dev/null +++ b/lf_endp_script.pl @@ -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 diff --git a/lf_firemod.pl b/lf_firemod.pl new file mode 100755 index 000000000..e95442e73 --- /dev/null +++ b/lf_firemod.pl @@ -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); diff --git a/lf_ice.pl b/lf_ice.pl new file mode 100755 index 000000000..d0ec444e4 --- /dev/null +++ b/lf_ice.pl @@ -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: "; + ; + } + 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 diff --git a/lf_icemod.pl b/lf_icemod.pl new file mode 100755 index 000000000..aa114082c --- /dev/null +++ b/lf_icemod.pl @@ -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); + diff --git a/lf_l4_auth.pl b/lf_l4_auth.pl new file mode 100755 index 000000000..779b2a39a --- /dev/null +++ b/lf_l4_auth.pl @@ -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"); +} + +# diff --git a/lf_l4_reset.sh b/lf_l4_reset.sh new file mode 100755 index 000000000..d3d4d57ac --- /dev/null +++ b/lf_l4_reset.sh @@ -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 -d -n -l " + echo " --mgr --delay --min --load " + 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 diff --git a/lf_log_parse.pl b/lf_log_parse.pl new file mode 100755 index 000000000..5c17083f7 --- /dev/null +++ b/lf_log_parse.pl @@ -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"; + } +} diff --git a/lf_loop_traffic.sh b/lf_loop_traffic.sh new file mode 100755 index 000000000..2dd32935c --- /dev/null +++ b/lf_loop_traffic.sh @@ -0,0 +1,70 @@ +#!/bin/bash + +if [ -z "$1" -o -z "$2" -o -z "$3" ]; then + echo "Usage: $0 " + 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 diff --git a/lf_macvlan.pl b/lf_macvlan.pl new file mode 100755 index 000000000..cb17467f3 --- /dev/null +++ b/lf_macvlan.pl @@ -0,0 +1,1509 @@ +#!/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, custom_tcp, l4 (http, https, ftp and fileIO) +# across real ports and MACVLAN ports on one or more machines. +# It then continously starts and stops the connections. + +# Un-buffer output +$| = 1; + +use strict; +#use Switch; + +use Net::Telnet (); +use LANforge::Port; +use LANforge::Utils; + +my $script_speed = 25; # Increase to issue commands faster. +my $pause = 0; # Increase delay (seconds) if experiencing problems on slow systems. + +my $INIT = 0; # If true, removes all previous tests and ports!!! +my $create_only = 1; # If true, only create tests, i.e. do not automatically run them. + +my $mac_init = 0; # Set to 1 to start MAC address from zero when running looped test. +my $ip_init = 0; # Set to 1 to start IP addresses from zero when running looped test. +my $init_once = 0; # Set to 1 to only initialize test creation once. +my $init_net = 1; # Set to 0 to disable reconfiguring MAC and IP addresses. +my $init_tests = 1; # Set to 0 to disable reconfiguring tests. +my $first_run = 1; # Set to 0 to disable initial configurations. +my $name_id = 0; # First index of name of endpoints and CXs. +my $name_id_len = 0; # Override for length of $name_id. +my $loop_max = 100; +my $start_stop_loops = 2; +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 $ignore_phys_ports = 1; # If true, just muck with mac-vlans. + +my $one_cx_per_port = 0; # If zero, will have one of EACH of the cx types on each port. + +my $cx_types_from_file = 0; # If true, will rotate through the @cx_types_files + # when creating tests instead of using @cx_types array. +#cx_types files must be CSV. +my @cx_types_files = ("/tmp/cx_type-foo.txt", "/tmp/cx_type-foo1.txt"); + +#my @cx_types = ("lf", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4", "voip"); +#my @min_pkt_szs = (64, 1, 1, 1, 1, 0); +#my @max_pkt_szs = (1514, 12000, 13000, 2048, 2048, 0); + +#my @cx_types = ("lf_udp"); +my @cx_types = ("lf_tcp"); +#my @cx_types = ("l4", "l4", "l4", "l4", "l4", "l4", "l4", "l4", "l4", "l4"); +#my @cx_types = ("l4"); +#my @cx_types = ( +#"lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp", "lf_udp" +#,"l4"); + + +my $test_mgr = "ben_tm"; +my $report_timer = 8000; # Set report timer for all tests created in ms, i.e. 8 seconds + +my $lfmgr_host = undef; +my $lfmgr_port = 4001; + +my $shelf = 1; + +# This sets up connections. +my $lf1 = 1; # Minor Resource EID of first LANforge resource. +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", "eth1"); +my @lf2_ports = (""); +my @ip_base = ( "192.168", "172.16"); +my @ip_c = ( 2 , 1 ); +my @ip_lsb = ( 2 , 2 ); +my @msk = ("255.255.0.0", "255.255.0.0"); +my @ip_gw = ("192.168.2.1", "172.16.1.1"); + +#my $ip_base1 = "172.16"; # Use this set. +#my $ip_c1 = 2; # +#my $ip_lsb1 = 2; # +#my $msk1 = "255.255.0.0"; # +#my $ip_gw1 = "0.0.0.0"; # + +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 $mvl = 1; +my $start_mvlan = 0; +my $num_mvlans = 9; +my $num_cxs = 10; + +#my @min_rate = (100000);# bps +#my @max_rate = (100000);# bps +my @min_rate = (9600, 64000, 1000000, 9600); # bps +my @max_rate = (9600, 64000, 1000000, 1000000);# bps +#my @min_pkt_szs = (0); # bytes +#my @max_pkt_szs = (0); # bytes +my @min_pkt_szs = (40, 548, 1472, 40); # bytes +my @max_pkt_szs = (40, 548, 1472, 1472); # bytes + + +################ +# Layer-4 Only # +################ + +my $url_dl = 1; # If true, test will download from URL. False will upload to URL. +#my $l4_dl_path = "/tmp"; # Path to save downloaded file. +#my $l4_dl_path = "NUL"; # Windows equivalent of *nix /dev/null. +my $l4_dl_path = "/dev/null"; # Improve performance by saving downloaded file to /dev/null. + +#my @l4_urls = ( +# "http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +#,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +#,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +#,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +#,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +#); +my @l4_urls = ("http://192.168.100.3/index.html"); +#my @l4_urls = ("ftp://192.168.100.3/file"); + +my $urls_10m = 100; # How many URLs to process every 10 minutes. +my $l4_timeout = 10000; # How long to wait for a connection, in milliseconds. + + +############# +# VoIP Only # +############# +my $codec = "G711U"; # Other options: G711U, g729a, SPEEX, g726-16, g726-24, g726-32, g726-40 +my $jB_size = 1; # Set jitter buffer size in 20ms packets. Default value is 8 packets, 160ms. +my $tos = 0xBE; # Set ToS/QoS for VoIP can be decimal or 0xNN for hexadecimal but values will display in decimal in the GUI. + +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"; # set $vproto = "H323"; for H.323 +my $bsip_port_a = "5066"; # Base SIP port for endpoint-A +my $bsip_port_b = "5067"; # Base SIP port for endpoint-B +my $i_sip_port_a = 0; # If zero, do not increment, otherwise increment by assigned value. +my $i_sip_port_b = 0; # If zero, do not increment, otherwise increment by assigned value. +my $brtp_port = "AUTO"; # Base RTP port +my $i_rtp_port = 0; # If zero, do not increment, otherwise increment by assgined value + +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"); + +################ +# File-IO Only # +################ +my $fio_base = "/mnt/fio_base"; +my $fio_targ_dir = ""; +my $fsrw = "write"; + + +my $DEBUG = 0; +my $D_PAUSE = 3; + +######################################################################## +# Nothing to configure below here, most likely. +######################################################################## +my $script_name = $0; + +# 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 eq undef) { + print "\nYou must define a LANforge Manager!!!\n\n" + . "For example:\n" + . "./$script_name mgr=localhost\n" + . "OR\n" + . "./$script_name mgr=192.168.1.101\n\n"; + printHelp(); + exit (1); +} + +my $foundL4 = 0; +for ($i = 0; $i<@cx_types; $i++) { + if ($cx_types[$i] eq "l4") { + $foundL4 = 1; + last; + } +} +if ($lf2 == "" && @lf1_ports < 2 && !$foundL4) { + die ("Must have more than one port with only one resource."); +} + + +if (!$num_mvlans) { $mvl=0; } + + +#if (!$start_mvlan && !$num_mvlan && $num_cxs) { +# die ("Must have either number of MACVLANs (num_mvl) or cross-connects (num_cxs) > 0."); +#} + +print + "\nStarting script with the following arguments:" + . "\ninit: $INIT" + . "\nmanager: $lfmgr_host\n" + . "\nlf1: $lf1\nlf2: $lf2\n" + . "\nlf1_ports: " . join(" ", @lf1_ports) + . "\nlf2_ports: " . join(" ", @lf2_ports) . "\n" + . "\nstart_macvlans: $start_mvlan" + . "\nnum_mvlans: $num_mvlans\n" + . "\nmin_rates: " . join(" ", @min_rate) + . "\nmax_rates: " . join(" ", @max_rate) + . "\nmin_pkt_sizes: " . join(" ", @min_pkt_szs) + . "\nmax_pkt_sizes: " . join(" ", @max_pkt_szs) . "\n" + . "\ncx_types: " . join(" ", @cx_types) + . "\nnum_cxs: $num_cxs\n" + . "\none_cx_per_port: $one_cx_per_port\n\n"; + +if ($DEBUG) { sleep ($D_PAUSE); } + + +# Determine total port and endpoint counts and make sorting by name easier in the GUI :P + +my @num = (); # Formatted index number for name sorting in GUI. +my $t_num = 0; +my $t_ports = 0; +my $ni=0; +my $nj=0; + +my @lf1orig_ports = @lf1_ports; +my @lf2orig_ports = @lf2_ports; +my $lf2orig = $lf2; + +if ($lf2 == "") { + $lf2 = $lf1; + if ($foundL4) { + @lf2_ports = undef; + } + else { + # Put every other port into @lf2_ports to fake out lf2 info which makes the + # script work later. + # TODO: Stop faking out too early since we end up probing the same ports multiple times + # because of $num_cxs. This needs to move to below utils->updatePort @all_ports1 + # and @all_ports2 + @lf1_ports = undef; + @lf2_ports = undef; + $i=0; + if ($mvl) { + for ($ni=0; $ni<@lf1orig_ports; $ni++) { + $lf1_ports[$i] = $lf1orig_ports[$ni]; + $lf2_ports[$i] = $lf1orig_ports[++$ni]; + $i++; + } + } else { + for ($nj=0; $nj<($num_cxs*2); $nj++) { + for ($ni=0; $ni<(@lf1orig_ports); $ni++) { + $lf1_ports[$i] = $lf1orig_ports[$ni]; + $lf2_ports[$i] = $lf1orig_ports[++$ni]; + $i++; + } + } + } # if mvl + } # if foundL4 +} # if lf2 = "" + +if ($DEBUG) { printArgs(); sleep ($D_PAUSE); } + +# Check that ip_base address pairs aren't the same. +for ($ni = 0; $ni<@ip_base; $ni++) { + if ($ip_base[$ni] == $ip_base[$ni+1]) { + die ("ERROR: Base IP addresses cannot be the same."); + } + $ni++; +} + +my @cxts = ("lf", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4", + "fileIONFS", "fileIOCIFS"); +my @t_cxts = (); +for ($ni=0; $ni<@cxts; $ni++) { + @t_cxts[$ni] = 0; +} + +if ($lf2orig ne "") { + if ($ignore_phys_ports) { + $t_ports = $num_mvlans; + } + else { + $t_ports = @lf1_ports + @lf2_ports + ($num_mvlans); + if (@lf2_ports eq undef) { $t_ports--; } + } +} +elsif ($num_mvlans) { + if ($ignore_phys_ports) { + $t_ports = $num_mvlans; + } + else { + $t_ports = @lf1_ports + ($num_mvlans); + } +} +else { + $t_ports = @lf1_ports + @lf2_ports; + if (@lf2_ports eq undef) { $t_ports--; } + $t_ports *= $num_cxs; +} + +my $t_cxtypes = @cx_types; +my $t_urls = @l4_urls; + +if (@min_rate != @max_rate ) { + die("Number of elements in min_rate does not match number of elements in max_rate."); +} +else { + my $t_rate = @min_rate + @max_rate; +} +if (@min_pkt_szs != @max_pkt_szs ) { + die("Number of elements in min_pkt_szs does not match number of elements in max_pkt_szs."); +} +else { + my $t_pkt_szs = @min_pkt_szs + @max_pkt_szs; +} + +for ($ni=0; $ni<@cx_types; $ni++) { + for ($nj=0; $nj<@cxts; $nj++) { + if ( $cx_types[$ni] eq $cxts[$nj] ) { + $t_cxts[$nj]++; + } + } +} + +for ($nj=0; $nj<@cxts; $nj++) { + if ( $cxts[$nj] eq "l4") { + $t_num += ($t_ports * (2 * ($t_cxts[$nj] * $t_urls))); + } + else { + $t_num += ($t_ports * (2 * $t_cxts[$nj])); + } +} +$t_num += $name_id; + +my $num_len; +if ($name_id_len) { + if (length($name_id) > $name_id_len || length($t_num) > $name_id_len) { + print "\nWARNING: id_len specifies a string length less that first_name_id or less that total number of endpoints\n"; + } + $num_len = $name_id_len; +} +else { + $num_len = length ($t_num); +} +$t_num -= $name_id; +my $i = 0; + +# !!! DO NOT Reimplement Switch/Case since the following will cause switch/case to fail: +# !!! for ($nj=0; $nj<($num_cxs / @lf1orig_ports); $nj++) { +# !!! Why? DUNNO! + +#switch ($num_len) { +# case 1 { +# for ($i ; $i<$t_num; $i++) { +# $num[$i] = sprintf("%01d", $name_id + $i); +# } +# } +# case 2 { +# for ($i ; $i<$t_num; $i++) { +# $num[$i] = sprintf("%02d", $name_id + $i); +# } +# } +# case 3 { +# for ($i ; $i<$t_num; $i++) { +# $num[$i] = sprintf("%03d", $name_id + $i); +# } +# } +# case 4 { +# for ($i ; $i<$t_num; $i++) { +# $num[$i] = sprintf("%04d", $name_id + $i); +# } +# } +# case 5 { +# for ($i ; $i<$t_num; $i++) { +# $num[$i] = sprintf("%05d", $name_id + $i); +# } +# } +# case 6 { +# for ($i ; $i<$t_num; $i++) { +# $num[$i] = sprintf("%06d", $name_id + $i); +# } +# } +# else { +# for ($i ; $i<$t_num; $i++) { +# $num[$i] = $name_id + $i; +# } +# } +#} + +if ($num_len == 1) { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%01d", $name_id + $i); + } +} +elsif ($num_len == 2) { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%02d", $name_id + $i); + } +} +elsif ($num_len == 3) { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%03d", $name_id + $i); + } +} +elsif ($num_len == 4) { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%04d", $name_id + $i); + } +} +elsif ($num_len == 5) { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%05d", $name_id + $i); + } +} +elsif ($num_len == 6) { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%06d", $name_id + $i); + } +} +else { + for ($i ; $i<$t_num; $i++) { + $num[$i] = $name_id + $i; + } +} + +if ($DEBUG > 99) { + $i = 0; + print "name_id: $name_id, t_num: $t_num, num_len: $num_len :-\n"; + for ($i ; $i<$t_num; $i++) { + print $num[$i] . " "; + } + print "\n"; + sleep ($D_PAUSE); +} +if ($DEBUG) { printArgs(); sleep ($D_PAUSE); } + +# Open connection to the LANforge server. +my $t = new Net::Telnet(Timeout => 15, + Prompt => '/default\@btbits\>\>/'); + +$t->open(Host => $lfmgr_host, + Port => $lfmgr_port, + Timeout => 45); + +$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 ?? + +my $dt = getDate(); +my $dt_start = $dt; + +my @endpoint_names = (); #will be added to as they are created +my @cx_names = (); + +my $loop = 0; +for ($loop = 0; $loop<$loop_max; $loop++) { + $dt = getDate(); + print "\n\n***** Starting $script_name loop: $loop at: $dt *****\n\n"; + + if (!$init_once) { + if ($INIT) { initToDefaults(); } + + if ($init_net) { + if ($mvl) { addMacVlans(); } # Add MACVLANs. + initIpAddresses(); # Add some IP addresses to the ports. + } + if ($init_tests) { + doCmd("rm_cx $test_mgr all"); + doCmd("rm_endp YES_ALL"); + doCmd("rm_test_mgr $test_mgr"); + 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 + addCrossConnects(); # Add our endpoints. + } + } + elsif ($first_run) { + $first_run = 0; + if ($INIT) { initToDefaults(); } + + if ($init_net) { + if ($mvl) { addMacVlans(); } + initIpAddresses(); + } + if ($init_tests) { + doCmd("rm_cx $test_mgr all"); + doCmd("rm_endp YES_ALL"); + doCmd("rm_test_mgr $test_mgr"); + 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 + addCrossConnects(); # Add our endpoints. + } + } + + $dt = getDate(); + print "\n\n*** Started $script_name script at : $dt_start ***\n" + . "*** Finished $script_name configuration at: $dt ***\n\n"; + sleep($D_PAUSE); + + if ($create_only == 1) { exit(0); } + + my $rl = 0; + for ($rl = 0; $rl<$start_stop_loops; $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 + +if ($DEBUG) { printArgs(); } + +$dt = getDate(); +print "Started $script_name script at : $dt_start\n"; +print "Completed $script_name script at: $dt\n\n"; +exit(0); +##################### +# END lf_macvlan.pl # +##################### +sub addCrossConnects { + my $ep = 0; + my $cx = 0; + my $i = 0; + my $szs = 0; + my $r = 0; + my @all_ports1 = @lf1_ports; +# my @all_ports1 = @lf1orig_ports; This don't work + my @all_ports2 = (""); + my $j; + my $pname; + + if ($foundL4) { + my $p1 = new LANforge::Port(); + my $q; + for ($q = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + for ($j = 0; $j<@lf1_ports; $j++) { + $utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]); + $pname = $p1->{dev}; + @all_ports1 = (@all_ports1, "$pname\#$q"); + } + } + if ($ignore_phys_ports) { + for ($j = 0; $j<@lf1_ports; $j++) { + shift(@all_ports1); + } + } + # TODO: Fake out ports here to create num_cxs tests. + } + else { + 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 = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + @all_ports1 = (@all_ports1, "$pname\#$q"); + } + } + @all_ports2 = @lf2_ports; +# @all_ports2 = @lf2orig_ports; This don't work + 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 = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + @all_ports2 = (@all_ports2, "$pname\#$q"); + } + } + if ($ignore_phys_ports) { + for ($j = 0; $j<@lf1_ports; $j++) { + shift(@all_ports1); + } + for ($j = 0; $j<@lf2_ports; $j++) { + shift(@all_ports2); + } + } + # TODO: Fake out ports here to create num_cxs tests. + } # if foundL4 + + print "\n\n\nCreating endpoints on " . @all_ports1 . " ports:\nall_ports1: " . join(" ", @all_ports1); + +# if ($lf2orig ne "") { + print "\nCreating endpoints on " . @all_ports2 . " ports:\nall_ports2: " . join(" ", @all_ports2) . "\n\n\n"; +# } + + if ($DEBUG) { sleep($D_PAUSE); } + + if ($one_cx_per_port) { + my $j = 0; + my $cxcnt = 0; + my $fecnt = 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]}"; +# $ep++; + my $ep2 = "D_L4-${num[$ep]}"; + $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); + + if ($l4_dl_path = "/dev/null") { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[0]} $l4_dl_path' ' '"; + } + else { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[0]} $l4_dl_path/$ep1' ' '"; + } + doCmd($cmd); + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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); + }# if L4 + elsif ($cxt eq "voip") { + + + + + + }# if VoIP + elsif (($cxt eq "fileIONFS") || ($cxt eq "fileIOCIFS")) { + # Create File-IO endpoint + + my $FST = "nfs"; + if ($cxt eq "fileIOCIFS") { + $FST = "cifs"; + } + + my $ep1 = "fe-${num[$fecnt]}"; + my $ep2 = "D_$ep1"; + $fecnt++; + $ep++; +# $ep++; + + @endpoint_names = (@endpoint_names, $ep1, $ep2); + + # Add the dummy endpoint + my $cmd = "add_file_endp $ep2 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing $fio_base/$ep2 $ep2"; + doCmd($cmd); + $cmd = "set_endp_flag $ep2 unmanaged 1"; + doCmd($cmd); + + $cmd = "add_file_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing \'$fio_base/$FST" + . "_$all_ports1[$j]" . $fio_targ_dir . "\' $ep1"; + doCmd($cmd); + + $cmd = "set_fe_info $ep1 16384 16384 10 1000000 1000000 \'$fio_base/$FST" . "_$all_ports1[$j]" + . $fio_targ_dir . "\' $ep1 $fsrw"; + doCmd($cmd); + + if ($r < (@min_rate - 1)) { + $r++; + } + else { + $r = 0; + } + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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 FIO + else { + # Create L3 endpoint + + my $burst = "NO"; + if ($min_rate[$r] != $max_rate[$r]) { + $burst = "YES"; + } + my $szrnd = "NO"; + if ($min_pkt_szs[$szs] != $max_pkt_szs[$szs]) { + $szrnd = "YES"; + } + + my $pattern = "increasing"; + if ($cx_types[$i] =~ /custom/) { + $pattern = "custom"; + } + + my $ep1 = "L3e-${num[$ep]}tx"; + $ep++; + my $ep2 = "L3e-${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[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + doCmd($cmd); + + if ($lf2 ne "") { +# die("Must have lf2 defined if using non-l4 endpoints."); + $cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . + $max_pkt_szs[$szs] . " $pattern NO"; + } + else { + $cmd = "add_endp $ep2 $shelf $lf1 " . $all_ports1[($j)] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + } + doCmd($cmd); + + if ($szs < (@min_pkt_szs - 1)) { $szs++; } + else { $szs = 0; } + if ($r < (@min_rate - 1)) { $r++; } + else { $r = 0; } + + # Now, add the cross-connects + my $cx_name = "L3-${num[$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 L3 + }#for all ports + }#one_cx_per_port = 1 + else { + my $j = 0; + my $n = 0; + my $fecnt = 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 + for ($n = 0; $n<@l4_urls; $n++) { + my $ep1 = "L4-${num[$ep]}"; +# $ep++; + my $ep2 = "D_L4-${num[$ep]}"; + $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); + if ($l4_dl_path = "/dev/null") { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[$n]} $l4_dl_path' ' '"; + } + else { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[$n]} $l4_dl_path/$ep1' ' '"; + } + doCmd($cmd); + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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 url_list + } + elsif ($cxt eq "voip") { + + + + + + }# if VoIP + elsif (($cxt eq "fileIONFS") || ($cxt eq "fileIOCIFS")) { + # Create File-IO endpoint + my $FST = "nfs"; + if ($cxt eq "fileIOCIFS") { + $FST = "cifs"; + } + + my $ep1 = "fe-${num[$fecnt]}"; + my $ep2 = "D_$ep1"; + $fecnt++; + $ep++; +# $ep++; + + @endpoint_names = (@endpoint_names, $ep1, $ep2); + + # Add the dummy endpoint + my $cmd = "add_file_endp $ep2 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing $fio_base/$ep2 $ep2"; + doCmd($cmd); + $cmd = "set_endp_flag $ep2 unmanaged 1"; + doCmd($cmd); + + $cmd = "add_file_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing $fio_base/$FST" . "_$all_ports1[$j]" . $fio_targ_dir . " $ep1"; + doCmd($cmd); + + $cmd = "set_fe_info $ep1 16384 16384 10 1000000 1000000 $fio_base/$FST" + . "_$all_ports1[$j]" . $fio_targ_dir . " $ep1 $fsrw"; + doCmd($cmd); + + if ($r < (@min_rate - 1)) { $r++; } + else { $r = 0; } + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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 { + # Create L3 endpoint + + my $burst = "NO"; + if ($min_rate[$r] != $max_rate[$r]) { + $burst = "YES"; + } + my $szrnd = "NO"; + if ($min_pkt_szs[$szs] != $max_pkt_szs[$szs]) { + $szrnd = "YES"; + } + + my $pattern = "increasing"; + if ($cx_types[$i] =~ /custom/) { + $pattern = "custom"; + } + + my $ep1 = "L3e-${num[$ep]}tx"; + $ep++; + my $ep2 = "L3e-${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[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + doCmd($cmd); + + + if ($lf2 ne "") { +# die("Must have lf2 defined if using non-l4 endpoints."); + $cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . + $max_pkt_szs[$szs] . " $pattern NO"; + } + else { + $cmd = "add_endp $ep2 $shelf $lf1 " . $all_ports1[$j+1] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + } + doCmd($cmd); + + if ($szs < (@min_pkt_szs - 1)) { $szs++; } + else { $szs = 0; } + if ($r < (@min_rate - 1)) { $r++; } + else { $r = 0; } + + # Now, add the cross-connects + my $cx_name = "L3-${num[$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 + }##one_cx_per_port = 0 +}#addCrossConnects +sub initToDefaults { + # Clean up database if stuff exists + if ($DEBUG) { + print "\nsub initToDefaults\n"; + } + 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 ($DEBUG) { + print "\nsub addMacVlans\n"; + } + if ($mac_init == 1 ) { + $lsb1 = sprintf("%d", $mac1); + $lsb2 = sprintf("%d", $mac2); + $lsb3 = sprintf("%d", $mac3); + } + my $i; + my $q; + my $pnum1; + my $pnum2; + my $throttle = $script_speed; + my $since_throttle = 0; + for ($i = $start_mvlan; $i<($num_mvlans + $start_mvlan); $i++) { + for ($q = 0; $q<@lf1_ports; $q++) { + + $pnum1 = $lf1_ports[$q]; + 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"); + + $pnum2 = $lf2_ports[$q]; + if ($pnum2 ne "") { + $card = sprintf("%02x", $lf2); + $mac_index = getNextMac(); + $mac_addr = "00:$shlf:$card:$mac_index"; + doCmd("add_mvlan $shelf $lf2 $pnum2 $mac_addr $i"); + } + if ($DEBUG > 1) { sleep($D_PAUSE); } + + # 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 ($pnum2 ne "") { + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf2, $pnum2); + } + $since_throttle = 0; + } + } + } + + doCmd("probe_ports"); + + # Wait until 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 ($pnum2 ne "") { + $utils->updatePort($p2, $shelf, $lf2, $lf2_ports[$q]); + $pname2 = $p2->{dev}; + } + + for ($i = $start_mvlan; $i<($num_mvlans + $start_mvlan); $i++) { + while (1) { + $utils->updatePort($p1, $shelf, $lf1, "$pname\#$i"); + if ($pnum2 ne "") { + $utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i"); + } + if ($p1->isPhantom() || (($pnum2 ne "") && $p2->isPhantom())) { + sleep(1); + } + else { + last; + } + } + } + } +}#addMacVlans + +# 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 ($lf2orig ne "") { + clearMacVlanPorts($shelf, $lf2); + } + + throttleCard($shelf, $lf1); + if ($lf2orig 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]; + if ($tmp ne "0") { + doCmd("set_port $shelf $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA"); + } + if ($lf2orig ne "") { + if ($tmp2 ne "0") { + 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; + for ($i = 0; $i<$mx; $i++) { + if ($ports[$i]->isMacVlan()) { + doCmd($ports[$i]->getDeleteCmd()); + $found_one = 1; + } + } + } +} + + +sub initIpAddresses { + # Set all ports we are messing with to known state. + my $i; + +# TODO: This loop needs to only loop for the number of "real"/necessary ports +# because lf1_ports is faked by num_cxs when num_mvlans is 0 and slows the +# script down. + for ($i = 0; $i<@lf1_ports; $i++) { +# for ($i = 0; $i<(@lf1orig_ports + @lf2orig_ports); $i++) { + +# if ($ip_lsb[$i] > 250) { +# $ip_c[$i]++; +# $ip_lsb[$i] = 2; +# } + +# TODO: The whole assignment of IPs to physical ports need to be encapsulated in +# a loop, much like the MACVLANs... + + my $ptmp = $lf1_ports[$i]; + my $ptmp2 = $lf2_ports[$i]; + my $cmd = ""; + if (!$ignore_phys_ports) { +# $cmd = "set_port $shelf $lf1 $ptmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA"; + +# $cmd = "set_port $shelf $lf1 $ptmp " . +# "$ip_base[$i].$ip_c[$i].$ip_lsb[$i] $msk[$i] " . +# "$ip_gw[$i] NA NA NA"; + + if ($ptmp ne "") { +# doCmd($cmd); + } + if ($ptmp2 ne "") { +# $cmd = "set_port $shelf $lf2 $ptmp2 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA"; + +# $cmd = "set_port $shelf $lf2 $ptmp2 " . +# "$ip_base[$i+1].$ip_c[$i+1].$ip_lsb[$i+1] $msk[$i+1] " . +# "$ip_gw[$i+1] NA NA NA"; +# doCmd($cmd); + } + } + +# END TODO + + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf1, $ptmp); + my $pname = $p1->{dev}; + + my $q; + my $throttle = $script_speed; + my $since_throttle = 0; + + for ($q = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + $cmd = "set_port $shelf $lf1 $pname\#$q " . + "$ip_base[$i].$ip_c[$i].$ip_lsb[$i] $msk[$i] " . + "$ip_gw[$i] NA NA NA"; + doCmd($cmd); + $ip_lsb[$i]++; + + if ($ip_lsb[$i] > 250) { + $ip_c[$i]++; + $ip_lsb[$i] = 2; + } + + if ($since_throttle++ > $throttle) { + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf1, "$pname\#$q"); + $since_throttle = 0; + } + } + + if ($ptmp2 ne "") { + $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf2, $ptmp2); + $pname = $p1->{dev}; + + for ($q = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + if (@ip_base == 1) { + $cmd = "set_port $shelf $lf2 $pname\#$q " . + "$ip_base[$i].$ip_c[$i].$ip_lsb[$i] $msk[$i] " . + "$ip_gw[$i] NA NA NA"; + doCmd($cmd); + $ip_lsb[$i]++; + + if ($ip_lsb[$i] > 250) { + $ip_c[$i]++; + $ip_lsb[$i] = 2; + } + } + else { + $cmd = "set_port $shelf $lf2 $pname\#$q " . + "$ip_base[$i+1].$ip_c[$i+1].$ip_lsb[$i+1] $msk[$i+1] " . + "$ip_gw[$i+1] NA NA NA"; + doCmd($cmd); + $ip_lsb[$i+1]++; + + if ($ip_lsb[$i+1] > 250) { + $ip_c[$i+1]++; + $ip_lsb[$i+1] = 2; + } + } + if ($since_throttle++ > $throttle) { + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf2, "$pname\#$q"); + $since_throttle = 0; + } + } # for $q + } # if we have an lf2_ports defined + } +} + +sub doCmd { + my $cmd = shift; + + if ($cmd) { + print ">>> $cmd\n"; + $t->print($cmd); + my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/'); + print "**************\n @rslt ................\n\n"; + } else { + print "\n***** doCmd (): NULL COMMAND !!! *****"; + print "\n$cmd\n\n"; + exit (1); + } + #sleep(1); +} + +sub getDate { + my $date = `date`; + chomp($date); + return $date +} + +sub printArgs { + print + "\n$script_name" + . "\nModified arguments:" + . "\ninit: $INIT" + . "\nmanager: $lfmgr_host\n" + . "\nlf1: $lf1\nlf2: $lf2\n" + . "\nlf1_ports: " . join(" ", @lf1_ports) + . "\nlf2_ports: " . join(" ", @lf2_ports) . "\n" + . "\nstart_macvlans: $start_mvlan" + . "\nnum_mvlans: $num_mvlans" + . "\nmvl: $mvl\n" + . "\nmin_rates: " . join(" ", @min_rate) + . "\nmax_rates: " . join(" ", @max_rate) + . "\nmin_pkt_sizes: " . join(" ", @min_pkt_szs) + . "\nmax_pkt_sizes: " . join(" ", @max_pkt_szs) . "\n" + . "\ncx_types: " . join(" ", @cx_types) + . "\none_cx_per_port: $one_cx_per_port\n\n" + . "\n" + . "Available CX types: " . join(", ", @cxts) . "\n" + . "Total of each CX type: " . join(", ", @t_cxts) . "\n" + . "Total number of ports: $t_ports\n" + . "Total number of urls: " . scalar(@l4_urls) . "\n" + . "Total number of endpoints and CXs: $t_num\n" + . "\n\n"; +} + +sub printMark { + print + "\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*" + ."\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n*\n"; +} + + +sub printHelp { + print + "\n$script_name\n" + . "USAGE: mgr=[ip-of-mgr] speed=[25|n] wait=[0|n] DEBUG=[0|1|2|...] D_PAUSE=[3|n]\n" + . " config_once=[0|1] init=[0|1] init_net=[1|0] init_tests=[1|0]\n" + . " test_mgr=\"ben_tm\" first_run=[1|0]\n" + . " first_name_id=[0|n] id_len=[0|n]\n" + . " create_only=[0|1] one_cx_per_port=[0|1] ignore_phy_ports=[1|0]\n" + . " lf1=[1|n] lf2=[none|n=!lf1]\n" + . " lf1_ports=[\"1 2 3\"|\"eth2 eth3\"] lf2_ports=[\"4 5 6\"|\"eth4 eth5\"]\n" + . " start_mvl=[0|n] num_mvl=[9|0]\n" + . " if (num_mvl=0) num_cxs_per_port=[10|n]\n" + . " mac3=0xf0 mac2=0xbe mac1=0xef\n" + . " ip_base= \"192.168 172.16\"\n" + . " ip_c = \"2 1\"\n" + . " ip_lsb = \"2 2\"\n" + . " ip_msk =\"255.255.0.0 255.255.0.0\"\n" + . " ip_gw =\"192.168.2.1 172.16.1.1\"\n" + . " cx_types=\"lf lf_udp lf_tcp custom_udp custom_tcp l4 fileIONFS fileIOCIFS\"\n" + . " min_rates=\"9600 56000 128000\" max_rates=\"56000 128000 25600\"\n" + . " min_pkt_sizes=\"500 500 500\" max_pkt_sizes=\"1000 1000 1000\"\n" + . " url_rate=100 l4_wait=10000\n" + . " urls=\"http://www.candelatech.com/file ftp://www.candelatech.com/file https://www.candelatech.com/file\"\n" + . " fsrw=[read|write] fio_targ_dir=tmp/ fio_base=/mnt/fio_base\n" + . "\n"; + +} + +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 "debug" || $arg eq "DEBUG") { + $DEBUG = $val; + } + elsif ($arg eq "d_pause" || $arg eq "D_PAUSE") { + $D_PAUSE = $val; + } + elsif ($arg eq "mgr") { + $lfmgr_host = $val; + } + elsif ($arg eq "test_mgr") { + $test_mgr = $val; + } + elsif ($arg eq "init") { + $INIT = $val; + } + elsif ($arg eq "config_once") { + $init_once = $val; + } + elsif ($arg eq "init_net") { + $init_net = $val; + } + elsif ($arg eq "init_tests") { + $init_tests = $val; + } + elsif ($arg eq "first_run") { + $first_run = $val; + } + elsif ($arg eq "first_name_id") { + $name_id = $val; + } + elsif ($arg eq "id_len") { + $name_id_len = $val; + if (length($name_id) > $name_id_len) { + print "\nWARNING: id_len specifies a string length less that first_name_id.\n"; + } + } + elsif ($arg eq "speed") { + $script_speed = $val; + } + elsif ($arg eq "wait") { + $pause = $val; + } + elsif ($arg eq "lf1") { + $lf1 = $val; + } + elsif ($arg eq "lf2") { + $lf2 = $val; + if ($lf1 == $lf2) { + die("\nINVALID: First and second resource are the same !!!\n\n"); + } + } + elsif ($arg eq "mac3") { + $mac3 = $val; + } + elsif ($arg eq "mac2") { + $mac2 = $val; + } + elsif ($arg eq "mac1") { + $mac1 = $val; + } + elsif ($arg eq "ip_base") { + @ip_base = undef; + @ip_base = split(/ /, $val); + } + elsif ($arg eq "ip_c") { + @ip_c = undef; + @ip_c = split(/ /, $val); + } + elsif ($arg eq "ip_lsb") { + @ip_lsb = undef; + @ip_lsb = split(/ /, $val); + } + elsif ($arg eq "ip_msk") { + @msk = undef; + @msk = split(/ /, $val); + } + elsif ($arg eq "ip_gw") { + @ip_gw = undef; + @ip_gw = split(/ /, $val); + } + elsif ($arg eq "lf1_ports") { + @lf1_ports = split(/ /, $val); + } + elsif ($arg eq "lf2_ports") { + if ($lf2 == "" || $lf1 == $lf2) { + die("\nINVALID: Either second resource is not defined\nor first and second resource are the same !!!\n\n"); + } + else { + @lf2_ports = split(/ /, $val); + } + } + elsif ($arg eq "cx_types") { + @cx_types = split(/ /, $val); + } + elsif ($arg eq "min_pkt_sizes") { + @min_pkt_szs = split(/ /, $val); + } + elsif ($arg eq "max_pkt_sizes") { + @max_pkt_szs = split(/ /, $val); + } + elsif ($arg eq "start_mvl") { + $start_mvlan = $val; + } + elsif ($arg eq "num_mvl") { + $num_mvlans = $val; + } + elsif ($arg eq "num_cxs_per_port") { + $num_cxs = $val; + } + elsif ($arg eq "min_rates") { + @min_rate = split(/ /, $val); + } + elsif ($arg eq "max_rates") { + @max_rate = split(/ /, $val); + } + elsif ($arg eq "fsrw") { + $fsrw = $val; + } + elsif ($arg eq "fio_base") { + $fio_base = $val; + } + elsif ($arg eq "fio_targ_dir") { + $fio_targ_dir = $val; + } + elsif ($arg eq "urls") { + @l4_urls = split(/ /, $val); + } + elsif ($arg eq "url_rate") { + $urls_10m = $val; + } + elsif ($arg eq "l4_wait") { + $l4_timeout = $val; + } + elsif ($arg eq "one_cx_per_port") { + $one_cx_per_port = $val; + } + elsif ($arg eq "ignore_phy_ports") { + $ignore_phys_ports = $val; + } + elsif ($arg eq "create_only") { + $create_only = $val; + } + else { + print "\n\nCould not parse one or more of the arguments !!!\n" + . "First rejected argument: $arg\n"; + printHelp(); + exit(1); + } +} diff --git a/lf_macvlan2.pl b/lf_macvlan2.pl new file mode 100755 index 000000000..64f62e611 --- /dev/null +++ b/lf_macvlan2.pl @@ -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); +} diff --git a/lf_macvlan3.pl b/lf_macvlan3.pl new file mode 100755 index 000000000..d53b9ef00 --- /dev/null +++ b/lf_macvlan3.pl @@ -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); +} diff --git a/lf_macvlan_l4.pl b/lf_macvlan_l4.pl new file mode 100755 index 000000000..59c16a5b6 --- /dev/null +++ b/lf_macvlan_l4.pl @@ -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); +} diff --git a/lf_macvlan_streams.pl b/lf_macvlan_streams.pl new file mode 100755 index 000000000..4033b15eb --- /dev/null +++ b/lf_macvlan_streams.pl @@ -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); +} diff --git a/lf_many_conn.pl b/lf_many_conn.pl new file mode 100755 index 000000000..3f4711c59 --- /dev/null +++ b/lf_many_conn.pl @@ -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: "; + ; + } + 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 diff --git a/lf_many_conn2.pl b/lf_many_conn2.pl new file mode 100755 index 000000000..468c593ff --- /dev/null +++ b/lf_many_conn2.pl @@ -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: "; + ; + } + 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 diff --git a/lf_many_vphy.pl b/lf_many_vphy.pl new file mode 100755 index 000000000..47db39216 --- /dev/null +++ b/lf_many_vphy.pl @@ -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); +} diff --git a/lf_max_cxs_v1_3000.pl b/lf_max_cxs_v1_3000.pl new file mode 100755 index 000000000..ab30de0ac --- /dev/null +++ b/lf_max_cxs_v1_3000.pl @@ -0,0 +1,1749 @@ +#!/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 Switch; + +use Net::Telnet (); +use Time::HiRes qw (usleep); +use LANforge::Port; +use LANforge::Utils; +use LANforge::Endpoint; + +my $init_stop_all = 1; # Stop all tests before running script test. +my $script_speed = 25; # Increase to issue commands faster. +my $quiet_cli_cmds = 1; # Quiesce CLI response output to commands sent. +my $quiet_cli_output = 1; # Quiesce unsolicited CLI output. +my $cli_cmd_delay = 0; # Increase to slow command rate sent to cli. +my $report_timer = 9000; # Set report timer for all tests created in ms, i.e. 8 seconds + +my $INIT = 1; # If true, removes all previous tests and ports!!! +my $create_only = 0; # If true, only create tests, i.e. do not automatically run them. + +my $mac_init = 0; # Set to 1 to start MAC address from zero when running looped test. +my $ip_init = 0; # Set to 1 to start IP addresses from zero when running looped test. +my $init_once = 1; # Set to 1 to only initialize test creation once. +my $init_net = 1; # Set to 0 to disable reconfiguring MAC and IP addresses. +my $init_tests = 1; # Set to 0 to disable reconfiguring tests. +my $first_run = 1; # Set to 0 to disable initial configurations. +my $name_id = 0; # First index of name of endpoints and CXs. +my $name_id_len = 0; # Override for length of $name_id. +my $loop_max = 3; +my $start_stop_loops = 2; +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 $keep_running = 1; # If ture, will keep last test loop running. +my $ignore_phys_ports = 1; # If true, just muck with MACVLANs. + +my $one_cx_per_port = 0; # If zero, will have one of EACH of the cx types on each port. + +my $cx_types_from_file = 0; # If true, will rotate through the @cx_types_files + # when creating tests instead of using @cx_types array. + +my @cx_types = ( +#"lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp", +"lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp", +"lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp", +"lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp","lf_tcp"); + +my $test_mgr = "max_cxs_tm"; + +my $lfmgr_host = "localhost"; +my $lfmgr_port = 4001; + +my $shelf = 1; + +# This sets up connections. +my $lf1 = 1; # Minor Resource EID of first LANforge resource. +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", "eth1"); +my @lf2_ports = (""); +my @ip_base = ( "192.168", "172.1"); +my @ip_c = ( 2 , 1 ); +my @ip_lsb = ( 2 , 2 ); +my @msk = ("255.255.255.0","255.255.255.0"); +my @ip_gw = ( "192.168.2.1", "172.1.1.1"); + +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 $start_mvlan = 0; +my $num_mvlans = 30; +my $num_cxs = 0; + +my @min_rate = (19200);# bps +my @max_rate = (19200);# bps +my @min_pkt_szs = (948); # bytes +my @max_pkt_szs = (948); # bytes + +########################## +# lf_max_cxs.pl specific # +########################## + +my $max_delay = 100; # Maximum endpoint delay threshold in milliseconds. +my $percent_ep_delay = 3.0;# Percentage of endpoints allowed to exceed the + # $max_delay. Exceeding percentage will cause curren + # test loop to exit. + +my $settle_time = 1; # Number of seconds to allow an endpoint to receive data +my $ep_rx_strikes = 3; # Number of strikes before declaring it failed. + +my $sample_time_dly = 500; # Milliseconds between endpoint delay samples. +my $samples = 3; + +my $use_udp_probe = 1; +my $use_udp_loss = 1; +my $end_udp_drop = 0; + +#my $percentile = 97; +#my $filename = "delay_data.txt"; + + +################ +# Layer-4 only # +################ + +my $url_dl = 1; # If true, test will download from URL. False will upload to URL. +#my $l4_dl_path = "/tmp"; # Path to save downloaded file. +#my $l4_dl_path = "NUL"; # Windows equivalent of *nix /dev/null. +my $l4_dl_path = "/dev/null"; # Improve performance by saving downloaded file to /dev/null. + +my @l4_urls = ( + "http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +,"http://192.168.100.3/index.html", "ftp://192.168.100.3/file", "http://192.168.100.3/index.html", "ftp://192.168.100.3/file" +); +#my @l4_urls = ("ftp://192.168.100.3/file"); + +my $urls_10m = 100; # How many URLs to process every 10 minutes. +my $l4_timeout = 10000; # How long to wait for a connection, in milliseconds. + + +########### +# File-IO # +########### + +my $fio_base = "/mnt/fio_base"; +my $fio_targ_dir = ""; +my $fsrw = "write"; + + +######### +# Debug # +######### + +my $DEBUG = 0; +my $D_PAUSE = 3; +######################################################################## +# Nothing to configure below here, most likely. +######################################################################## +my $script_name = $0; +$sample_time_dly = $sample_time_dly * 1000; + +# Parse cmd-line args +my $i; +my $j; +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); + } +} + +my $ss_wait + = 0.003 * $report_timer; # Increase delay (seconds) if experiencing problems on slow systems. + + +if ($lfmgr_host eq undef) { + print "\nYou must define a LANforge Manager!!!\n\n" + . "For example:\n" + . "./$script_name mgr=localhost\n" + . "OR\n" + . "./$script_name mgr=192.168.1.101\n\n"; + printHelp(); + exit (1); +} + +my $foundL4 = 0; +for ($i = 0; $i<@cx_types; $i++) { + if ($cx_types[$i] eq "l4") { + $foundL4 = 1; + last; + } +} +if ($lf2 == "" && @lf1_ports < 2 && !$foundL4) { + die ("Must have more than one port with only one resource."); +} + +#if (!$numvlan && !$num_cxs) { +# die ("Must have either number of MACVLANs (num_mvl) or cross-connects (num_cxs) > 0."); +#} + +print + "\nStarting script with the following arguments:" + . "\ninit: $INIT" + . "\nmanager: $lfmgr_host\n" + . "\nlf1: $lf1\nlf2: $lf2\n" + . "\nlf1_ports: " . join(" ", @lf1_ports) + . "\nlf2_ports: " . join(" ", @lf2_ports) . "\n" + . "\nstart_macvlans: $start_mvlan" + . "\nnum_mvlans: $num_mvlans\n" + . "\nmin_rates: " . join(" ", @min_rate) + . "\nmax_rates: " . join(" ", @max_rate) + . "\nmin_pkt_sizes: " . join(" ", @min_pkt_szs) + . "\nmax_pkt_sizes: " . join(" ", @max_pkt_szs) . "\n" + . "\ncx_types: " . join(" ", @cx_types) + . "\none_cx_per_port: $one_cx_per_port\n\n"; + +if ($DEBUG) { sleep ($D_PAUSE); } + + +# Determine total port and endpoint counts and make sorting by name easier in the GUI :P + +my @num = (); # Formatted index number for name sorting in GUI. +my $t_num = 0; +my $t_ports = 0; +my $ni=0; +my $nj=0; + +my $lf2orig = $lf2; + +if ($lf2 == "") { + $lf2 = $lf1; + if ($foundL4) { + @lf2_ports = undef; + } + else { + # put every other port into @lf2_ports to fake out lf2 info which makes the + # script work later. + my @lf1_ports_tmp = @lf1_ports; + @lf1_ports = undef; + @lf2_ports = undef; + $i=0; + for ($ni=0; $ni<@lf1_ports_tmp; $ni++) { + $lf1_ports[$i] = $lf1_ports_tmp[$ni]; + $lf2_ports[$i] = $lf1_ports_tmp[++$ni]; + $i++; + } + } +} + +# Check that ip_base address pairs aren't the same. +for ($ni = 0; $ni<@ip_base; $ni++) { + if ($ip_base[$ni] == $ip_base[$ni+1]) { + die ("ERROR: Base IP addresses cannot be the same."); + } + $ni++; +} + +my @cxts = ("lf", "lf_udp", "lf_tcp", "custom_udp", "custom_tcp", "l4", + "fileIONFS", "fileIOCIFS"); +my @t_cxts = (); +for ($ni=0; $ni<@cxts; $ni++) { + @t_cxts[$ni] = 0; +} + +if ($lf2orig ne "") { + if ($ignore_phys_ports) { + $t_ports = $num_mvlans; + } + else { + $t_ports = @lf1_ports + @lf2_ports + ($num_mvlans); + } +} +elsif ($num_mvlans) { + if ($ignore_phys_ports) { + $t_ports = $num_mvlans; + } + else { + $t_ports = @lf1_ports + ($num_mvlans); + } +} +else { + $t_ports = @lf1_ports + @lf2_ports; +} + +my $t_cxtypes = @cx_types; +my $t_urls = @l4_urls; + +if (@min_rate != @max_rate ) { + die("Number of elements in min_rate does not match number of elements in max_rate."); +} +else { + my $t_rate = @min_rate + @max_rate; +} +if (@min_pkt_szs != @max_pkt_szs ) { + die("Number of elements in min_pkt_szs does not match number of elements in max_pkt_szs."); +} +else { + my $t_pkt_szs = @min_pkt_szs + @max_pkt_szs; +} + +for ($ni=0; $ni<@cx_types; $ni++) { + for ($nj=0; $nj<@cxts; $nj++) { + if ( $cx_types[$ni] eq $cxts[$nj] ) { + $t_cxts[$nj]++; + } + } +} + +for ($nj=0; $nj<@cxts; $nj++) { + if ( $cxts[$nj] eq "l4") { + $t_num += ($t_ports * (2 * ($t_cxts[$nj] * $t_urls))); + } + else { + $t_num += ($t_ports * (2 * $t_cxts[$nj])); + } +} +$t_num += $name_id; + +my $num_len; +if ($name_id_len) { + if (length($name_id) > $name_id_len || length($t_num) > $name_id_len) { + print "\nWARNING: id_len specifies a string length less that first_name_id or less that total number of endpoints\n"; + } + $num_len = $name_id_len; +} +else { + $num_len = length ($t_num); +} +$t_num -= $name_id; +$i = 0; +switch ($num_len) { + case 1 { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%01d", $name_id + $i); + } + } + case 2 { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%02d", $name_id + $i); + } + } + case 3 { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%03d", $name_id + $i); + } + } + case 4 { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%04d", $name_id + $i); + } + } + case 5 { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%05d", $name_id + $i); + } + } + case 6 { + for ($i ; $i<$t_num; $i++) { + $num[$i] = sprintf("%06d", $name_id + $i); + } + } + else { + for ($i ; $i<$t_num; $i++) { + $num[$i] = $name_id + $i; + } + } +} +if ($DEBUG > 99) { + $i = 0; + print "name_id: $name_id, t_num: $t_num, num_len: $num_len :-\n"; + for ($i ; $i<$t_num; $i++) { + print $num[$i] . " "; + } + print "\n"; + sleep ($D_PAUSE); +} +if ($DEBUG) { printArgs(); sleep ($D_PAUSE); } + +# Open connection to the LANforge server. +my $t = new Net::Telnet(Timeout => 15, + Prompt => '/default\@btbits\>\>/'); + +$t->open(Host => $lfmgr_host, + Port => $lfmgr_port, + Timeout => 60); + +$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($quiet_cli_cmds); # Do not show input to CLI +$utils->cli_rcv_silent($quiet_cli_output); # Repress output from CLI ?? + +my $dt = getDate(); +my $dt_start = $dt; +my $cmd; + +my @t_cx_run_loop = (); +my @endpoint_names = (); #will be added to as they are created +my @cx_names = (); +my @ep_delay = (); +my $cx_run = 0; +my $avg_cx_run = 0; +my $t_cx_run = 0; +my $t_prcnt_ep_dly = 0; +my $avg_prcnt_ep_dly = 0; +my $eia = 0; +my $eib = 0; +my $ci = 0; +my $ep_dly_cnt = 0; +my $t_ep_dly_cnt = 0; +my $avg_ep_dly_cnt = 0; +my $prcnt_ep_dly = 0; +my $epa_rx = 0; +my $epb_rx = 0; +my $ep_delay = 0.0; +#my $epa_delay = 0; +#my $epb_delay = 0; +my $epa_drop = 0; +my $epb_drop = 0; +my $t_ep_run = 0; +my $prcnt_ep_dlyd = 0; + + +if ($init_stop_all) { doCmd("set_cx_state ALL ALL STOPPED"); } + +$SIG{'INT'} = 'CLEANUP'; + +my $loop = 0; +for ($loop = 0; $loop<$loop_max; $loop++) { + $dt = getDate(); + print "\n\n***** Starting $script_name at: $dt. Test Loop: ". ($loop+1) . " *****\n\n"; + + if (!$init_once) { + if ($INIT) { initToDefaults(); } + + if ($init_net) { + addMacVlans(); # Add MACVLANs. + initIpAddresses(); # Add some IP addresses to the ports. + } + if ($init_tests) { + doCmd("rm_cx $test_mgr all"); + doCmd("rm_endp YES_ALL"); + doCmd("rm_test_mgr $test_mgr"); + 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 + addCrossConnects(); # Add our endpoints. + print "Done adding CXs.\n"; + } + } + elsif ($first_run) { + if ($INIT) { initToDefaults(); } + + if ($init_net) { + addMacVlans(); + initIpAddresses(); + } + if ($first_run && $init_tests) { + doCmd("rm_cx $test_mgr all"); + doCmd("rm_endp YES_ALL"); + doCmd("rm_test_mgr $test_mgr"); + 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 + addCrossConnects(); # Add our endpoints. + print "Done adding CXs.\n"; + } + $first_run = 0; + } + + if ($DEBUG) { printArgs(); } + $dt = getDate(); + print "\n\n*** Started $script_name script at : $dt_start ***\n" + . "*** Finished $script_name configuration at: $dt ***\n\n"; + sleep($D_PAUSE); + + if ($create_only == 1) { exit(0); } + + print "Wait $ss_wait seconds for ports to update.\n"; + sleep($ss_wait); + + ####################### + # START lf_max_cxs.pl # + ####################### + # Start Cross-Connects + my $endp = new LANforge::Endpoint(); + for ($ci=0; $ci<@cx_names; $ci++) { + $cmd = "set_cx_state $test_mgr " . $cx_names[$ci] . " RUNNING"; + doCmd($cmd); + $eia = 2 * $ci; + $eib = $eia + 1; + + $ep_delay[$eia] = $ep_delay[$eib] = 0.0; + + # check that the CX is passing packets + $utils->updateEndpoint($endp, $endpoint_names[$eia]); + $epa_rx = $endp->rx_pkts(); + + $utils->updateEndpoint($endp, $endpoint_names[$eib]); + $epb_rx = $endp->rx_pkts(); + + my $slp = 0; + $ep_delay = 0.0; +# $epa_delay = $epb_delay = 0; + while ($epa_rx == 0 || $epb_rx == 0) { + sleep($settle_time); # sleep to allow CX to connect + $slp++; + + $utils->updateEndpoint($endp, $endpoint_names[$eia]); + $epa_rx = $endp->rx_pkts(); + + $utils->updateEndpoint($endp, $endpoint_names[$eib]); + $epb_rx = $endp->rx_pkts(); + + if ($slp > $ep_rx_strikes) { + # too long + print "WARNING: Waited too long on endpoint $ci to receive packet\n"; + if ($epa_rx == 0) { + $ep_delay[$eia] = 999999; + } + if ($epb_rx == 0) { + $ep_delay[$eib] = 999999; + } + last; # for $ci + } + } # while + + $cx_run++; + if ($DEBUG > 99) { + print "\n[DEBUG] cx_run: $cx_run\n"; + } + print "Test Loop: " . ($loop+1) . "\n Processing data for " . ($eib+1) . " endpoints"; + $ep_dly_cnt = 0; + for ($i=0; $i<=$eib; $i++) { + print "."; + # MIGHT MOVE UDP CHECK into loop so that tcp delay and udp loss or delay can be used. + # if UDP check CX for dropped packets + if ($use_udp_probe) { + if ($use_udp_loss) { + $utils->updateEndpoint($endp, $endpoint_names[0]); + $epa_drop = $endp->rx_dropped_pkts(); + + $utils->updateEndpoint($endp, $endpoint_names[1]); + $epb_drop = $endp->rx_dropped_pkts(); + + if (($epa_drop || $epb_drop) && $i == 0) { # If there are ANY dropped packets on UDP CX. + print "DROP ON PROBE ENDPOINT DETECTED"; + if ($end_udp_drop) { + print "\nSTOP FURTHER PROCESSING !!!\n"; + # Probably should refine this to have a drop threshold. +# $t_cx_run += $cx_run; # Average calculated later. +# $t_ep_run = $t_cx_run * 2; # Probably need more or different results now. + # Might add processing for all UDP CXs.... + #save ep delays + last; # not sure but NOT for $i - need the next one to break out of for $i + } + } + #elsif ($ci > 0) { + # # Successfully added TCP CX, count it + # $cx_run++; + #} + } + # if UDP delay? Nothing special about delay wrt UDP - just loss is special + } + if ($end_udp_drop && ($epa_drop || $epb_drop)) { + last; # for $i + } + if ($endpoint_names[$eia] eq $endpoint_names[$i] || $endpoint_names[$eib] eq $endpoint_names[$i] ) { + for ($j=0; $j<$samples; $j++) { + $utils->updateEndpoint($endp, $endpoint_names[$i]); + $ep_delay += $endp->avg_latency(); +# $epa_delay += $endp->avg_latency(); +# $utils->updateEndpoint($endp, $endpoint_names[($i+1)]); +# $epb_delay += $endp->avg_latency(); + if ($DEBUG > 1) { + print "\n[DEBUG] Sample#" . ($j+1) . ": ". $endpoint_names[$i] . " - ep_delay +=: $ep_delay ms\n" +# print "\n[DEBUG] Sample#" . ($j+1) . ": ". $endpoint_names[$i] . " - epa_delay: $epa_delay\n" +# . "[DEBUG] Sample#" . ($j+1) . ": ". $endpoint_names[($i+1)] . " - epb_delay: $epb_delay\n"; + } + usleep ($sample_time_dly); + } + $ep_delay[$i] = $ep_delay / $samples; + } else { + $utils->updateEndpoint($endp, $endpoint_names[$i]); + $ep_delay = $endp->avg_latency(); + $ep_delay[$i] = $ep_delay; + if ($DEBUG > 1 ) { + print "\n[DEBUG] Single sample ". $endpoint_names[$i] . " - ep_delay: $ep_delay ms\n"; + } +# $epa_delay = $endp->avg_latency(); +# $utils->updateEndpoint($endp, $endpoint_names[($i+1)]); +# $epb_delay = $endp->avg_latency(); + } +# $ep_delay[($i+1)] = $epb_delay / $samples; +# $epa_delay = $epb_delay = 0; + $ep_delay = 0.0; +# if ($ep_delay[$i] > $max_delay || $ep_delay[($i+1)] > $max_delay) { + if ($ep_delay[$i] > $max_delay) { + $ep_dly_cnt++; + } # if $ep_delay > $max_delay + } # for $i Processing endpoint delay data + + if ($end_udp_drop && ($epa_drop || $epb_drop)) { + print "\nSTOP FURTHER PROCESSING !!!\n"; + last; # for $ci + } + + $prcnt_ep_dly = ($ep_dly_cnt / ($eib+1)) * 100.0; + if ($prcnt_ep_dly > $percent_ep_delay) { + $t_cx_run += $cx_run; + $t_ep_run = $t_cx_run * 2.0; + $t_ep_dly_cnt += $ep_dly_cnt; + $t_prcnt_ep_dly += $prcnt_ep_dly; + print "\n\n PERCENT DELAY EXCEEDED!!!\n"; + #if ($DEBUG > 99) { + print "\n"; + for ($i=0; $i<=$eib; $i++) { + print " Delay Exceeded, Endpoint: " . $endpoint_names[$i] . ", Delay: ". $ep_delay[$i] . " ms\n"; + } + print "\n ep_dly_cnt: $ep_dly_cnt, prcnt_ep_dly: $prcnt_ep_dly%" + . "\n loop: $loop" + . "\n t_cx_run: $t_cx_run, t_ep_dly_cnt: $t_ep_dly_cnt, t_prcnt_ep_dly: $t_prcnt_ep_dly" + . "\n"; + sleep ($D_PAUSE); + #} + #$avg_ep_dly_cnt + #do something like write out the ep delay data to file + #wonder if there is a way to use internal perl sort on the delay and still keep the endpoint + #name correctly indexed. + + last; # for $ci + } + # $ep_dly_cnt = 0; might need to transfer to average ep_dly_cnt for loops. + #perhaps, do array sort on delays don't see why if were checking for a certain percentage of delayed CXs + #sort would be slooow and painful + } #for $ci + $t_cx_run_loop[$loop] = $cx_run; + $cx_run = 0; + if ($keep_running) { + if ($loop < ($loop_max - 1)) { + doCmd("set_cx_state $test_mgr ALL STOPPED"); + } else { + last; # for $loop + } + } else { + doCmd("set_cx_state $test_mgr ALL STOPPED"); + } + + # SHOULD probably get throughput data for each pass + # need to save off each loops results. + $epa_drop = $epb_drop = 0; + doCmd("clear_cx_counters ALL"); +} #for $loop_max + +#save endpoints delays to file +print "\n\n*** RESULTS ****\n\n"; +$loop++; +if ($t_cx_run == 0 && $use_udp_probe) { + print "$cx_run connections were made.\n"; + print "No dropped packets were detected on the UDP connection.\n"; + print "Try increasing the number of connections.\n"; +} +#elsif ($use_udp_probe) { +# $avg_cx_run = int($t_cx_run / $loop); +# print "\n$loop test loops completed.\n" +# . "Average number of simultaneous connections: $avg_cx_run\n"; +#} +elsif ($t_cx_run == 0) { +# if ($DEBUG) { + for ($i=0; $i<$loop_max; $i++) { + print "Loop " . ($i+1) . ": " . $t_cx_run_loop[$i] . " simultaneous connections.\n"; + } +# } + print "$cx_run connections were made.\n" + . "Less than $percent_ep_delay% of endpoints exceeded $max_delay ms of delay.\n" + . "Actual percentage of endpoints that exceeded $max_delay ms of delay is $prcnt_ep_dly%.\n" + . "Try increasing the number of connections.\n"; +} +else { + $prcnt_ep_dlyd = ($t_ep_dly_cnt / $t_ep_run) * 100.0; + $avg_cx_run = ($t_cx_run / $loop); + $avg_ep_dly_cnt = ($t_ep_dly_cnt / $loop); + $avg_prcnt_ep_dly = ($t_prcnt_ep_dly / $loop); + my $mean_ep_dly = 0; + #for ($i=0; $i<=$eib; $i++) { + #my $t_ep_dly += $_ foreach @ep_delay; + #my $avg_ep_dly = $t_ep_dly / + + #} + if ($DEBUG > 1) { + print "\n"; + for ($i=0; $i<=$eib; $i++) { + print "[DEBUG] Endpoint: " . $endpoint_names[$i] . " - Delay: ". $ep_delay[$i] . " ms\n"; + } + } + for ($i=0; $i<$loop_max; $i++) { + print "Loop " . ($i+1) . ": " . $t_cx_run_loop[$i] . " simultaneous connections.\n"; + } + + print "\n" + . "$loop test loops completed.\n\n" + . "Over $percent_ep_delay% of endpoints exceeded $max_delay ms of delay.\n\n" + . "Total number of endpoints that exceeded $max_delay ms is $t_ep_dly_cnt\n" + . "Total number of endpoints run $t_ep_run\n" + . "Total percentage of delayed endpoints $prcnt_ep_dlyd%\n\n" + . "Average number of simultaneous connections per test loop is $avg_cx_run\n" + . "Average percentage of endpoints that exceeded $max_delay ms of delay per test loop is $avg_prcnt_ep_dly%\n" + . "Average number of endpoints exceeding $max_delay ms per test loop is $avg_ep_dly_cnt" + . "\n"; +} + + +if ($DEBUG) { printArgs(); } + +$dt = getDate(); +print "\nStarted $script_name script at : $dt_start\n"; +print "Completed $script_name script at: $dt\n\n"; +exit(0); +##################### +# END lf_macvlan.pl # +##################### +sub CLEANUP { +print "\n\n*** RESULTS ****\n\n"; +#save endpoints delays to file +$loop++; +if ($t_cx_run == 0 && $use_udp_probe) { + print "$cx_run connections were made.\n"; + print "No dropped packets were detected on the UDP connection.\n"; + print "Try increasing the number of connections.\n"; +} +#elsif ($use_udp_probe) { +# $avg_cx_run = int($t_cx_run / $loop); +# print "\n$loop test loops completed.\n" +# . "Average number of simultaneous connections: $avg_cx_run\n"; +#} +elsif ($t_cx_run == 0) { +# if ($DEBUG) { + for ($i=0; $i<$loop_max; $i++) { + print "Loop " . ($i+1) . ": " . $t_cx_run_loop[$i] . " simultaneous connections.\n"; + } +# } + print "$cx_run connections were made.\n" + . "Less than $percent_ep_delay% of endpoints exceeded $max_delay ms of delay.\n" + . "Actual percentage of endpoints that exceeded $max_delay ms of delay is $prcnt_ep_dly%.\n" + . "Try increasing the number of connections.\n"; +} +else { + $prcnt_ep_dlyd = ($t_ep_dly_cnt / $t_ep_run) * 100.0; + $avg_cx_run = ($t_cx_run / $loop); + $avg_ep_dly_cnt = ($t_ep_dly_cnt / $loop); + $avg_prcnt_ep_dly = ($t_prcnt_ep_dly / $loop); + my $mean_ep_dly = 0; + #for ($i=0; $i<=$eib; $i++) { + #my $t_ep_dly += $_ foreach @ep_delay; + #my $avg_ep_dly = $t_ep_dly / + + #} + if ($DEBUG > 1) { + print "\n"; + for ($i=0; $i<=$eib; $i++) { + print "[DEBUG] Endpoint: " . $endpoint_names[$i] . " - Delay: ". $ep_delay[$i] . " ms\n"; + } + } + for ($i=0; $i<$loop_max; $i++) { + print "Loop " . ($i+1) . ": " . $t_cx_run_loop[$i] . " simultaneous connections.\n"; + } + + print "\n" + . "$loop test loops completed.\n\n" + . "Over $percent_ep_delay% of endpoints exceeded $max_delay ms of delay.\n\n" + . "Total number of endpoints that exceeded $max_delay ms is $t_ep_dly_cnt\n" + . "Total number of endpoints run $t_ep_run\n" + . "Total percentage of delayed endpoints $prcnt_ep_dlyd%\n\n" + . "Average number of simultaneous connections per test loop is $avg_cx_run\n" + . "Average percentage of endpoints that exceeded $max_delay ms of delay per test loop is $avg_prcnt_ep_dly%\n" + . "Average number of endpoints exceeding $max_delay ms per test loop is $avg_ep_dly_cnt" + . "\n"; +} + + +if ($DEBUG) { printArgs(); } + +$dt = getDate(); +print "\nStarted $script_name script at : $dt_start\n"; +print "Exited $script_name script at: $dt\n\n"; + +exit (0); +} # CLEANUP + + +sub addCrossConnects { + my $ep = 0; + my $cx = 0; + my $i = 0; + my $szs = 0; + my $r = 0; + my @all_ports1 = @lf1_ports; + my @all_ports2 = (""); + my $j; + my $pname; + + if ($foundL4) { + my $p1 = new LANforge::Port(); + my $q; + for ($q = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + for ($j = 0; $j<@lf1_ports; $j++) { + $utils->updatePort($p1, $shelf, $lf1, $lf1_ports[$j]); + $pname = $p1->{dev}; + @all_ports1 = (@all_ports1, "$pname\#$q"); + } + } + if ($ignore_phys_ports) { + for ($j = 0; $j<@lf1_ports; $j++) { + shift(@all_ports1); + } + } + } + else { + 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 = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + @all_ports1 = (@all_ports1, "$pname\#$q"); + } + } + + @all_ports2 = @lf2_ports; + 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 = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + @all_ports2 = (@all_ports2, "$pname\#$q"); + } + } + if ($ignore_phys_ports) { + for ($j = 0; $j<@lf1_ports; $j++) { + shift(@all_ports1); + } + for ($j = 0; $j<@lf2_ports; $j++) { + shift(@all_ports2); + } + } + } + + print "\nCreating endpoints on " . @all_ports1 . " ports:\nall_ports1: " . join(" ", @all_ports1); + +# if ($lf2orig ne "") { + print "\nCreating endpoints on " . @all_ports2 . " ports:\nall_ports2: " . join(" ", @all_ports2) . "\n\n"; +# } + +if ($DEBUG) { sleep($D_PAUSE); } + + if ($one_cx_per_port) { + my $j = 0; + my $cxcnt = 0; + my $fecnt = 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]}"; +# $ep++; + my $ep2 = "D_L4-${num[$ep]}"; + $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); + + if ($l4_dl_path = "/dev/null") { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[0]} $l4_dl_path' ' '"; + } + else { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[0]} $l4_dl_path/$ep1' ' '"; + } + doCmd($cmd); + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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); + }# if L4 + elsif (($cxt eq "fileIONFS") || ($cxt eq "fileIOCIFS")) { + # Create File-IO endpoint + + my $FST = "nfs"; + if ($cxt eq "fileIOCIFS") { + $FST = "cifs"; + } + + my $ep1 = "fe-${num[$fecnt]}"; + my $ep2 = "D_$ep1"; + $fecnt++; + $ep++; +# $ep++; + + @endpoint_names = (@endpoint_names, $ep1, $ep2); + + # Add the dummy endpoint + my $cmd = "add_file_endp $ep2 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing $fio_base/$ep2 $ep2"; + doCmd($cmd); + $cmd = "set_endp_flag $ep2 unmanaged 1"; + doCmd($cmd); + + $cmd = "add_file_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing \'$fio_base/$FST" + . "_$all_ports1[$j]" . $fio_targ_dir . "\' $ep1"; + doCmd($cmd); + + $cmd = "set_fe_info $ep1 16384 16384 10 1000000 1000000 \'$fio_base/$FST" . "_$all_ports1[$j]" + . $fio_targ_dir . "\' $ep1 $fsrw"; + doCmd($cmd); + + if ($r < (@min_rate - 1)) { + $r++; + } + else { + $r = 0; + } + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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 FIO + else { + # Create L3 endpoint + + my $burst = "NO"; + if ($min_rate[$r] != $max_rate[$r]) { + $burst = "YES"; + } + my $szrnd = "NO"; + if ($min_pkt_szs[$szs] != $max_pkt_szs[$szs]) { + $szrnd = "YES"; + } + + my $pattern = "increasing"; + if ($cx_types[$i] =~ /custom/) { + $pattern = "custom"; + } + + my $ep1 = "L3e-${num[$ep]}tx"; + $ep++; + my $ep2 = "L3e-${num[$ep]}rx"; + $ep++; + + @endpoint_names = (@endpoint_names, $ep1, $ep2); + + $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + doCmd($cmd); + + if ($lf2 ne "") { +# die("Must have lf2 defined if using non-l4 endpoints."); + $cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . + $max_pkt_szs[$szs] . " $pattern NO"; + } + else { + $cmd = "add_endp $ep2 $shelf $lf1 " . $all_ports1[($j)] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + } + doCmd($cmd); + + if ($szs < (@min_pkt_szs - 1)) { $szs++; } + else { $szs = 0; } + if ($r < (@min_rate - 1)) { $r++; } + else { $r = 0; } + + # Now, add the cross-connects + my $cx_name = "L3-${num[$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); + + if ($use_udp_probe && $first_run) { + $first_run = 0; + # Delete first CX and related Endpoints. + doCmd("rm_cx $test_mgr $cx_names[0]"); + doCmd("rm_endp $endpoint_names[0]"); + doCmd("rm_endp $endpoint_names[1]"); + + # Add UDP CX as first CX. + + $cmd = "add_endp $endpoint_names[0] $shelf $lf1 " . $all_ports1[0] . " lf_udp " + . " -1 $burst $min_rate[0] $max_rate[0] $szrnd " . $min_pkt_szs[0] . " " + . $max_pkt_szs[0] . " $pattern NO"; + doCmd($cmd); + + $cmd = "add_endp $endpoint_names[1] $shelf $lf2 " . $all_ports2[0] . " lf_udp " + . " -1 $burst $min_rate[0] $max_rate[0] $szrnd " . $min_pkt_szs[0] . " " + . $max_pkt_szs[0] . " $pattern NO"; + doCmd($cmd); + doCmd("add_cx $cx_names[0] $test_mgr $endpoint_names[0] $endpoint_names[1]"); + doCmd("set_cx_report_timer $test_mgr $cx_names[0] 1000"); + + if ($DEBUG > 99) { sleep ($D_PAUSE); } + } + }# else L3 + }#for all ports + }#one_cx_per_port = 1 + else { + my $j = 0; + my $n = 0; + my $fecnt = 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 + for ($n = 0; $n<@l4_urls; $n++) { + my $ep1 = "L4-${num[$ep]}"; +# $ep++; + my $ep2 = "D_L4-${num[$ep]}"; + $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); + if ($l4_dl_path = "/dev/null") { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[$n]} $l4_dl_path' ' '"; + } + else { + $cmd = "add_l4_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " l4_generic 0 $l4_timeout $urls_10m 'dl ${l4_urls[$n]} $l4_dl_path/$ep1' ' '"; + } + doCmd($cmd); + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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 url_list + } + elsif (($cxt eq "fileIONFS") || ($cxt eq "fileIOCIFS")) { + # Create File-IO endpoint + my $FST = "nfs"; + if ($cxt eq "fileIOCIFS") { + $FST = "cifs"; + } + + my $ep1 = "fe-${num[$fecnt]}"; + my $ep2 = "D_$ep1"; + $fecnt++; + $ep++; +# $ep++; + + @endpoint_names = (@endpoint_names, $ep1, $ep2); + + # Add the dummy endpoint + my $cmd = "add_file_endp $ep2 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing $fio_base/$ep2 $ep2"; + doCmd($cmd); + $cmd = "set_endp_flag $ep2 unmanaged 1"; + doCmd($cmd); + + $cmd = "add_file_endp $ep1 $shelf $lf1 " . $all_ports1[$j] + . " fe_generic $min_rate[$r] $max_rate[$r] $min_rate[$r] $max_rate[$r]" + . " increasing $fio_base/$FST" . "_$all_ports1[$j]" . $fio_targ_dir . " $ep1"; + doCmd($cmd); + + $cmd = "set_fe_info $ep1 16384 16384 10 1000000 1000000 $fio_base/$FST" + . "_$all_ports1[$j]" . $fio_targ_dir . " $ep1 $fsrw"; + doCmd($cmd); + + if ($r < (@min_rate - 1)) { $r++; } + else { $r = 0; } + + # Now, add the cross-connects + my $cx_name = "L4-${num[$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 { + # Create L3 endpoint + + my $burst = "NO"; + if ($min_rate[$r] != $max_rate[$r]) { + $burst = "YES"; + } + my $szrnd = "NO"; + if ($min_pkt_szs[$szs] != $max_pkt_szs[$szs]) { + $szrnd = "YES"; + } + + my $pattern = "increasing"; + if ($cx_types[$i] =~ /custom/) { + $pattern = "custom"; + } + + my $ep1 = "L3e-${num[$ep]}tx"; + $ep++; + my $ep2 = "L3e-${num[$ep]}rx"; + $ep++; + + @endpoint_names = (@endpoint_names, $ep1, $ep2); + + $cmd = "add_endp $ep1 $shelf $lf1 " . $all_ports1[$j] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + doCmd($cmd); + + + if ($lf2 ne "") { +# die("Must have lf2 defined if using non-l4 endpoints."); + $cmd = "add_endp $ep2 $shelf $lf2 " . $all_ports2[$j] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . + $max_pkt_szs[$szs] . " $pattern NO"; + } + else { + $cmd = "add_endp $ep2 $shelf $lf1 " . $all_ports1[$j+1] . " " . @cx_types[$i] . + " -1 $burst $min_rate[$r] $max_rate[$r] $szrnd " . $min_pkt_szs[$szs] . " " . $max_pkt_szs[$szs] . + " $pattern NO"; + } + doCmd($cmd); + + if ($szs < (@min_pkt_szs - 1)) { $szs++; } + else { $szs = 0; } + if ($r < (@min_rate - 1)) { $r++; } + else { $r = 0; } + + # Now, add the cross-connects + my $cx_name = "L3-${num[$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); + + if ($use_udp_probe && $first_run) { + $first_run = 0; + # Delete first CX and related Endpoints. + doCmd("rm_cx $test_mgr $cx_names[0]"); + doCmd("rm_endp $endpoint_names[0]"); + doCmd("rm_endp $endpoint_names[1]"); + + # Add UDP CX as first CX. + + $cmd = "add_endp $endpoint_names[0] $shelf $lf1 " . $all_ports1[0] . " lf_udp " + . " -1 $burst $min_rate[0] $max_rate[0] $szrnd " . $min_pkt_szs[0] . " " + . $max_pkt_szs[0] . " $pattern NO"; + doCmd($cmd); + + $cmd = "add_endp $endpoint_names[1] $shelf $lf2 " . $all_ports2[0] . " lf_udp " + . " -1 $burst $min_rate[0] $max_rate[0] $szrnd " . $min_pkt_szs[0] . " " + . $max_pkt_szs[0] . " $pattern NO"; + doCmd($cmd); + doCmd("add_cx $cx_names[0] $test_mgr $endpoint_names[0] $endpoint_names[1]"); + doCmd("set_cx_report_timer $test_mgr $cx_names[0] 1000"); + + if ($DEBUG > 99) { sleep ($D_PAUSE); } + } + } + }#for cx types + }#for each port + }#each cx per port +}#addCrossConnects +sub initToDefaults { + # Clean up database if stuff exists + if ($DEBUG) { + print "\nsub initToDefaults\n"; + } + 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 ($DEBUG) { + print "\nsub addMacVlans\n"; + } + if ($mac_init == 1 ) { + $lsb1 = sprintf("%d", $mac1); + $lsb2 = sprintf("%d", $mac2); + $lsb3 = sprintf("%d", $mac3); + } + my $i; + my $q; + my $pnum1; + my $pnum2; + my $throttle = $script_speed; + my $since_throttle = 0; + for ($i = $start_mvlan; $i<($num_mvlans + $start_mvlan); $i++) { + for ($q = 0; $q<@lf1_ports; $q++) { + + $pnum1 = $lf1_ports[$q]; + 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"); + + $pnum2 = $lf2_ports[$q]; + if ($pnum2 ne "") { + $card = sprintf("%02x", $lf2); + $mac_index = getNextMac(); + $mac_addr = "00:$shlf:$card:$mac_index"; + doCmd("add_mvlan $shelf $lf2 $pnum2 $mac_addr $i"); + } + if ($DEBUG > 1) { sleep($D_PAUSE); } + + # 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 ($pnum2 ne "") { + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf2, $pnum2); + } + $since_throttle = 0; + } + } + } + + doCmd("probe_ports"); + + # Wait until 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 ($pnum2 ne "") { + $utils->updatePort($p2, $shelf, $lf2, $lf2_ports[$q]); + $pname2 = $p2->{dev}; + } + + for ($i = $start_mvlan; $i<($num_mvlans + $start_mvlan); $i++) { + while (1) { + $utils->updatePort($p1, $shelf, $lf1, "$pname\#$i"); + if ($pnum2 ne "") { + $utils->updatePort($p2, $shelf, $lf2, "$pname2\#$i"); + } + if ($p1->isPhantom() || (($pnum2 ne "") && $p2->isPhantom())) { + sleep(1); + } + else { + last; + } + } + } + } +}#addMacVlans + +# 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 ($lf2orig ne "") { + clearMacVlanPorts($shelf, $lf2); + } + + throttleCard($shelf, $lf1); + if ($lf2orig 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]; + if ($tmp ne "0") { + doCmd("set_port $shelf $lf1 $tmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA"); + } + if ($lf2orig ne "") { + if ($tmp2 ne "0") { + 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; + for ($i = 0; $i<$mx; $i++) { + if ($ports[$i]->isMacVlan()) { + doCmd($ports[$i]->getDeleteCmd()); + $found_one = 1; + } + } + } +} + + +sub initIpAddresses { + # Set all ports we are messing with to known state. + my $i; + for ($i = 0; $i<@lf1_ports; $i++) { + +# if ($ip_lsb > 250) { +# $ip_c++; +# $ip_lsb = 2; +# } + + my $ptmp = $lf1_ports[$i]; + my $ptmp2 = $lf2_ports[$i]; +# my $cmd = ""; + if (!$ignore_phys_ports) { +# $cmd = "set_port $shelf $lf1 $ptmp $ip_base1.$ip_c1.$ip_lsb1 $msk1 " . +# "$ip_gw1 NA NA NA"; + $cmd = "set_port $shelf $lf1 $ptmp 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA"; + if ($ptmp ne "") { + doCmd($cmd); + } +# $ip_lsb++; + if ($ptmp2 ne "") { +# $cmd = "set_port $shelf $lf2 $tmp2 $ip_base1.$ip_c1.$ip_lsb1 $msk1 " . +# "$ip_gw1 NA NA NA"; + $cmd = "set_port $shelf $lf2 $ptmp2 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA"; + doCmd($cmd); +# $ip_lsb++; + } + } + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf1, $ptmp); + my $pname = $p1->{dev}; + + my $q; + my $throttle = $script_speed; + my $since_throttle = 0; + + for ($q = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + $cmd = "set_port $shelf $lf1 $pname\#$q " . + "$ip_base[$i].$ip_c[$i].$ip_lsb[$i] $msk[$i] " . + "$ip_gw[$i] NA NA NA"; + doCmd($cmd); + $ip_lsb[$i]++; + + if ($ip_lsb[$i] > 250) { + $ip_c[$i]++; + $ip_lsb[$i] = 2; + } + + if ($since_throttle++ > $throttle) { + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf1, "$pname\#$q"); + $since_throttle = 0; + } + } + +# $ip_lsb++; + + if ($ptmp2 ne "") { + $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf2, $ptmp2); + $pname = $p1->{dev}; + + for ($q = $start_mvlan; $q<($num_mvlans + $start_mvlan); $q++) { + if (@ip_base == 1) { + $cmd = "set_port $shelf $lf2 $pname\#$q " . + "$ip_base[$i].$ip_c[$i].$ip_lsb[$i] $msk[$i] " . + "$ip_gw[$i] NA NA NA"; + doCmd($cmd); + $ip_lsb[$i]++; + + if ($ip_lsb[$i] > 250) { + $ip_c[$i]++; + $ip_lsb[$i] = 2; + } + } + else { + $cmd = "set_port $shelf $lf2 $pname\#$q " . + "$ip_base[$i+1].$ip_c[$i+1].$ip_lsb[$i+1] $msk[$i+1] " . + "$ip_gw[$i+1] NA NA NA"; + doCmd($cmd); + $ip_lsb[$i+1]++; + + if ($ip_lsb[$i+1] > 250) { + $ip_c[$i+1]++; + $ip_lsb[$i+1] = 2; + } + } + if ($since_throttle++ > $throttle) { + my $p1 = new LANforge::Port(); + $utils->updatePort($p1, $shelf, $lf2, "$pname\#$q"); + $since_throttle = 0; + } + } # for $q + } # if we have an lf2_ports defined + } +} + +sub doCmd { + my $cmd = shift; + + print ">>> $cmd\n"; + + $t->print($cmd); + my @rslt = $t->waitfor('/ \>\>RSLT:(.*)/'); + print "**************\n @rslt ................\n\n"; + sleep($cli_cmd_delay); +} + +sub getDate { + my $date = `date`; + chomp($date); + return $date +} + +sub printArgs { + print + "\n$script_name" + . "\nModified arguments:" + . "\ninit: $INIT" + . "\nmanager: $lfmgr_host\n" + . "\nlf1: $lf1\nlf2: $lf2\n" + . "\nlf1_ports: " . join(" ", @lf1_ports) + . "\nlf2_ports: " . join(" ", @lf2_ports) . "\n" + . "\nstart_macvlans: $start_mvlan" + . "\nnum_mvlans: $num_mvlans\n" + . "\nmin_rates: " . join(" ", @min_rate) + . "\nmax_rates: " . join(" ", @max_rate) + . "\nmin_pkt_sizes: " . join(" ", @min_pkt_szs) + . "\nmax_pkt_sizes: " . join(" ", @max_pkt_szs) . "\n" + . "\ncx_types: " . join(" ", @cx_types) + . "\none_cx_per_port: $one_cx_per_port\n\n" + . "\n" + . "Available CX types: " . join(", ", @cxts) . "\n" + . "Total of each CX type: " . join(", ", @t_cxts) . "\n" + . "Total number of ports: $t_ports\n" + . "Total number of urls: " . @l4_urls . "\n" + . "Total number of endpoints and CXs: $t_num\n" + . "\n\n"; +} + +sub printHelp { + print + "\n$script_name\n" + . "USAGE: mgr=[ip-of-mgr] speed=[25|n] slowsys_wait=[0|n] DEBUG=[0|1|2|...] D_PAUSE=[3|n]\n" + . " config_once=[0|1] init=[0|1] init_net=[1|0] init_tests=[1|0] exit_running=[0|1]\n" + . " test_loops=[3|n] cli_cmd_dly=[0|1] quiet_cli_cmds=[0|1] quiet_cli_output=[0|1]\n" + . " test_mgr=\"ben_tm\" first_run=[1|0] rpt_timer=[9000|n]\n" + . " first_name_id=[0|n] id_len=[0|n]\n" + . " create_only=[0|1] one_cx_per_port=[0|1] ignore_phys_ports=[1|0]\n" + . " lf1=X lf2=Y\n" + . " lf1_ports=[\"1 2 3\"|\"eth2 eth3\"] lf2_ports=[\"4 5 6\"|\"eth4 eth5\"]\n" + . " start_mvl=X num_mvl=X\n" + . " mac3=0xf0 mac2=0xbe mac1=0xef\n" + . " ip_base= \"192.168 172.16\"\n" + . " ip_c = \"2 1\"\n" + . " ip_lsb = \"2 2\"\n" + . " ip_msk =\"255.255.0.0 255.255.0.0\"\n" + . " ip_gw =\"192.168.2.1 172.16.1.1\"\n" + . " cx_types=\"lf lf_udp lf_tcp custom_udp custom_tcp l4 fileIONFS fileIOCIFS\"\n" + . " min_rates=\"9600 56000 128000\" max_rates=\"56000 128000 25600\"\n" + . " min_pkt_sizes=\"500 500 500\" max_pkt_sizes=\"1000 1000 1000\"\n" + . " url_rate=100 l4_wait=10000\n" + . " urls=\"http://www.candelatech.com/file ftp://www.candelatech.com/file https://www.candelatech.com/file\"\n" + . " fsrw=[read|write] fio_targ_dir=tmp/ fio_base=/mnt/fio_base\n" + . "\n"; + +} + +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 "debug" || $arg eq "DEBUG") { + $DEBUG = $val; + } + elsif ($arg eq "d_pause" || $arg eq "D_PAUSE") { + $D_PAUSE = $val; + } + elsif ($arg eq "mgr") { + $lfmgr_host = $val; + } + elsif ($arg eq "test_mgr") { + $test_mgr = $val; + } + elsif ($arg eq "init") { + $INIT = $val; + } + elsif ($arg eq "config_once") { + $init_once = $val; + } + elsif ($arg eq "init_net") { + $init_net = $val; + } + elsif ($arg eq "init_tests") { + $init_tests = $val; + } + elsif ($arg eq "exit_running") { + $keep_running = $val; + } + elsif ($arg eq "test_loops") { + $loop_max = $val; + } + elsif ($arg eq "cli_cmd_dly") { + $cli_cmd_delay = $val; + } + elsif ($arg eq "quiet_cli_cmds") { + $quiet_cli_cmds = $val; + } + elsif ($arg eq "quiet_cli_output") { + $quiet_cli_output = $val; + } + elsif ($arg eq "first_run") { + $first_run = $val; + } + elsif ($arg eq "rpt_timer") { + $report_timer = $val; + } + elsif ($arg eq "first_name_id") { + $name_id = $val; + } + elsif ($arg eq "id_len") { + $name_id_len = $val; + if (length($name_id) > $name_id_len) { + print "\nWARNING: id_len specifies a string length less that first_name_id.\n"; + } + } + elsif ($arg eq "speed") { + $script_speed = $val; + } + elsif ($arg eq "slowsys_wait") { + $ss_wait = $val; + } + elsif ($arg eq "lf1") { + $lf1 = $val; + } + elsif ($arg eq "lf2") { + $lf2 = $val; + if ($lf1 == $lf2) { + die("\nINVALID: First and second resource are the same !!!\n\n"); + } + } + elsif ($arg eq "mac3") { + $mac3 = $val; + } + elsif ($arg eq "mac2") { + $mac2 = $val; + } + elsif ($arg eq "mac1") { + $mac1 = $val; + } + elsif ($arg eq "ip_base") { + @ip_base = split(/ /, $val); + } + elsif ($arg eq "ip_c") { + @ip_c = split(/ /, $val); + } + elsif ($arg eq "ip_lsb") { + @ip_lsb = split(/ /, $val); + } + elsif ($arg eq "ip_msk") { + @msk = split(/ /, $val); + } + elsif ($arg eq "ip_gw") { + @ip_gw = split(/ /, $val); + } + elsif ($arg eq "lf1_ports") { + @lf1_ports = split(/ /, $val); + } + elsif ($arg eq "lf2_ports") { + if ($lf2 == "" || $lf1 == $lf2) { + die("\nINVALID: Either second resource is not defined\nor first and second resource are the same !!!\n\n"); + } + else { + @lf2_ports = split(/ /, $val); + } + } + elsif ($arg eq "cx_types") { + @cx_types = split(/ /, $val); + } + elsif ($arg eq "min_pkt_sizes") { + @min_pkt_szs = split(/ /, $val); + } + elsif ($arg eq "max_pkt_sizes") { + @max_pkt_szs = split(/ /, $val); + } + elsif ($arg eq "start_mvl") { + $start_mvlan = $val; + } + elsif ($arg eq "num_mvl") { + $num_mvlans = $val; + } + elsif ($arg eq "min_rates") { + @min_rate = split(/ /, $val); + } + elsif ($arg eq "max_rates") { + @max_rate = split(/ /, $val); + } + elsif ($arg eq "fsrw") { + $fsrw = $val; + } + elsif ($arg eq "fio_base") { + $fio_base = $val; + } + elsif ($arg eq "fio_targ_dir") { + $fio_targ_dir = $val; + } + elsif ($arg eq "urls") { + @l4_urls = split(/ /, $val); + } + elsif ($arg eq "url_rate") { + $urls_10m = $val; + } + elsif ($arg eq "l4_wait") { + $l4_timeout = $val; + } + elsif ($arg eq "one_cx_per_port") { + $one_cx_per_port = $val; + } + elsif ($arg eq "ignore_phys_ports") { + $ignore_phys_ports = $val; + } + elsif ($arg eq "create_only") { + $create_only = $val; + } + else { + print "\n\nCould not parse one or more of the arguments !!!\n" + . "First rejected argument: $arg\n"; + printHelp(); + exit(1); + } +} diff --git a/lf_mcast.bash b/lf_mcast.bash new file mode 100755 index 000000000..8fb170211 --- /dev/null +++ b/lf_mcast.bash @@ -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. diff --git a/lf_monitor.pl b/lf_monitor.pl new file mode 100755 index 000000000..f01c858cf --- /dev/null +++ b/lf_monitor.pl @@ -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; +our $bytes_sufx = qq; +our $secs_sufx = qq; +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 diff --git a/lf_netoptics.pl b/lf_netoptics.pl new file mode 100755 index 000000000..c73937f73 --- /dev/null +++ b/lf_netoptics.pl @@ -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 "\n$ports_rpt\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); + } +} diff --git a/lf_nfs_io.pl b/lf_nfs_io.pl new file mode 100755 index 000000000..fd718ca87 --- /dev/null +++ b/lf_nfs_io.pl @@ -0,0 +1,1066 @@ +#!/usr/bin/perl -w +# +# This program is used to stress test the LANforge system, and may be used as +# an example for others who wish to automate LANforge tests. + +# This script sets up connections of types: +# lf, lf_udp, lf_tcp, custom_ether, custom_udp, custom_tcp, l4 (http, https, ftp and fileIO) +# across real ports and MACVLAN ports on one or more machines. +# It then continously starts and stops the connections. +package main; +$| = 1; # Un-buffer output + +use strict; +use warnings; +use Carp; +use Net::Telnet (); +$SIG{ __DIE__ } = sub { Carp::confess( @_ ) }; +use Scalar::Util; #::looks_like_number; +use lib '/home/lanforge/scripts'; # this is pedantic necessity for the following use statements +use LANforge::Port; +use LANforge::Utils; +use LANforge::Endpoint; +use Net::Telnet (); +use Net::Ping; +use Getopt::Long; +use Time::HiRes ('sleep'); +use Socket; + +use POSIX; +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## package variables below +use constant NL => "\n"; +use constant NA => "NA"; +use constant AUTO => "AUTO"; +use constant READ => "read"; +use constant WRITE => "write"; + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +our $report_timer = 8000; # Set report timer for all tests created in ms, i.e. 8 seconds +our $lfmgr_host = undef; +our $lfmgr_port = 4001; +our $resource = 1; +our $quiet = 1; +our $group = undef; +our $tmp_group = undef; +our $tmp_group_min = 0; +our $tmp_group_max = 0; +our $action = undef; +our $nfs_mnt = undef; +our $nfs_list = undef; +our $local_mnt = AUTO; +our $first_mvlan_ip = undef; #"10.26.1.10"; +our $netmask = "255.255.255.0"; +our $parent_port = undef; +our $utils = undef; +our $shelf_num = 1; +our $DEBUG = 0; +our $sleep_after_wo = 15; # Second to sleep after starting writers (before starting readers) +our $D_PAUSE = 3; + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +# File-IO configuration constants +our $quiesce_after_files = 0; +our $min_rw_size = "512"; +our $max_rw_size = "65536"; +our $use_crc = "yes"; +our $min_read_bps = "1000000"; # 1Mbps +our $max_read_bps = "2000000"; # 2Mbps +our $num_files = 2; +our $min_file_size = 1024 * 1024; +our $max_file_size = 1024 * 1024 * 2; +our $min_write_bps = "3000000"; # 3Mbps +our $max_write_bps = "4000000"; # 4Mbps +our $mount_options = "NONE"; +our $skip_writers = 0; +our $skip_readers = 0; + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +# below are sorted names and associated endpoints +# the third argument can be used as the default parent +# port for the mac-vlans for that group +our %group_names = ( + #"group1" => [ 1, 20, 'eth1'], + #"group2" => [ 21, 40, 'eth1'], + #"group3" => [ 41, 60, 'eth1'], + #"group4" => [ 1, 1, 'eth1'], + #"group5" => [ 2, 2, 'eth1'] +); +our $fast_forward_ep = 0; # set this to 1 to leave exiting file endpoints alone +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +our %mnt_map = (); +our %file_endpoints = (); +our %cross_connects = (); +our %test_groups = (); +our %all_file_ep = (); +our %mac_vlans = (); +our %vlan_ips = (); + +# These are set based on group chosen. +our $qty_mac_vlans = 0; +our $start = 0; # First idx, inclusive +our $stop = 0; # Last idx + +sub ipSummary { + my $first; + if((!defined $::first_mvlan_ip ) || ("$::first_mvlan_ip" eq "")) { + $first = "0.0.0.0"; + } + else { + $first = $::first_mvlan_ip; + } + my $linestart = " # "; + my $summary = NL; + for my $name (sort keys %::group_names) { + $summary .= $linestart.$name.": "; + my $a = addrtoint( $first ) + $::group_names{ $name }->[0] -1; + my $b = addrtoint( $first ) + $::group_names{ $name }->[1] -1; + $summary .= inttoaddr( $a )." - ".inttoaddr( $b ).NL; + } + return $summary; +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## Usage == +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +my $first = ($::first_mvlan_ip) ? $::first_mvlan_ip : "0.0.0.0"; + +my $usage = "$0 [--mgr {host-name | IP}] + [--mgr_port {ip port ($lfmgr_port)}] + [--resource {resource ($resource)}] + [--nfs_mnt {[IP|host-name]:/path}] + # 192.168.1.1:/foo + # filehost:/home/fileio + [--nfs_list {local file}]\t# list of nfs mountpoints + # Will be modulo distributed among groups mac vlans + # Obviates --nfs_mnt; examples: + # --nfs_list ./my-list-of-mounts + # --nfs_list /tmp/mnt-list + # File format: + # 10.20.30.40:/a/b/c + # filehost:/z/y + [--parent_port {parent eth port}]\t# parent of mac vlans + [--first-mvlan-ip {ip ($first)}]\t# mvlan ips: ".ipSummary()." + [--netmask {mask ($netmask)}]\t#mac-vlan netmask + [--action {list_groups|run_group|stop_group|del_group}] + # list_groups: list test groups + # run_group: assemble and start writer then reader group + # stop_group: quiece writer then reader group + # del_group: delete reader then writer file endpoints + [--group {name}] # test group base name, creates: + # _wo for writers and + # _ro for readers + [--min_rw_size ($min_rw_size)]\t# in bytes + [--max_rw_size ($max_rw_size)]\t# in bytes + [--use_crc {yes|no}] + [--min_read_bps ($min_read_bps)]\t# in bps, 2000000 = 1Mbps + [--max_read_bps ($max_read_bps)]\t# in bps, 2000000 = 2Mbps + [--num_files ($num_files)]\t# files per writer + [--quiesce_after_files ($quiesce_after_files)]\t# files to read/write before stopping test. + O == infinite (default) + + [--skip_readers ($skip_readers)]\t# Should we not create reader connections: 0 | 1 + [--skip_writers ($skip_readers)]\t# Should we not create writer connections: 0 | 1 + [--min_file_size ($min_file_size)]\t# in bytes + [--max_file_size ($max_file_size)]\t# in bytes + [--min_write_bps ($min_write_bps)]\t# in bps, 3000000 = 3Mbps + [--max_write_bps ($max_write_bps)]\t# in bps, 4000000 = 4Mbps + [--mount_options ($mount_options)]\t# as per nfs(1) + [--tmp_group {name}]\t# for specifying ad-hoc group, you will see group + [--min 1-n]\t first macvlan in tmp group + [--max 1-n]\t last macvlan in tmp group + +Examples: + $0 --mgr 10.0.0.1 --resource 1 --action list_groups + + $0 --mgr 10.0.0.1 --resource 1 --action run_group --group group1 \\ + --parent_port eth2 --netmask 255.255.0.0 \\ + --nfs_mnt 192.168.99.99:/fire + + $0 --mgr 10.0.0.1 --resource 1 \\ + --action stop_group --group group1 + + $0 --mgr 10.0.0.1 --resource 1 \\ + --action del_group --group group1 + + $0 --mgr 10.0.0.1 --resource 1 \\ + --action run_group --group group2 --parent_port eth9 \\ + --first_mvlan_ip 172.168.90.1 --netmask 255.255.0.0 \\ + --nfs_list ./nfsexports.txt \\ + --num_files 20 --min_file_size 4096 --max_file_size 524288 \\ + --min_write_bps 1000000 --max_write 900000000 + +$0 --mgr 10.0.0.1 --resource 1 \\ + --action run_group --group group1 \\ + --nfs_mnt 192.168.99.99:/fire \\ + --mount_options sync,hard,timeo=120,retrans=4 + +$0 --mgr 10.0.0.1 --resource 1 --action run_group \\ + --tmp_group lag1 --min 1 --max 2 --parent_port eth1 \\ + --first_mvlan_ip 10.30.0.10 \\ + --nfs_mnt 10.30.0.1:/tmp + +$0 --mgr 10.0.0.1 --resource 1 \\ + --action stop_group --tmp_group lag1 --min 1 --max 2 --parent_port eth1 +"; + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## ip_to_a/a_to_ip +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub addrtoint { + return( unpack( "N", pack( "C4", split( /[.]/,$_[0]) ) ) ); +}; +sub inttoaddr { + return( join( ".", unpack( "C4", pack( "N", $_[0] ) ) ) ); +}; + + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## Open connection to the LANforge server, configure our utils. +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub init { + my $conn = new Net::Telnet(Timeout => 20, + Prompt => '/default\@btbits\>\>/'); + $conn->open(Host => $::lfmgr_host, + Port => $::lfmgr_port, + Timeout => 10); + + $conn->waitfor("/btbits\>\>/"); + $conn->max_buffer_length(1024 * 1024 * 10); # 10M buffer + + $::utils = new LANforge::Utils(); + $::utils->telnet($conn); # Set our telnet object. + $::utils->cli_send_silent($::DEBUG ? 0 : 1); # Do show input to CLI + $::utils->cli_rcv_silent($::DEBUG ? 0 : 1); # Repress output from CLI ?? + + if ($::group && $::group ne "") { + my $ra_bounds = $::group_names{ $::group }; + $::start = @$ra_bounds[0]; + $::stop = @$ra_bounds[1]; + + $::qty_mac_vlans = ($::stop - $::start) + 1; + print "group [$group] vlans: $::stop - $::start = $::qty_mac_vlans\n" if($::DEBUG); + } +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## set a port or mvlan up or down +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +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; +} # ~port up/down + + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## Create mac_vlans if they do not exist. +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub preparePorts { + do_err_exit("First mac vlan IP is not set. Please set --first_mvlan_ip.") + unless ((defined $::first_mvlan_ip) && ("$::first_mvlan_ip" ne "")); + + do_err_exit( "preparePorts: Unnamed parent port. Please set \$parent_port") + unless((defined $::parent_port) && ("$::parent_port" ne "")); + + my $sleep_after = 0; + my %all_ports = (); + # build list of MAC VLANS + print "shelf_num $::shelf_num, resource $::resource\n" if ($::DEBUG); + my @ports = $::utils->getPortListing( 1, $::resource +0); + + for my $rh_port (@ports) { + print "added port $rh_port->{'dev'}".NL if($::DEBUG); + $all_ports{ $rh_port->{'dev'} } = $rh_port; + next unless ( $rh_port->{'dev'} eq $::parent_port ); + } + do_err_exit("preparePorts: Failed to populate ports list, please debug.") + unless (keys %all_ports > 0); + + my $i; + my %new_items = (); + my $ra_bounds = $::group_names{ $group }; + my $start_str = $::first_mvlan_ip; + my $start_int = addrtoint($start_str); + my $next_ip; + + if (($::qty_mac_vlans + $::start) < 1) { + do_err_exit("preparePorts: expects a positive, non-zero number of mvlans to create. Cannot continue."); + } + + for ($i = 0 + $::start; $i < $::qty_mac_vlans + $::start; $i++) { + my $devname = $::parent_port."#".$i; + print "start_str[$start_str] start_int[$start_int] i[$i]\n" if ($::DEBUG); + my $next_ip = inttoaddr( $start_int + $i -1); + print "next_ip[$next_ip]\n" if ($::DEBUG); + $::vlan_ips{ $devname } = $next_ip; + $::mac_vlans{ $devname } = 0; + if ( defined $all_ports{ $devname }) { + $::mac_vlans{ $devname } = 1; + } + else { # create mac_vlan + my $mac_addr = mac(); + my $cmd = $::utils->fmt_cmd( "add_mvlan", $::shelf_num, + $::resource, $::parent_port, $mac_addr, $i); + print " + ".$cmd.NL if ($::DEBUG); + $::utils->doCmd($cmd); + sleep(0.1); + } + $new_items{ $devname } = 1; + $sleep_after++; + } #~for + + if ( keys %new_items > 0 ) { + print "Creating ".(keys %new_items)." new ports:..."; + + # set the port IP + for my $new_item (keys(%new_items)) { + my $ip = $::vlan_ips{ $new_item }; + my $cmd_flags = 0x0; + my $current = 0x0; + my $interesting = 0x0 | 0x4 | 0x8; + + my $cmd = $::utils->fmt_cmd("set_port", + $::shelf_num, $::resource, $new_item, $ip, + $::netmask, NA, $cmd_flags, $current, NA, + NA, NA, NA, $interesting, + NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, + NA, NA, NA, NA, NA, NA, NA); + + if ($::DEBUG) { + print NL." $new_item $ip: $cmd "; + } + else { + print "."; + } + $::utils->doCmd($cmd); + sleep(0.1); + $sleep_after++; + + my @ports = $::utils->getPortListing($::shelf_num, $::resource); + for my $rh_port (@ports) { + $::all_ports{ $rh_port->{'dev'} } = $rh_port; #reset ports + } + } + print NL."Created ".(keys %new_items)." new mac vlans".NL; + } + if ($sleep_after > 10) { + $sleep_after = $sleep_after / 2; + } + + if ($sleep_after) { + print "\nSleeping: $sleep_after seconds to allow ports to be created and configured.\n"; + for $i (1..$sleep_after) { sleep(1); print "."; } + print NL; + } + # check that the port is up by trying to run a ping from it + if ( defined $::nfs_mnt && "$::nfs_mnt" ne "") { + my ($nfs_name) = split(/:/, $::nfs_mnt ); + print "Emitting one ping from each mvlan reduces failed mounts:"; + + foreach my $name (reverse sort keys %new_items) { + my $rh_p = $::all_ports{ $name }; + my $ip = $rh_p->{'ip_addr'}; + #my $ping = "ping -n -c1 -w1 -W1 -I $ip $nfs_name"; + print "ping $ip".NL if ($::DEBUG); + my $ping = Net::Ping->new('tcp', 1); + $ping->bind($ip); + $ping->port_number(scalar(getservbyname("nfs", "tcp"))); + my $counter = 5; + while( $counter > 0 ) { + if ($ping->ping($nfs_name)) { + print "."; + $counter = 0; + } + else { + print "$nfs_name did not ack nfs packet from $ip".NL; + $counter --; + sleep(0.2); + } + } + $ping->close(); + undef($ping); + #$ping->close(); + } + } + print NL; + +} # ~preparePorts + +sub notBlank { + my ($name, $value) = @_; + if((!defined $name) || ("$name" eq "")) { + print "Name itself is blank, value[$value]".NL; + } + if((!defined $value) || ("$value" eq "")) { + print "Value of $name is blank".NL; + } + #die if($::DEBUG); +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## prepareFileEndp - creates requested file endpoints if they do not exist, +## creates implied FIO endpoints if they dont exist and adds endpoints +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub prepareFileEndpoints { + do_err_exit("prepareFileEndpoints: Unnamed parent port. Please set \$parent_port") + unless((defined $::parent_port) && ("$::parent_port" ne "")); + + do_err_exit("prepareFileEndpoints: Blank all_ports array. Please run preparePorts() first.") + unless( keys %::all_ports > 1 ); + + do_err_exit("prepareFileEndpoints: Blank mac_vlans array. Please run preparePorts() first.") + unless( keys %::mac_vlans > 0 ); + + if((defined $::nfs_list) && ("$::nfs_list" ne "")) { + if((keys %::mnt_map) < 1) { + do_err_exit("prepareFileEndpoints: empty --nfs_list. Provide mountpoints in [$::nfs_list]"); + } + } + elsif((! defined $::nfs_mnt) || ("$::nfs_mnt" eq "")) { + do_err_exit("prepareFileEndpoints: undefined --nfs_mnt. Please specify --nfs_mnt first"); + } + + my %all_file_endpoints = (); + my %all_cross_connects = (); + my %endpoints_mvlans = (); + my @new_file_endpoints = (); + my @new_cross_connects = (); + + my $ep_name = undef; + for my $grp (sort(keys %::group_names)) { + my $ra_bounds = $::group_names{ $grp }; + print "skip_writers[$::skip_writers] skip_readers[$::skip_readers]" if ($::DEBUG); + sleep(3) if($::DEBUG); + + for my $i (@$ra_bounds[0]..@$ra_bounds[1]) { + if (! $::skip_writers) { + $ep_name = $grp ."_wo_".sprintf( "%03d", $i); + $all_file_endpoints{ $ep_name } = 0; + $endpoints_mvlans{ $ep_name } = $::parent_port."#".$i; + $all_cross_connects{ $ep_name } = 0; + } + + if (! $::skip_readers) { + $ep_name = $grp ."_ro_".sprintf( "%03d", $i); + $all_file_endpoints{ $ep_name } = 0; + $endpoints_mvlans{ $ep_name } = $::parent_port."#".$i; + $all_cross_connects{ $ep_name } = 0; + } + } + } + + print NL."Reading endpoints..."; + my $endpoint_str = $::utils->doCmd("nc_show_endpoints all all"); + my @endpoint_lines = split(/\n/, $endpoint_str); + + if ($::fast_forward_ep) { + for my $line (@endpoint_lines) { + $line =~ m/Endpoint \[(.*?)\]/; # proves this ep exists + next if(! $1); + $all_file_endpoints{ $1 } = 1; + } + } + for my $ep_name (sort(keys %all_file_endpoints)) { + print " $ep_name [".$all_file_endpoints{$ep_name}."] " if ($::DEBUG); + if ($all_file_endpoints{$ep_name} == 0 ){ + my $begins = $::group."_"; + if( $ep_name =~ /^$begins/ ){ + push( @new_file_endpoints, $ep_name ); + } + } + } + # assert we have sufficient remote_mnt entries + for my $ep_name (@new_file_endpoints) { + my $mvlan = $endpoints_mvlans{ $ep_name }; + my $remote_mnt = $::mnt_map{ $mvlan }; + notBlank( $mvlan, $remote_mnt ); + } + + if (@new_file_endpoints > 0) { + print "Creating ".@new_file_endpoints." new file endpoints..."; + my $endpoint_type = "lf"; + my $ip_port = "-1"; + my $bursty = "no"; + my $rand_pkt_sz = "no"; + my $remote_mnt = undef; + + for my $ep_name (@new_file_endpoints) { + my $mvlan = $endpoints_mvlans{ $ep_name }; + $remote_mnt = $::mnt_map{ $mvlan }; + + my $read_write = ($ep_name =~ /_ro_/)? READ : WRITE; + my $rw_prefix = $ep_name; + $rw_prefix =~ s/_ro_/_wo_/; + my $prefix = ($read_write eq WRITE) ? AUTO : $rw_prefix; + my $directory = ($read_write eq WRITE) ? AUTO : '/mnt/lf/'.$rw_prefix; + my $min_write_rt = ($read_write eq READ ) ? "0" : $::min_write_bps; + my $max_write_rt = ($read_write eq READ ) ? "0" : $::max_write_bps; + my $min_read_rt = ($read_write eq WRITE ) ? "0" : $::min_read_bps; + my $max_read_rt = ($read_write eq WRITE ) ? "0" : $::max_read_bps; + my $pattern = "increasing"; #($read_write eq "read" ) ? NA : "increasing"; + my $mount_retry_nap = 3500; + my $mount_dir = "NA"; + + # we do not want anything 'blank' in this + my @names=qw(ep_name ::shelf_num ::resource mvlan min_read_rt max_read_rt min_write_rt max_write_rt pattern directory prefix remote_mnt mount_options mount_dir mount_retry_nap); + + my @values=($ep_name, $::shelf_num, $::resource, $mvlan, $min_read_rt, $max_read_rt, $min_write_rt, $max_write_rt, $pattern, $directory, $prefix, $remote_mnt, $mount_options, $mount_dir, $mount_retry_nap); + for (my $i=0; $i<@names; $i++) { + notBlank($names[$i], $values[$i]); + } + + my $cmd = $::utils->fmt_cmd( + "add_file_endp", $ep_name, $::shelf_num, $::resource, $mvlan, + 'fe_nfs', $min_read_rt , $max_read_rt, $min_write_rt, $max_write_rt, + $pattern, $directory, $prefix, $remote_mnt, $mount_options, + "7", $mount_dir, NA, $mount_retry_nap); + print " + " . $cmd.NL if ($::DEBUG); + $::utils->doCmd($cmd); + sleep(0.1); # if ($::DEBUG); + print "."; + $cmd = $::utils->fmt_cmd( "set_fe_info", $ep_name, + $min_rw_size, $max_rw_size, $num_files, $min_file_size, $max_file_size, + $directory, $prefix, $read_write, $quiesce_after_files); + print " + " . $cmd.NL if ($::DEBUG); + + $::utils->doCmd($cmd); + sleep(0.1); # if ($::DEBUG); + + print "\bo"; + $::utils->doCmd($::utils->fmt_cmd( "set_endp_quiesce", $ep_name, 5)); + sleep(0.1); + print "\bO"; + $::utils->doCmd($::utils->fmt_cmd( "set_endp_report_timer", $ep_name, 1000)); + sleep(0.1); + print "\b*"; + $::utils->doCmd($::utils->fmt_cmd( "set_endp_flag", $ep_name, "ClearPortOnStart", 0)); + sleep(0.1); + print "\b|"; + my $cx_name = "CX_".$ep_name; + my $tg_name = $::group.(($read_write eq READ) ? "_ro" : "_wo"); + my $tm_name = "default_tm"; #= $::group.(($read_write eq READ) ? "_ro" : "_wo"); + my $tx_endp = $ep_name; + my $rx_endp = NA; + + my $add_cx = $::utils->fmt_cmd( "add_cx", $cx_name, $tm_name, $tx_endp, $rx_endp ); + my $set_cx = $::utils->fmt_cmd( "set_cx_report_timer", $tm_name, $cx_name, "1000", "cxonly"); + my $add_tgcx = $::utils->fmt_cmd( "add_tgcx", $tg_name, $cx_name ); + print $add_tgcx.NL if ($::DEBUG); + print $add_cx.NL if ($::DEBUG); + print $set_cx.NL if ($::DEBUG); + + $::utils->doCmd($add_cx); + sleep(0.1); + print "\bi"; + $::utils->doCmd($set_cx); + sleep(0.1); + print "\b:"; + $::utils->doCmd($add_tgcx); + sleep(0.1); + print "\b."; + } #~for + print "\nAdded ".@new_file_endpoints." endpoints to group $::group\n"; + sleep(3); + } #~if need to create file endpoints + +} #~prepareFileEndpoints + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## prepareExportList - assemble the list of nfs exports from either +## the nfs_list resource or the nfs_mnt option +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub prepareExportList { + + if ((defined $::nfs_list) && ("$::nfs_list" ne "")) { + open(my $fh, "<", $::nfs_list) or do_err_exit("Unable to open [$::nfs_list]. Cannot continue."); + my @lines = (); + while(<$fh>) { + chomp; + next if (/^\s*[#;]/); + next if (/^\s*$/); + s/^\s+//; + s/\s+$//; + if (/[0-9a-zA-Z.-]+:\/.*$/) { + push( @lines, $_ ); + } + } + close($fh); + if (@lines < 1) { + do_err_exit("Unable to find lines that look like nfs mount points in [$::nfs_list]. Cannot continue."); + } + my $i = 0; + for my $mvlan (sort keys %::mac_vlans) { + $::mnt_map{ $mvlan } = $lines[ $i ]; + print " mapping $mvlan => ".$lines[ $i ].NL if($::DEBUG); + $i = ++$i % @lines; + } + } + elsif ((defined $::nfs_mnt) && ("$::nfs_mnt" ne "")) { + for my $mvlan (sort keys %::mac_vlans) { + $::mnt_map{ $mvlan } = $::nfs_mnt; + } + } + else { + do_err_exit("Niether --nfs_list or --nfs_mnt are specified. Cannot continue."); + } + + if ((keys %::mnt_map) < 1) { + do_err_exit("prepareExportList: unable to build map of mount entries. Cannot continue."); + } +} +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## prepareGroups - creates requested test group if it does not exist, +## file-endpoints will be created expecting these refs +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub prepareTestGroups { + my @new_items = (); + my $test_group_str = $::utils->doCmd("show_group all"); + my @test_group_lines = split(/\n/, $test_group_str ); + my %test_groups = (); + + for my $group_name (sort(keys %::group_names)) { + $test_groups{ $group_name } = 0; + } + for my $line ( @test_group_lines) { + if ($line =~ /TestGroup name: ([^\[]+)\s*\[.*$/) { + $test_groups{ $1 } = 1; + } + } + for my $group_name (keys %test_groups) { + if ($test_groups{$group_name} == 0 ) { + push(@new_items, $group_name); + } + } + if (@new_items > 0 ) { + sleep(5); + for my $group_name (@new_items) { + + $::utils->doCmd($::utils->fmt_cmd("add_group", $group_name."_wo", NA, NA)) if (!$::skip_writers); + $::utils->doCmd($::utils->fmt_cmd("add_group", $group_name."_ro", NA, NA)) if (!$::skip_readers); + + #print " + tg $group_name "; + } + } +} # ~prepareTestGroups + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## generates random mac address +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub mac { + my $rv = "00:"; + for (my $i=0; $i<5; $i++) { + $rv.=sprintf("%02X",int(rand(255))).(($i<4)?':':''); + } + return $rv; +} + + + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## list ports +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub showGroups { + my @ports = $::utils->getPortListing($::shelf_num, $::resource); + print "in show groups, found $#ports ports\n" if ($::DEBUG); + for my $group_name ( sort(keys(%::group_names))) { + print "show groups, $group_name _ro\n" if ($::DEBUG); + my $cmd = $::utils->fmt_cmd("show_group", $group_name."_ro"); + print $::utils->doCmd($cmd); + + print "show groups, $group_name _wo\n" if ($::DEBUG); + $cmd = $::utils->fmt_cmd("show_group", $group_name."_wo"); + print $::utils->doCmd($cmd); + } + print "\n"; +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## start the writers then start the readers +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub runGroup { + my $cmd; + if (!$::skip_writers) { + $cmd = "start_group ".$::group."_wo"; + $::utils->doCmd($cmd); + print "Starting ".$::group."_wo..."; + for my $i ( 1..$sleep_after_wo ) { sleep(1); print "."; } + print "...started".NL; + } + if (!$::skip_readers) { + $cmd = "start_group ".$::group."_ro"; + $::utils->doCmd($cmd); + print "Starting ".$::group."_ro ..."; + for my $i ( 1..3 ) { sleep(1); print "."; } + print "...started".NL; + } +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## stop writers then stop readers +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub stopGroup { + my $cmd; + if (!($::skip_writers || $skip_readers)) { + print NL."Quiesceing all connections..."; + $cmd = "quiesce_group all"; + $::utils->doCmd($cmd); + } + if (!$::skip_writers) { + print NL."Quiesceing writers..."; + $cmd = "quiesce_group ".$::group."_wo"; + $::utils->doCmd($cmd); + } + if (!$::skip_readers) { + print NL."Quiesceing readers..."; + $cmd = "quiesce_group ".$::group."_ro"; + $::utils->doCmd($cmd); + } +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## poll the set of connections to see if they are 'stopped' +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub pollCxForStop { + my $cmd; + my $lines; + my $num_lines = 0; + my $num_counted = 0; + my $num_stopped = 0; + my $upper_limit = 60; + my $attempts = 0; + while( $num_counted == 0 || ($num_counted != $num_stopped)) { + return 0 if ($attempts > $upper_limit); + sleep(2); + $attempts++; + $cmd = $::utils->fmt_cmd("show_cx", "all", "all"); + $lines = $::utils->doCmd($cmd); + $num_counted = 0; + $num_stopped = 0; + for my $line (split(NL, $lines)) { + next unless ($line =~ /CX_.*?_[wr]o_\d+/); + $num_counted ++; + my @h = split(/ +/, $line); + + $num_stopped += ($h[10] eq "STOPPED") ? 1 : 0; + print "${h[2]} target:${h[8]} reported:${h[10]} counted:$num_counted stopped:$num_stopped attempts: $attempts".NL if ($::DEBUG); + } + print " counted:$num_counted stopped:$num_stopped attempts: $attempts".NL if ($::DEBUG); + } + return 1; +} + + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## stop the group, +## delete the file endpoints from the group, +## then delete the group +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- + +sub deleteGroup { + if ((!defined $::group) || ("$::group" eq "")) { + do_err_exit("Cannot delete group if --group unspecified."); + } + my $group_name = undef; + if( @_ < 1 ) { + if ( $::skip_readers || $::skip_writers) { + if (!$::skip_readers) { + print "send Delete Group $group_name to $::group _ro \n" if ($::DEBUG); + deleteGroup( $::group."_ro") ; + } + if (!$::skip_writers) { + print "send Delete Group $group_name to $::group _wo \n" if ($::DEBUG); + deleteGroup( $::group."_wo"); + } + return; + } + $group_name = $::group; + } + else { + ($group_name) = @_; + } + print "Delete Group $group_name\n" if ($::DEBUG); + + my %cx_names = (); + my %endp_names = (); + my %portlist = (); + my $cx_prefix = "CX_".$group_name."_"; + my $should_stop_group = 0; + my $cmd; + my $resp; + my $endp_name; + my $cx_name; + + if ("$group_name" eq "$::group") { + $cmd = $::utils->fmt_cmd("show_group", $group_name."_wo"); + $resp = $::utils->doCmd($cmd); + $cmd = $::utils->fmt_cmd("show_group", $group_name."_ro"); + $resp .= $resp.NL.$::utils->doCmd($cmd); + } + else { + $cmd = $::utils->fmt_cmd("show_group", $group_name); + $resp = $::utils->doCmd($cmd); + } + + # collect cross connect names + for my $line (split(NL, $resp)) { + chomp $line; + $should_stop_group = 1 if ($line =~ /TestGroup name:.*?\[RUNNING/); + if( $line =~ / $cx_prefix/ ) { + for my $tg_name_hunk (sort split(/\s+/, $line )) { + next if ( $tg_name_hunk =~ /^ *$/); + print "$tg_name_hunk " if ($::DEBUG); + $cx_names{$tg_name_hunk}++ if ($tg_name_hunk =~ /^CX_/); + } + } + } + + if ($should_stop_group) { + stopGroup(); + if (! pollCxForStop()) { + stopGroup(); + print "Not all connections have stopped. Continuing.".NL; + } + } + + # I'm not getting output here for many seconds after polling for stop + foreach my $x (1..10) { sleep(1); print "."; } + print NL; + + # build endpoint names and find ports + for $cx_name (reverse sort keys %cx_names) { + next if( $cx_name !~ /^CX_/); + my $endp_name = $cx_name; + $endp_name =~ s/CX_//; + print "."; sleep(0.2); + my $lines = $::utils->doCmd("nc_show_endp $endp_name"); + for my $line (split(NL, $lines)) { + if ($line =~ /Shelf: /) { + $line =~ s/,//g; + my @hunks = split(/\s+/, $line); + my $port = $hunks[2]." ".$hunks[4]." ".$hunks[6]; + #print "PORT: $port\n"; + $portlist{$port}++; + } + } + } + print NL; + die "Error making portlist" if (length(keys %portlist) < 1); + + # remove cross connects and endpoints immediately after each + print "Removing Cross Connects and endpoints: "; + for $cx_name (reverse sort keys %cx_names) { + next if( $cx_name !~ /^CX_/); + $cmd = $::utils->fmt_cmd("rm_cx", "all", $cx_name); + print "** $cmd **".NL if ($::DEBUG); + + $::utils->doCmd($cmd); + print "0"; #$cx_name "; + sleep(0.5); + my $endp_name = $cx_name; + $endp_name =~ s/CX_//; + $cmd = $::utils->fmt_cmd("rm_endp", $endp_name); + $::utils->doCmd($cmd); + print "o"; #$endp_name "; + sleep(0.1); + } + print NL; + sleep(1); + + # remove group + if ( "$group_name" eq "$::group" ) { + $cmd = $::utils->fmt_cmd("rm_group", $group_name."_wo"); + print " + $cmd".NL if ($::DEBUG); + $::utils->doCmd($cmd); + print "Removed ".$group_name."_wo".NL; + sleep(0.2); + $cmd = $::utils->fmt_cmd("rm_group", $group_name."_ro"); + print " + $cmd".NL if ($::DEBUG); + $::utils->doCmd($cmd); + print "Removed ".$group_name."_ro".NL; + sleep(0.2); + } + else { + $cmd = $::utils->fmt_cmd("rm_group", $group_name); + print " + $cmd".NL if ($::DEBUG); + $::utils->doCmd($cmd); + print "Removed ".$group_name.NL; + } + sleep(2); + + # set those vlans admin down + print "Setting mvlans down: "; + for my $port (reverse sort keys %portlist) { + my @h = split(/\s+/, $port); + $cmd = fmt_port_up_down($h[1], $h[2], "down"); + print "$cmd".NL if ($::DEBUG); + $::utils->doCmd($cmd); + print "o"; # $port "; + sleep(0.4); + } + print NL; + sleep(0.2 * length(keys %portlist)); + # remove macvlans + print "Removing mvlans ports: "; + for my $port (reverse sort keys %portlist) { + $cmd = "rm_vlan $port"; + print "Remove VLAN: $cmd".NL if ($::DEBUG); + $::utils->doCmd($cmd); + print "*"; #$port "; + sleep(0.2); + } + print "...done.".NL; +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +## use this method to find the user prefix for each ip last octet +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- +sub get_prefix_for_octet { + my($octet) = @_; + die "get_prefix_for_octet called without octet as argument" if ((!defined $octet) || ("$octet" eq "")); + for my $name (sort( keys %::group_names)) { + my $ra_bounds = $::group_names{ $name }; + if (($octet >= @$ra_bounds[0]) && ($octet <= @$ra_bounds[1])) { + return $name; + } + } + die "get_prefix_for_octet: no prefix found for octet [$octet]"; +} + +sub do_err_exit { + my $msg = shift; + print $msg.NL; + exit(1); +} + +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- == +## == +## M A I N == +## == +## ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- == + +GetOptions +( + 'mgr|m=s' => \$lfmgr_host, + 'mgr_port|mp=i' => \$lfmgr_port, + 'resource|r=i' => \$resource, + 'quiet|q=s' => \$quiet, + 'action|a=s' => \$action, + 'nfs_mnt|h=s' => \$nfs_mnt, + 'nfs_list|e=s' => \$nfs_list, + 'first_mvlan_ip|n=s' => \$first_mvlan_ip, + 'group|g=s' => \$group, + 'debug' => \$DEBUG, + 'dbg_nap|dp=i' => \$D_PAUSE, + 'parent_port|pp=s' => \$parent_port, + 'min_rw_size|nws=i' => \$min_rw_size, + 'max_rw_size|xws=i' => \$max_rw_size, + 'use_crc|crc=s' => \$use_crc, + 'min_read_bps|nrbps=i' => \$min_read_bps, + 'max_read_bps|xrbps=i' => \$max_read_bps, + 'num_files|nf=i' => \$num_files, + 'quiesce_after_files|qaf=i' => \$quiesce_after_files, + 'skip_readers|sr=i' => \$skip_readers, + 'skip_writers|sw=i' => \$skip_writers, + 'min_file_size|nsz=i' => \$min_file_size, + 'max_file_size|xsz=i' => \$max_file_size, + 'min_write_bps|nwbps=i' => \$min_write_bps, + 'max_write_bps|xwbps=i' => \$max_write_bps, + 'mount_options|mo=s' => \$mount_options, + 'netmask|nm=s' => \$netmask, + 'tmp_group|tmp=s' => \$tmp_group, + 'min|ga=i' => \$tmp_group_min, + 'max|gb=i' => \$tmp_group_max, +) || do_err_exit("$usage"); + + +if ((!defined $action) || ($action eq "")) { + do_err_exit("Please specify an action to perform.\n$usage"); +} + +if ( ! ( $action eq "list_groups" + || $action eq "run_group" + || $action eq "stop_group" + || $action eq "del_group" )) { + do_err_exit("Unknown action $action:\n$usage"); +} + +if ((defined $tmp_group) && ($tmp_group ne "")) { + print "Using temporary group [$tmp_group]\n"; + do_err_exit("Please set --min when using tmp_group") if ($tmp_group_min <= 0); + do_err_exit("Please set --max when using tmp_group") if ($tmp_group_max <= 0); + $group = $tmp_group; +} +elsif ( !(defined $group) || ("$group" eq "")) { + do_err_exit("Blank or unknown group. Cannot continue."); +} + +if ( $group eq $tmp_group ) { + if ( !defined $parent_port || "$parent_port" eq "" ) { + do_err_exit("Undefined --parent_port value. Cannot continue."); + } + $group_names{ $tmp_group } = [ $tmp_group_min, $tmp_group_max, $parent_port ]; + print "assigned values to group name [$group]\n" if ($::DEBUG); + my $ra = $group_names{ $tmp_group }; + print "values: [".join(':', @$ra)."]\n" if ($::DEBUG); +} + +if ( !defined $parent_port || "$parent_port" eq "" ) { + $parent_port = $group_names{ $group }[2]; + if ( !defined $parent_port || "$parent_port" eq "" ) { + do_err_exit("Undefined --parent_port value. Cannot continue."); + } +} + +init(); + +if ( $action eq "list_groups" ) { + showGroups(); + exit(0); +} + +print "checking group name [$group]\n" if ($::DEBUG); +if ( !defined $group || $group eq "" || ! $group_names{ $group }) { + $group = "" if ( !defined $group ); + do_err_exit("Blank or unknown group [$group]" + .NL."Known groups: ".join(', ', sort(keys(%group_names)))); +} +print "Using group [$group]\n"; + + +if ( $action eq "stop_group" ) { + stopGroup(); +} +elsif ( $action eq "run_group" ) { + prepareTestGroups(); + preparePorts(); + prepareExportList(); + prepareFileEndpoints(); + runGroup(); +} +elsif ( $action eq "del_group" ) { + if ( $::skip_readers || $::skip_writers ) { + deleteGroup(); + } + else { + deleteGroup( $::group ); + } +} +else { + die "Unknown action $action:\n$usage"; +} + +#eof diff --git a/lf_parse_tshark_log.pl b/lf_parse_tshark_log.pl new file mode 100755 index 000000000..b86998eba --- /dev/null +++ b/lf_parse_tshark_log.pl @@ -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; + } + } +} diff --git a/lf_port_walk.pl b/lf_port_walk.pl new file mode 100755 index 000000000..c41397047 --- /dev/null +++ b/lf_port_walk.pl @@ -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); +} diff --git a/lf_portmod.pl b/lf_portmod.pl new file mode 100755 index 000000000..417323a3e --- /dev/null +++ b/lf_portmod.pl @@ -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); diff --git a/lf_show_events.pl b/lf_show_events.pl new file mode 100755 index 000000000..613b5e12f --- /dev/null +++ b/lf_show_events.pl @@ -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); +# diff --git a/lf_sta_name.pl b/lf_sta_name.pl new file mode 100755 index 000000000..653b23c1c --- /dev/null +++ b/lf_sta_name.pl @@ -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); +} + +# diff --git a/lf_staggered_dl.sh b/lf_staggered_dl.sh new file mode 100755 index 000000000..ab9c8c0be --- /dev/null +++ b/lf_staggered_dl.sh @@ -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 diff --git a/lf_stress1.pl b/lf_stress1.pl new file mode 100755 index 000000000..a96410311 --- /dev/null +++ b/lf_stress1.pl @@ -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); +} diff --git a/lf_stress2.pl b/lf_stress2.pl new file mode 100755 index 000000000..9101b7de7 --- /dev/null +++ b/lf_stress2.pl @@ -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); +} diff --git a/lf_stress3.pl b/lf_stress3.pl new file mode 100755 index 000000000..2460b219f --- /dev/null +++ b/lf_stress3.pl @@ -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); +} diff --git a/lf_stress4.pl b/lf_stress4.pl new file mode 100755 index 000000000..b89bc7e6e --- /dev/null +++ b/lf_stress4.pl @@ -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); +} diff --git a/lf_verify.pl b/lf_verify.pl new file mode 100755 index 000000000..bcf183923 --- /dev/null +++ b/lf_verify.pl @@ -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: "; + ; + } + } +}#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 diff --git a/lf_voip.pl b/lf_voip.pl new file mode 100755 index 000000000..dca39618a --- /dev/null +++ b/lf_voip.pl @@ -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); +} diff --git a/lf_voip_test.pl b/lf_voip_test.pl new file mode 100755 index 000000000..78e8496d9 --- /dev/null +++ b/lf_voip_test.pl @@ -0,0 +1,1121 @@ +#!/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 VoIP connections. +# It then continously starts and stops the connections. + +# Un-buffer output +$| = 1; + +use strict; +use Switch; + +use Net::Telnet (); +use LANforge::Port; +use LANforge::Utils; + +my $script_speed = 25; # Increase to issue commands faster + +my $lfmgr_host = undef; +my $lfmgr_port = 4001; + +my $shelf = 1; + +my $INIT = 1; # If true, removes all previous tests!!! + +# This sets up connections between 2 LANforge machines with minor EIDs of 4 and 15 +#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 = 1; my $lf2 = 2; my @lf1_ports = ("ad0"); my @lf2_ports = ("ad0"); +my $lf1 = 1; my $lf2 = 1; my @lf1_ports = ("eth1"); my @lf2_ports = ("eth2"); + +my $ignore_phys_ports = 0; # If 1, just muck with mac-vlans instead. +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_base = "10.0"; +my $ip_c = 1; +my $ip_lsb = 10; +my $msk = "255.0.0.0"; +my $default_gw = "0.0.0.0"; + +my $start_mvlan = 0; # Starting MACVLAN index for VoIP endpoints. +my $num_cxs = 70; # Overrides $num_mvlans. +my $num_mvlans = 0; # Only used if $num_cxs is zero: The number of MACVLANs per interface. + # Representing the total number of VoIP CXs. VoIP CXs are created + # across the two physical interfaces + the MACVLANs per interface. + + +my $codec = "G711U"; # Other options: G711U, g729a, SPEEX, g726-16, g726-24, g726-32, g726-40 +my $jB_size = 1; # Set jitter buffer size in 20ms packets. Default value is 8 packets, 160ms. +my $tos = 0xBE; # Set ToS/QoS for VoIP can be decimal or 0xNN for hexadecimal but values will display in decimal in the GUI. + + +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 $start_dly = 3; # seconds to delay call start +my $start_dly_inc = 0; # seconds to increase delay by for each test + +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"; # set $vproto = "H323"; for H.323 +my $bsip_port_a = "5066"; # Base SIP port for endpoint-A +my $bsip_port_b = "5067"; # Base SIP port for endpoint-B +my $i_sip_port_a = 0; # If zero, do not increment, otherwise increment by assigned value. +my $i_sip_port_b = 0; # If zero, do not increment, otherwise increment by assigned value. +my $brtp_port = "AUTO"; # Base RTP port +my $i_rtp_port = 0; # If zero, do not increment, otherwise increment by assgined value + + +# 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 $STARTSTOP_LOOP = 0; # set $STARTSTOP_LOOP = 1; to start and stop ALL endpoints + # after script finishes populating the database. +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 $script_name = $0; + +# 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 @num = (); #make sorting by name easier :P +my $num_len = 0; +my $total = 0; + +if ($num_mvlans == 0 && $num_cxs == 0) { + printHelp(); + print "\nYou must specify a non-zero value for: num_cxs: $num_cxs OR num_mvl: $num_mvlans\n\n"; + exit (1); +} + +if ($num_cxs != 0) { + $total = $num_cxs*2; + $num_len = length ($total); + $num_mvlans = $num_cxs-1; +} +else { + $total = (($num_mvlans+1)*2); + $num_len = length ($total); +} + +my $i = 0; +switch ($num_len) { + case 1 { + for ($i=0;$i<$total;$i++) { + $num[$i] = sprintf("%01d", $i); + } + } + case 2 { + for ($i=0;$i<$total;$i++) { + $num[$i] = sprintf("%02d", $i); + } + } + case 3 { + for ($i=0;$i<$total;$i++) { + $num[$i] = sprintf("%03d", $i); + } + } + case 4 { + for ($i=0;$i<$total;$i++) { + $num[$i] = sprintf("%04d", $i); + } + } + else { print '***** Error Invalid Number of MAC VLANS i.e. >10,000 !!!!'; } +} + + +print + . "init: $INIT\n" + . "\nmanager: $lfmgr_host\n" + . "\nlf1: $lf1\nlf2: $lf2\n" + . "\nlf1_ports: " . join(" ", @lf1_ports) + . "\nlf2_ports: " . join(" ", @lf2_ports) . "\n" + . "\nstart_macvlans: $start_mvlan" + . "\nnum_mvlans: $num_mvlans\n\n"; + + +#my $junk=0; +#for ($junk=0;$junk<$total;$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++) { + $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 ($num_mvlans != 0) { + 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 + +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 { + 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 until 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_mvlans; $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 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++) { + 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 " . + "$default_gw NA NA NA"; + doCmd($cmd); + $ip_lsb++; + + if ($lf2 ne "") { + $cmd = "set_port $shelf $lf2 $tmp2 $ip_base.$ip_c.$ip_lsb $msk " . + "$default_gw 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 = $script_speed; + my $since_throttle = 0; + for ($q = 0; $q<$num_mvlans; $q++) { + $cmd = "set_port $shelf $lf1 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " + . "$default_gw 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_mvlans; $q++) { + $cmd = "set_port $shelf $lf2 $pname\#$q $ip_base.$ip_c.$ip_lsb $msk " + . "$default_gw 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 $sip_port_a = $bsip_port_a; + my $sip_port_b = $bsip_port_b; + + + 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; + my $q_end = 0; + + if ($num_mvlans == 0) { + $q_end = $num_cxs; + } + else { + $q_end = $num_mvlans; + } + + for ($q = 0; $q<$q_end; $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; + my $q_end = 0; + + if ($num_mvlans == 0) { + $q_end = $num_cxs; + } + else { + $q_end = $num_mvlans; + } + + for ($q = 0; $q<$q_end; $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-${num[$ep]}-TX"; +# $ep++; +# my $ep2 = "rtpe-${num[$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 $sip_port_b $pesq_server $pesq_server_port NA $jB_size"; +# doCmd($cmd); +# +# if ($i_sip_port_b != 0) { +# $sip_port_b = $sip_port_b + $i_sip_port_b; +# } +# +# $cmd = "set_endp_flag $ep2 SavePCM 0"; +# doCmd($cmd); +# +# $cmd = "set_endp_tos $ep2 ${tos} 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 $sip_port_a $pesq_server $pesq_server_port NA $jB_size"; +# doCmd($cmd); +# +# if ($i_sip_port_a != 0) { +# $sip_port_a = $sip_port_a + $i_sip_port_a; +# } +# +# $cmd = "set_endp_flag $ep1 SavePCM 0"; +# doCmd($cmd); +# +# $cmd = "set_endp_tos $ep1 ${tos} 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-${num[$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); +# } # cx type l4 +# elsif ($cxt eq "voip") { + # Create VOIP endpoint + + my $ep1 = "RTPE-${num[$ep]}-TX"; + $ep++; + my $ep2 = "RTPE-${num[$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 $start_dly $mn_icg $mx_icg NA $codec $vproto NA NA $min_call_duration $max_call_duration /dev/null 20000 $sip_port_b $pesq_server $pesq_server_port NA $jB_size"; + doCmd($cmd); + + if ($i_sip_port_b != 0) { + $sip_port_b = $sip_port_b + $i_sip_port_b; + } + + $cmd = "set_endp_flag $ep2 SavePCM 0"; + doCmd($cmd); + + $cmd = "set_endp_tos $ep2 ${tos} 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 $start_dly $mn_icg $mx_icg NA $codec $vproto NA NA $min_call_duration $max_call_duration /dev/null 20000 $sip_port_a $pesq_server $pesq_server_port NA $jB_size"; + doCmd($cmd); + + $start_dly += $start_dly_inc; + + if ($i_sip_port_a != 0) { + $sip_port_a = $sip_port_a + $i_sip_port_a; + } + + $cmd = "set_endp_flag $ep1 SavePCM 0"; + doCmd($cmd); + + $cmd = "set_endp_tos $ep1 ${tos} 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-${num[$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); +} + + +sub printHelp { + print + "\n$script_name\n" + . "USAGE: mgr=[ip-of-mgr] init=[0|1] speed=25\n" + . " lf1=X lf2=Y\n" + . " lf1_ports=[\"1 2 3\"|\"eth2 eth3\"] lf2_ports=[\"4 5 6\"|\"eth4 eth5\"]\n" + . " start_mvl=X num_cxs=[N|0 num_mvl=Y]\n" + . " mac3=0xf0 mac2=0xbe mac1=0xef\n" + . " ip_base=192.168 ip_c=1 ip_lsb=2 ip_msk=255.255.0.0\n" + . "\n"; + +} + +sub handleCmdLineArg { + my $arg = $_[0]; + my $val = $_[1]; + + if ($arg eq "mgr") { + $lfmgr_host = $val; + } + elsif ($arg eq "init") { + $INIT = $val; + } + elsif ($arg eq "speed") { + $script_speed = $val; + } + elsif ($arg eq "lf1") { + $lf1 = $val; + } + elsif ($arg eq "lf2") { + $lf2 = $val; + if ($lf1 == $lf2) { + print "\nINVALID: First and second resource are the same !!!\n\n"; + exit (1); + } + } + elsif ($arg eq "mac3") { + $mac3 = $val; + } + elsif ($arg eq "mac2") { + $mac2 = $val; + } + elsif ($arg eq "mac1") { + $mac1 = $val; + } + elsif ($arg eq "ip_base") { + $ip_base = $val; + } + elsif ($arg eq "ip_lsb") { + $ip_lsb = $val; + } + elsif ($arg eq "ip_c") { + $ip_c = $val; + } + elsif ($arg eq "ip_msk") { + $msk = $val; + } + elsif ($arg eq "lf1_ports") { + @lf1_ports = split(/ /, $val); + } + elsif ($arg eq "lf2_ports") { + if ($lf2 == "" || $lf1 == $lf2) { + print "\nINVALID: Either second resource is not defined\nor first and second resource are the same !!!\n\n"; + exit (1); + } + else { + @lf2_ports = split(/ /, $val); + } + } + elsif ($arg eq "start_mvl") { + $start_mvlan = $val; + } + elsif ($arg eq "num_cxs") { + $num_cxs = $val; + } + elsif ($arg eq "num_mvl") { + $num_mvlans = $val; + } + else { + printHelp(); + exit(1); + } +} # handleCmdLineArg diff --git a/lf_vue_mod.sh b/lf_vue_mod.sh new file mode 100755 index 000000000..f3b3a579b --- /dev/null +++ b/lf_vue_mod.sh @@ -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 --radio --security --ssid --passphrase + --delete_sta --name + --show_port --name + --list_ports + --list_cx + --list_l4 + --log_cli + --poll_endp --name [--endp_vals tx_bytes,tx_pkts,rx_bytes,rx_pkts] + --up --name + --down --name + --create_cx --name --sta --port --tcp|--udp --bps , + --create_l4 --name --sta --url --utm --l4bps + --start_cx --name + --start_l4 --name + --stop_cx --name + --stop_l4 --name + --mgr + --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 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 diff --git a/lf_wifi_rest_example.pl b/lf_wifi_rest_example.pl new file mode 100755 index 000000000..1e502eb84 --- /dev/null +++ b/lf_wifi_rest_example.pl @@ -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; +} diff --git a/lf_zlt_binary.pl b/lf_zlt_binary.pl new file mode 100755 index 000000000..f7a54aae3 --- /dev/null +++ b/lf_zlt_binary.pl @@ -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); +} diff --git a/list_phy_sta.sh b/list_phy_sta.sh new file mode 100755 index 000000000..6c1d6cc3e --- /dev/null +++ b/list_phy_sta.sh @@ -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 + +# diff --git a/min_max_ave_station.pl b/min_max_ave_station.pl new file mode 100755 index 000000000..0328b0854 --- /dev/null +++ b/min_max_ave_station.pl @@ -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"; +## +## +## diff --git a/multi_routers.pl b/multi_routers.pl new file mode 100755 index 000000000..da65392a9 --- /dev/null +++ b/multi_routers.pl @@ -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"); +} diff --git a/rand_nc.pl b/rand_nc.pl new file mode 100755 index 000000000..7a685b98a --- /dev/null +++ b/rand_nc.pl @@ -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 +# +#------------------------------------------------------------------- diff --git a/rand_nmap.pl b/rand_nmap.pl new file mode 100755 index 000000000..b249e9f4e --- /dev/null +++ b/rand_nmap.pl @@ -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 +# +#------------------------------------------------------------------- diff --git a/show-port-from-json.pl b/show-port-from-json.pl new file mode 100755 index 000000000..32fb65f2a --- /dev/null +++ b/show-port-from-json.pl @@ -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); diff --git a/station-toggle.sh b/station-toggle.sh new file mode 100755 index 000000000..89b9ea2df --- /dev/null +++ b/station-toggle.sh @@ -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 + +# diff --git a/telnet_expect_wrapper.pl b/telnet_expect_wrapper.pl new file mode 100755 index 000000000..fb3c1a9e2 --- /dev/null +++ b/telnet_expect_wrapper.pl @@ -0,0 +1,9 @@ +#!/usr/bin/perl + +my $i = 0; +while (1) { + `/home/lanforge/telnet.expect`; + print "Completed telnet connection $i\n"; + $i++; +} + diff --git a/wait_on_ports.pl b/wait_on_ports.pl new file mode 100755 index 000000000..201754bc1 --- /dev/null +++ b/wait_on_ports.pl @@ -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); +# diff --git a/wifi-event-histo.sh b/wifi-event-histo.sh new file mode 100755 index 000000000..c979eed3e --- /dev/null +++ b/wifi-event-histo.sh @@ -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 + +# diff --git a/wifi-roaming-times.pl b/wifi-roaming-times.pl new file mode 100755 index 000000000..9e515b067 --- /dev/null +++ b/wifi-roaming-times.pl @@ -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 +