Commit 08ca1a04 authored by Gary Wong's avatar Gary Wong

Add a "mktestbedtest" script.

It constructs an experiment including every (available) experimental PC,
and every relevant link, so that during swap-in linktest will exercise
as much of the testbed as possible.
parent 90f22d96
......@@ -1160,6 +1160,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
utils/opsdb_control utils/opsdb_control.proxy \
utils/remove_old_www utils/epmodeset \
utils/mkblob utils/rmblob utils/ctrladdr utils/tcppd \
utils/mktestbedtest \
www/GNUmakefile www/defs.php3 www/dbdefs.php3 www/xmlrpc.php3 \
www/xmlrpcpipe.php3 \
www/swish.conf www/websearch \
......
......@@ -49,7 +49,8 @@ SBIN_SCRIPTS = vlandiff vlansync withadminprivs export_tables cvsupd.pl \
addspecialdevice addspecialiface imagehash clone_image \
addvpubaddr imageinfo ctrladdr image_import \
prereserve_check tcppd addexternalnetwork \
update_sitevars delete_image sitecheckin sitecheckin_client
update_sitevars delete_image sitecheckin sitecheckin_client \
mktestbedtest
WEB_SBIN_SCRIPTS= webnewnode webdeletenode webspewconlog webarchive_list \
webwanodecheckin webspewimage webdumpdescriptor \
......
#!/usr/bin/perl -w
#
# Copyright (c) 2012 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
# This file is part of the Emulab network testbed software.
#
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public
# License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this file. If not, see <http://www.gnu.org/licenses/>.
#
# }}}
#
use English;
use strict;
#
# Configure variables
#
my $TB = "@prefix@";
#
# Turn off line buffering on output
#
$| = 1;
#
# Untaint the path
#
$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/sbin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
# A ghastly bit of SQL to retrieve all testnode PCs, their reservation
# status, and number of experimental interfaces.
my $result = DBQueryWarn( "SELECT nodes.node_id, reserved.eid, " .
"COUNT(interfaces.node_id) FROM nodes " .
"LEFT OUTER JOIN reserved ON " .
"nodes.node_id = reserved.node_id INNER JOIN " .
"node_types ON nodes.type = node_types.type " .
"INNER JOIN interfaces ON nodes.node_id = " .
"interfaces.node_id " .
"WHERE node_types.class = 'pc' AND " .
"nodes.role = 'testnode' AND " .
"interfaces.role = 'expt' " .
"GROUP BY nodes.node_id;" );
die( "Could not retrieve node list!" ) unless defined( $result );
my $warnings = 0;
my $num_nodes = 0;
my $max_ifs = 0;
my $total_ifs = 0;
my @nodes = ();
while( my( $node_id, $eid, $ifs ) = $result->fetchrow_array() ) {
if( defined( $eid ) ) {
if( $warnings < 10 ) {
print STDERR "warning: $node_id is reserved\n";
$warnings++;
}
} else {
my %dat = ( name => $node_id, ifs => $ifs );
push( @nodes, \%dat );
$max_ifs = $ifs if( $ifs > $max_ifs );
$total_ifs += $ifs;
$num_nodes++;
}
}
print "set ns [new Simulator]\n";
print "source tb_compat.tcl\n\n";
my $i = 0;
foreach my $node (@nodes) {
# It would be nice to use the physical node_ids for the Tcl node
# names. Unfortunately, we can't guarantee that they are legal
# Tcl identifiers. So we have to make up silly generic names instead.
print "set node$i [\$ns node]\n";
print "tb-fix-node \$node$i \"$node->{name}\"\n";
print "tb-set-node-failure-action \$node$i \"nonfatal\"\n";
$i++;
}
# Pick a sensible number of LANs to create. The number isn't really
# critical... let's just pick sqrt( $total_ifs ) to avoid a huge number
# of tiny LANs or a tiny number of huge LANs. Then make sure it's
# at least $max_ifs -- since we'll assign interfaces to LANs round-robin
# style, this will ensure each interface on any one node belongs to a
# different LAN.
my $num_lans = int( sqrt( $total_ifs ) );
$num_lans = $max_ifs if( $max_ifs > $num_lans );
my @lans = ("") x $num_lans;
$i = 0;
my $next_lan = 0;
foreach my $node (@nodes) {
foreach (1..$node->{ifs}) {
$lans[ $next_lan ] .= "\$node$i ";
$next_lan++;
$next_lan = 0 if( $next_lan == $num_lans );
}
$i++;
}
$i = 0;
print "\n";
foreach (@lans) {
# Make all LANs 1 gigabit... this needs to be made more sophisticated.
# We don't want to require any delay nodes, and we should really
# set each interface to full speed and group them into VLANs
# accordingly. But we don't want to oversubscribe inter-switch
# trunks, either!
#
# Fortunately, the 1 Gb default works fine for InstaGENI racks, which
# is our immediate concern.
chop;
# nsverify is unhappy unless we assign the result somewhere
print "set lan$i [\$ns make-lan \"$_\" 1000Mb 0ms]\n";
$i++;
}
print "\n\$ns run\n";
exit( 0 );
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment