mirror of
https://github.com/Telecominfraproject/wlan-lanforge-scripts.git
synced 2025-10-28 17:32:35 +00:00
72712ff548
These scripts will now be publicly available in a git repo for easier shared development and change tracking.
280 lines
8.0 KiB
Perl
Executable File
280 lines
8.0 KiB
Perl
Executable File
#!/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);
|
|
}
|