ptopgen.in

#!/usr/bin/perl -w

#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# All rights reserved.
#

use English;
use Getopt::Std;

sub usage()
{
    print STDOUT "Usage: ptopgen [-v] [-s switch] [-e pid/eid] [-m factor]\n" .
                 "       -e include given experiment's resources\n" .
                 "          in the ptopfile (as if they were free)\n" .
		 "       -v Include stuff for topologies with virtual nodes\n".
		 "       -m Override multiplex_factor\n";
    exit(-1);
}
my $optlist = "s:e:m:v";
my $mfactor;
my $virtstuff = 0;


# Settings - Change these to your particular network.

#
# Also bogus. The interfaces table does not hold entries for the switch
# side of each link. It will have to at some point, when we have something
# other than 100Mbs ports (say, gbit ports).
#
# Speed in in Kbs!
#
my $default_switchport_speed    = 100000;

######################################################################

my $TBROOT = "@prefix@";
use lib '@prefix@/lib';
require exitonwarn;
use libdb;

my $TRACK_INTERSWITCH_BANDWIDTH = "@TRACK_INTERSWITCH_BANDWIDTH@";

%switches=();
%used_switches=();
my $switchtouse;

my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

my $exempt_pid;
my $exempt_eid;

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV) {
    usage();
}
if (defined($options{"s"})) {
    $switchtouse = $options{"s"};
}
if (defined($options{"m"})) {
    $mfactor = $options{"m"};
}
if (defined($options{"v"})) {
    $virtstuff = 1;
}

