lf_many_conn2.pl

#!/usr/bin/perl

# This program is used to stress test the LANforge system, and may be used as
# an example for others who wish to automate LANforge tests.

# The purpose of this script is to create many connections
# This script not only starts and stops connections, but
# also verifys that both ends of the connection
# have received data before tearing the connection down.
# (Errors will be printed to the console if the connection
# does not start in 15 seconds.)

# Written by Candela Technologies Inc.
#  Udated by:
#
#

use strict;

# Un-buffer output
$| = 1;

use LANforge::Endpoint;
use LANforge::Port;
use LANforge::Utils;

use Net::Telnet();

use Getopt::Long;

my $lfmgr_host = "localhost";
my $lfmgr_port = 4001;

my $shelf_num = 1;

# Specify 'card' numbers for this configuration.
my $lanf1 = 4;
my $lanf2 = 4;

# Script assumes that we are using one port on each machine for data transmission...specifically
# port 1.

my $test_mgr = "conn-mgr";


my $report_timer = 8000; # XX/1000 seconds

my $between_start_stop = 120; # run for 120 seconds between start/stop

# Default values for ye ole cmd-line args.
my $proto = "tcp";  # tcp, udp, or both
my $cx_to_create = 800; # How many we will try to create.
my $quiet = "yes";
my $start_cx_num = 0;
my $init_to_dflts = "yes";
my $speed = 200000;
my $payloadsize = 1400;

# Port pairs.  These are the ports that should be talking to each other.
# Ie, the first item lf1_ports talks to the third column in lf2_ports.
# Syntax is: port_num ip_addr ip_mask ip_gateway(dlft_router)
#my $lf1_port = "1 172.16.1.200 255.255.255.0 172.16.1.1";
#my $lf2_port = "1 172.16.1.220 255.255.255.0 172.16.1.1";
my $lf1_port = "1 172.17.1.200 255.255.255.0 172.17.1.1";
my $lf2_port = "2 172.17.1.220 255.255.255.0 172.17.1.1";



my $do_bulk_removes = 1;
my $do_cx_too = 1; # Should probably be 1 most of the time...
my $do_run_cxs = 1; #Should usually be 1
my $fail_msg = "";
my $manual_check = 0;

my $cmd_log_name = "lf_conn_cmds.txt";
open(CMD_LOG, ">$cmd_log_name") or die("Can't open $cmd_log_name for writing...\n");
print "History of all commands can be found in $cmd_log_name\n";

########################################################################
# Nothing to configure below here, most likely.
########################################################################

my $usage = "$0  [--lf1_port {\"port_num ip mask gateway\"}]
                 [--lf2_port {\"port_num ip mask gateway\"}]
                 [--protocol {tcp | udp}]
                 [--start_cx_num {num}]
                 [--quiet {yes | no}]
                 [--num_cxs {num}]
                 [--init_to_dflts {yes | no}]

Example:
 $0 --lf1_port \"1 172.22.22.2 255.255.255.0 172.22.22.1\" --lf2_port \"1 172.22.22.3 255.255.255.0 172.22.22.1\" --init_to_dflts yes\n";

my $i = 0;

GetOptions 
(
	'protocol|p=s'		=> \$proto,
	'start_cx_num|s=i'	=> \$start_cx_num,
        'quiet|q=s'             => \$quiet,
        'num_cxs|n=i'           => \$cx_to_create,
        'init_ports|i=s'        => \$init_to_dflts,
        'lf1_port|l=s'          => \$lf1_port,
        'lf2_port|L=s'          => \$lf2_port,
        'init_to_dflts|d=s'     => \$init_to_dflts,
) || die("$usage");


my @endpoint_names = (); #will be added to as they are created
my @cx_names = ();

# Open connection to the LANforge server.

my $t = new Net::Telnet(Prompt => '/default\@btbits\>\>/');


$t->open(Host    => $lfmgr_host,
	 Port    => $lfmgr_port,
	 Timeout => 10);

$t->waitfor("/btbits\>\>/");

my $dt = "";


# Configure our utils.
my $utils = new LANforge::Utils();
$utils->telnet($t);         # Set our telnet object.
$utils->cli_send_silent(0); # Do show input to CLI
$utils->cli_rcv_silent(1);  # Repress output from CLI ??


my $dt = "";

if ($init_to_dflts eq "yes") {
  initToDefaults();

  # Now, add back the test manager we will be using
  $utils->doCmd("add_tm $test_mgr");
  $utils->doCmd("tm_register $test_mgr default");  #Add default user
  $utils->doCmd("tm_register $test_mgr default_gui");  #Add default GUI user

  setUpPorts();
}

# $utils->doCmd("log_level 63");


# Create the connections we will be manipulating.
my $i = 0;
my $ep = $start_cx_num * 2;

my $cmd = "";
my $cx = $start_cx_num;

for ($i = 0; $i<$cx_to_create; $i++) {
  my $burst = "NO";
  my $szrnd = "NO";
  my $pattern = "INCREASING";
  my $epnum = $i;
  my $ep1 = "endp-${ep}-TX";
  my $min_rate = $speed;
  my $max_rate = $speed;
  my $pktsz = $payloadsize;

  $ep++;
  my $ep2 = "endp-${ep}-RX";
  $ep++;

  my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);

  @endpoint_names = (@endpoint_names, $ep1, $ep2);

  $cmd = "add_endp $ep1 $shelf_num $lanf1 $pn lf_$proto -1 $burst $min_rate $max_rate $szrnd $pktsz $pktsz $pattern NO";
  $utils->doCmd($cmd);

  # Don't verify these, for speed reasons (and they should always work unless something
  # is mis-configured.
  #my $endp1 = new LANforge::Endpoint();
  #$utils->updateEndpoint($endp1, $ep1);
  #verifyEndpointAttributes($endp1, $ep1, $shelf_num, $lf1, $lf1_ports[$j], $cx_types[$i], -1, $burst,
  #                         $min_rate, $max_rate, $szrnd, $min_pkt_szs[$i], $max_pkt_szs[$i], $pattern,
  #                         "NO"); # last is use_checksum

  ($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
  $cmd = "add_endp $ep2 $shelf_num $lanf2 $pn lf_$proto -1 $burst $min_rate $max_rate $szrnd $pktsz $pktsz $pattern NO";

  $utils->doCmd($cmd);

  # Now, add the cross-connects
  my $cx_name = "cx-${cx}";
  $cmd = "add_cx $cx_name $test_mgr $ep1 $ep2";
  $utils->doCmd($cmd);
  $utils->doCmd("set_cx_report_timer $test_mgr $cx_name $report_timer");

  $cx++;

  @cx_names = (@cx_names, $cx_name);
}#addCrossConnects


# Now, bring up and down connections

my $tot_cx_started = 0;
my $begin_time = time();

while (1) {
  my $stime = time();

  for ($i = 0; $i<@cx_names; $i++) {
    my $nm = $cx_names[$i];
    $cmd = "set_cx_state $test_mgr $nm RUNNING";
    $utils->doCmd($cmd);
  }

  # Make sure they all started, and wait untill both sides have received
  # a packet or two.
  my $slp = 0;
  for ($i = 0; $i<@endpoint_names; $i++) {
    my $endp1 = new LANforge::Endpoint();
    my $en = $endpoint_names[$i];
    $utils->updateEndpoint($endp1, $en);
    while ($endp1->rx_pkts() <= 0) {
      if ($slp > 20) {
	# Things are not working right, it should never take this long
	print "WARNING:  Endpoint $en is not receiving packets after $slp seconds.\n";
	last;
      }
      $slp++;
      sleep(1);
      $utils->updateEndpoint($endp1, $en);
    }
  }

  sleep($between_start_stop);

  # Stop cxs.
  for ($i = 0; $i<@cx_names; $i++) {
    my $nm = $cx_names[$i];
    $cmd = "set_cx_state $test_mgr $nm STOPPED";
    $utils->doCmd($cmd);
  }
}#while true

exit(0);


sub initToDefaults {
  # Clean up database if stuff exists

  $utils->doCmd("rm_cx $test_mgr all");
  $utils->doCmd("rm_endp YES_ALL");
  $utils->doCmd("rm_test_mgr $test_mgr");

  # initPortsToDefault();
}#initToDefaults


sub initPortsToDefault {
  # Set all ports we are messing with to known state.
  my $i = 0;
  my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
  $utils->doCmd("set_port $shelf_num $lanf1 $pn 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");

  ($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
  $utils->doCmd("set_port $shelf_num $lanf2 $pn 0.0.0.0 0.0.0.0 0.0.0.0 NA NA NA");
}

sub testFailed {
  my $msg = shift;
  my $should_fail = shift;

  if (defined($should_fail) && ($should_fail eq "YES")) {
    print "\nGOOD: SUB-TEST FAILED correctly: $msg\n";
    $fail_msg .= "GOOD (should fail): $msg";
  }
  else {
    print "\nSUB-TEST FAILED: $msg\n";
    $fail_msg .= $msg;

    if ($manual_check) {
      #$utils->doCmd("log_level 7");
      print "Press enter to continue with test: ";
      <STDIN>;
    }
    else {
      die("FATAL ERROR: $fail_msg\n");
    }
  }
}#testFailed

sub setUpPorts {
  # Set all ports we are messing with to known state.
  my $i = 0;

  my ($pn, $ip, $msk, $gw) = split(/\s+/, $lf1_port);
  my $cmd = "set_port $shelf_num $lanf1 $pn $ip $msk $gw NA NA NA";
  $utils->doCmd($cmd);
  my $p1 = new LANforge::Port();
  # Tell the port what it is so it decodes the right one..
  $utils->updatePort($p1, $shelf_num, $lanf1, $pn);
  # Make sure the values we attempted to set actually worked.
  verifyPortAttributes($p1, $shelf_num, $lanf1, $pn, $ip, $msk, $gw);


  ($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
  $cmd = "set_port $shelf_num $lanf2 $pn $ip $msk $gw NA NA NA";
  $utils->doCmd($cmd);
  my $p2 = new LANforge::Port();
  ($pn, $ip, $msk, $gw) = split(/\s+/, $lf2_port);
  # Tell the port what it is so it decodes the right one..
  $utils->updatePort($p2, $shelf_num, $lanf2, $pn);

  verifyPortAttributes($p2, $shelf_num, $lanf2, $pn, $ip, $msk, $gw);

}#setUpPorts


sub verifyPortAttributes {
  my $port = shift;
  my $sn = shift;
  my $cn = shift;
  my $pn = shift;
  my $ip = shift;
  my $msk = shift;
  my $gw = shift;

  my $_sn = $port->shelf_id();
  my $_cn = $port->card_id();
  my $_pn = $port->port_id();
  my $_ipa = $port->ip_addr();

  my $p = $port->toStringBrief();

  $_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n");
  $_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n");
  $_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n");
  $_ipa eq $ip or testFailed("$p: IP Address: $_ipa does not match: $ip\n");
  $port->ip_mask() eq $msk or testFailed("$p: IP Mask: " . $port->ip_mask() . " does not match: $msk\n");
  $port->ip_gw() eq $gw or testFailed("$p: IP Gateway: " . $port->ip_gw() . " does not match: $gw\n");

  print "$p verified as correct!\n";
}#verifyPortAttributes


sub verifyEndpointAttributes {
  my $endp = shift;
  my $name = shift;
  my $sn = shift;
  my $cn = shift;
  my $pn = shift;
  my $type = shift;
  my $ip_port = shift;
  my $bursty = shift;
  my $min_rate = shift;
  my $max_rate = shift;
  my $szrnd = shift;
  my $min_pkt_sz = shift;
  my $max_pkt_sz = shift;
  my $pattern = shift;
  my $using_csum = shift;
  my $should_fail = shift;

  my $_sn = $endp->shelf_id();
  my $_cn = $endp->card_id();
  my $_pn = $endp->port_id();

  my $p = $endp->toStringBrief();

  $_sn eq $sn or testFailed("$p: Shelf id: $_sn does not match: $sn\n", $should_fail);
  $_cn eq $cn or testFailed("$p: Card id: $_cn does not match: $cn\n", $should_fail);
  $_pn eq $pn or testFailed("$p: Port id: $_pn does not match: $pn\n", $should_fail);
  $endp->isOfType($type) or testFailed("$p: Type: " . $endp->ep_type() . " does not match: $type\n", $should_fail);
  if ($ip_port ne -1) {
    $endp->ip_port() eq $ip_port or testFailed("$p: IP-Port: " . $endp->ip_port() .
					       " does not match: $ip_port\n", $should_fail);
  }
  $endp->getBursty() eq $bursty or testFailed("$p: Bursty: " . $endp->getBursty() .
					      " does not match: $bursty\n", $should_fail);

  $endp->min_tx_rate() eq $min_rate or testFailed("$p: Min-Tx-Rate: " . $endp->min_tx_rate() .
						  " does not match: $min_rate\n", $should_fail);
  $endp->max_tx_rate() eq $max_rate or testFailed("$p: Max-Tx-Rate: " . $endp->max_tx_rate() .
						  " does not match: $max_rate\n", $should_fail);

  if ($endp->isCustom()) {
    ($endp->size_random() eq "NO") or testFailed("$p: Size-Random: " . $endp->size_random() .
						 " but we are CUSTOM!!\n", $should_fail);
  }
  else {
    $endp->size_random() eq $szrnd or testFailed("$p: Size-Random: " . $endp->size_random() .
						 " does not match: $szrnd\n", $should_fail);
  }

  if (! $endp->isCustom()) {
    $endp->min_pkt_size() eq $min_pkt_sz or testFailed("$p: Min-Packet-Size: " . $endp->min_pkt_size() .
						       " does not match: $min_pkt_sz\n", $should_fail);
    $endp->max_pkt_size() eq $max_pkt_sz or testFailed("$p: Max-Packet-Size: " . $endp->max_pkt_size() .
						       " does not match: $max_pkt_sz\n", $should_fail);
  }
  $endp->pattern() eq $pattern or testFailed("$p: Pattern: " . $endp->pattern() .
					     " does not match: $pattern\n", $should_fail);
  $endp->checksum() eq $using_csum or testFailed("$p: Using-Checksum: " . $endp->checksum() .
						 " does not match: $using_csum\n", $should_fail);

}#verifyEndpointAttributes


sub genRandomHex {
  my $bytes = shift;

  my @tbl = ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f");
  my $i;
  my $pld = "";
  for ($i = 0; $i<$bytes; $i++) {
    $pld .= $tbl[(rand() * 1000.0) % 16] . $tbl[(rand() * 1000.0) % 16];  #Generate some hex the hard way!
    if ($i != ($bytes - 1)) {
      $pld .= " ";
    }
  }

  return $pld;
}#genRandomHex