if (defined($options{"e"})) {
    ($exempt_pid, $exempt_eid) = split( /\//, $options{"e"} );
    if (!defined($exempt_eid)) { usage(); }
}

# Read class/type maps
my $result =
    DBQueryFatal("select class,type,delay_capacity,virtnode_capacity ".
		 "from node_types");
while (($class,$type,$delaycapacity,$vcap) = $result->fetchrow_array) {
    $classes{$type} = $class;
    $nodetypes{$type} = $delaycapacity;
    $virtcapacity{$type} = $vcap;
}
$result->finish;

# switches can't delay
$nodetypes{"switch"} = 0;

# Print switches
if (defined($switchtouse)) {
    print "node $switchtouse switch:1 *lan:*\n";
    $switches{$switchtouse} = 1;
}
else {
    $result =
	DBQueryFatal("select node_id from nodes where role = \"testswitch\"");

    while (($switch) = $result->fetchrow_array) {
	print "node $switch switch:1 *lan:*\n";
	$switches{$switch} = 1;
    }
    $result->finish;
}

# Find available nodes
#
# VIRTNODES HACK: If the node is a virtual node, then in addition to
# to being free, the underlying physnode has to either be free, or
# not in the hwdown group. Either way, the the underlying physnode has
# to be "up", as determined by the autostatus stuff; this will prevent us
# from allocating a dead virtual node to an experiment. 
# This is especially hacky. We need another mechanism for this.
#
my $pc601hack_only = "a.type='pc601' and";
my $pc601hack_none = "a.type!='pc601' and";
my $pcvmhack       = "(t.class!='pcvm') and ";

# the ordinary free condition for a node
my $free_condition = "(b.node_id is null)";

# if the user has specified an exempt pid/eid, 
# then view any node which is reserved to that experiment as available.
if (defined($exempt_eid)) {
    $free_condition = "($free_condition or ".
	"(b.pid='$exempt_pid' and b.eid='$exempt_eid'))"; 
}

$result =
    DBQueryFatal("select a.node_id,a.type from nodes as a ".
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
		 "left join node_status as ns on a.phys_nodeid=ns.node_id ".
		 "left join node_types as t on t.type=a.type ".
		 "where $free_condition and $pcvmhack ".
		 "      $pc601hack_none ".
		 "      (a.role='testnode' or ".
		 "       (a.role='virtnode' and ns.status='up' and ".
		 "        (m.node_id is null or ".
		 "         m.pid!='$DEADPID' or m.eid!='$DEADEID')))");

while (($node,$type) = $result->fetchrow_array) {
    # Shark hack
    if (($shelf,$number) = ($node =~ /^sh(\d+)-(\d+)/)) {
	if ($number == 1) {
	    $nodes{"sh$shelf"} = "shark-shelf";
	}
    } else {
	$nodes{$node} = $type;
    }
}
$result->finish;


$sharklinks = "";

# XXX NSE hack


foreach $node (keys(%nodes)) {
    if ($node =~ /^sh/) {
	print "node $node shark-shelf:1\n";
    } else {
	$text = "node $node $nodes{$node}:1 $classes{$nodes{$node}}:1";
	$delay_capacity = $nodetypes{$nodes{$node}};
	$virtnode_capacity = $virtcapacity{$nodes{$node}};
	if ($delay_capacity > 0) {
	    $text .= " delay:$delay_capacity";
	    
            #################################################################
            ### NSE Node hack. Instead of adding sim nodes into the
            ### database schema, I'm just adding it here for now
            ### untill we can figure out how to add sim nodes into the
            ### nodes table.  One assumption is that if we the node
            ### type can support delay nodes, then it is a local node
            ### and therefore we can support sim nodes
            #################################################################
            $text .= " sim:100000";
	}

	$features = get_features($node,$nodes{$node});

	if ($virtstuff && $virtnode_capacity > 0) {
	    #
	    # Ditto for jailed nodes
	    #
	    if (defined($mfactor)) {
		$text .= " pcvm:$mfactor";
	    }
	    else {
		$text .= " pcvm:$virtnode_capacity";
	    }
	    $text .= " *lan:*";
	    # Add features
	    if ($features) {
		$text .= " - $features";
	    } else {
		$text .= " -";
	    }
	    # Add trivial bw spec.
	    $text .= " - trivial_bw:400000";
	} else {
	    $text .= " - $features";
	}
	print "$text\n";
    }
}

# Read interfaces
$result = DBQueryFatal("SELECT node_id,card,port,iface,interface_type" .
		     " from interfaces");
while (($node,$card,$port,$iface,$type) = $result->fetchrow_array) {
    $interfacemap{"$node:$card:$port"} = $iface;
    if ((defined $type) && ($type ne "")) {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
}
$result->finish;

# Read interface types
$result = DBQueryFatal("SELECT type,max_speed from interface_types");
while (($type,$speed) = $result->fetchrow_array) {
    $interfacespeeds{$type} = $speed;
}
$result->finish;

# Read interface switches
$result = DBQueryFatal("SELECT node_id1, iface, node_id2 FROM wires AS w " .
	"LEFT JOIN interfaces as i ON w.node_id1=i.node_id AND w.card1=i.card");
while (($node,$iface,$switch) = $result->fetchrow_array) {
    if ($node && $iface) {
	$interfaceswitches{"$node:$iface"} = $switch;
    }
}
$result->finish;

# Read interface cards and ports
$result = DBQueryFatal("SELECT node_id, iface, card, port FROM interfaces");
while (($node,$iface,$card,$port) = $result->fetchrow_array) {
    $interfacecardports{"$node:$iface"} = [$card,$port];
}
$result->finish;



$result = DBQueryFatal("SELECT node_id1,card1,port1,node_id2,card2,port2" .
 		    " from wires where type=\"Node\" or type=\"Trunk\"");
while (($node1,$card1,$port1,$node2,$card2,$port2) = 
       $result->fetchrow_array) {
    if ((defined($nodes{$node1}) || defined($switches{$node1})) && 
	(defined($nodes{$node2}) || defined($switches{$node2}))) {
	$iface1 = get_iface($node1,$card1,$port1);
	$iface2 = get_iface($node2,$card2,$port2);
	$iface1bw = get_ifacebw($node1,$card1,$port1);
	$iface2bw = get_ifacebw($node2,$card2,$port2);
	if ($iface1bw < $iface2bw) {
	    $bw = $iface1bw;
	} else {
	    $bw = $iface2bw;
	}
	if (defined($switches{$node2})) {
	    $used_switches{$node2} = 1;
	}
	if (defined($switches{$node1})) {
	    $used_switches{$node1} = 1;
	}
	if (defined($switches{$node1}) && defined($switches{$node2})) {
	    # interswitch link
	    if (defined($interconnects{"$node1:$node2"})) {
		$interconnects{"$node1:$node2"} += $bw;
	    } else {
		$interconnects{"$node1:$node2"} = $bw;
	    }
	} else {
	    # !!! - Here we use our knowledge that in the wires table links
	    # to the switch always come as node2.
	    print "link link-$node1:$iface1-$node2:$iface2 $node1:$node1/$iface1" .
		" $node2:$iface2 $bw 0 0 1\n";
	}
    } 
}
$result->finish;

#
# If we're supposed to track interswitch bandwidth, subtract out the amount
# that's already in use
#
if ($TRACK_INTERSWITCH_BANDWIDTH) {
    #
    # Get a list of all VLANs
    #
    my $result = DBQueryFatal("SELECT virtual, members FROM vlans");
    while (my ($virtual, $members) = $result->fetchrow()) {
	#
	# Split apart the space-separated list of members
	#
	my @members = split /\s+/, $members;
	my %switches = ();
	foreach my $member (@members) {
	    my ($node,$iface) = split /:/, $member;
	    my $switch = get_ifaceswitch($node,$iface);
	    my ($card, $port) = get_ifacecardport($node,$iface);
	    my $bw = get_ifacebw($node,$card,$port);
	    $switches{$switch} += $bw;
	}

	#
	# Check to see if more than one switch was found among the member
	# list, and if so, go through all the pairs
	#
	my @switches = keys %switches;
	if (@switches > 1) {
	    for (my $i = 0; $i < (@switches -1); $i++) {
		my $switch1 = $switches[$i];
		my $switch2 = $switches[$i+1];
		my $bw = $switches{$switch1};
		if ($switches{$switch2} < $bw) {
			$bw = $switches{$switch2};
		}
		#
		# The trunk link could be listed in either order
		#
		if ($interconnects{"$switch1:$switch2"}) {
		    $interconnects{"$switch1:$switch2"} -= $bw;
		} elsif ($interconnects{"$switch2:$switch1"}) {
		    $interconnects{"$switch2:$switch1"} -= $bw;
		}
	    }
	}
    }
}

foreach $interconnect (keys(%interconnects)) {
    ($src,$dst) = split(":",$interconnect);
    print "link link-$interconnect $src $dst $interconnects{$interconnect} 0 0 1\n";
}

print $sharklinks;

# Print out links
sub get_iface {
    ($node,$card,$port) = @_;
    if (defined($interfacemap{"$node:$card:$port"})) {
	return $interfacemap{"$node:$card:$port"};
    } else {
	# shark hack
	if ($node =~ /^sh/) {
	    return "eth0";
	} else {
	    return "(null)";
	}
	# end shark hack 
    }
};

# Find the bandwidth for an interface
sub get_ifacebw {
    ($node,$card,$port) = @_;
    if (defined($interfacetypes{"$node:$card:$port"})) {
	return $interfacespeeds{$interfacetypes{"$node:$card:$port"}};
    }
    else {
	return $default_switchport_speed;
    }
}

sub get_ifaceswitch {
    ($node,$iface) = @_;
    if (defined($interfaceswitches{"$node:$iface"})) {
	return $interfaceswitches{"$node:$iface"};
    } else {
	return undef;
    }
}

sub get_ifacecardport {
    ($node,$iface) = @_;
    if (defined($interfacecardports{"$node:$iface"})) {
	return @{$interfacecardports{"$node:$iface"}};
    } else {
	return ();
    }
}

sub get_features {
    my ($node, $type) = (@_);
    #
    # We don't actually have a per-node feature table yet, so the node is
    # ignored.
    #

    my @features;
    my $result = DBQueryFatal("select feature, weight from " .
	"node_type_features where type='$type'");
    while (my ($feature, $weight) = $result->fetchrow()) {
	push @features, "$feature:$weight";
    }

    return join(" ",@features);

}