Skip to content

GitLab

emulab-devel
emulab-devel
Commit 25694da3 authored by Jonathon Duerig's avatar Jonathon Duerig
Browse files
Options

Finally checked in a refactoring of ptopgen's output code. This includes... 

Finally checked in a refactoring of ptopgen's output code. This includes making rspecs mor rspec-y rather than just a slight variation of the ptop xml format.
parent cc50b846
Hide whitespace changes
Inline Side-by-side
Showing with 112 additions and 105 deletions
tbsetup/ptopgen.in
View file @ 25694da3
......@@ -13,7 +13,7 @@ use Math::BigInt;
sub usage()
{
print("Usage: ptopgen [-v] [-s switch] [-p pid [-e eid]] [-m factor] " .
"[-n c/e] [-x]\n".
"[-n c/e] [-x] [-g]\n".
" -p include nodes the project has permission to use\n".
" -e include given experiments resources\n" .
" in the ptopfile (as if they were free)\n" .
......@@ -151,13 +151,12 @@ if (defined($options{"x"})) {
$genimode = 1
if (defined($options{"g"}));
$do_xml = 1;
print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print "<ptop testbed=\"@THISHOMEBASE@\" "
. "xmlns=\"http://emulab.net/resources/ptop/0.1\">\n";
}
usage()
if ($prune && !defined($exempt_eid));
print_header();
# Read class/type maps
my $result =
DBQueryFatal("select class,type,isvirtnode from node_types");
......@@ -312,11 +311,7 @@ while (my ($osid) = $result->fetchrow()) {
# Print switches
if (defined($switchtouse)) {
if ($do_xml) {
print_switch($switchtouse);
} else {
print "node $switchtouse switch:1 *lan:*\n";
}
print_switch($switchtouse);
$switches{$switchtouse} = 1;
}
else {
......@@ -325,11 +320,7 @@ else {
"where role='testswitch' or role='widearea_switch'");
while (($switch, $uuid) = $result->fetchrow_array) {
if ($do_xml) {
print_switch($switch, $uuid);
} else {
print "node $switch switch:1 *lan:*\n";
}
print_switch($switch, $uuid);
$switches{$switch} = 1;
}
}
......@@ -659,19 +650,8 @@ foreach $node (keys(%nodes)) {
push @flags, "subnode_of:$subnode_of{$node}";
}
if ($do_xml) {
print "<node name=\"$node\" uuid=\"$uuid\">\n";
print_node_types(@types);
if (!$genimode) {
print_node_flags(@flags);
print_node_features(split(" ", join(" ",@features)));
}
print "</node>\n\n";
} else {
my $text = "node $node " . join(" ",@types) .
" - " . join(" ",@features) . " - " . join(" ",@flags);
print "$text\n";
}
my @parse_features = split(" ", join(" ", @features));
print_node($node, \@types, \@parse_features, \@flags, $uuid);
}
#
......@@ -698,14 +678,8 @@ if ($widearea) {
#
my $fake_inet_switch = "internet";
my @inet_protos = ("ipv4");
if ($do_xml) {
print "<node name=\"$fake_inet_switch\">\n";
print_node_types(map("*$_:*", @inet_protos));
print "</node>\n\n";
} else {
print("node $fake_inet_switch ",
join(" ",map("*$_:*",@inet_protos)), "\n");
}
my @types = map("*$_:*", @inet_protos);
print_node($fake_inet_switch, \@types, [], []);
#
# Note - there is currently an assumption in this query that widearea nodes
......@@ -824,18 +798,7 @@ if ($widearea) {
push @features, "bwlimit:0";
}
if ($do_xml) {
print "<node name=\"$physnode\" uuid=\"$uuid\">\n";
print_node_types(@types);
print_node_flags(@flags);
print_node_features(@features);
print "</node>\n";
} else {
my $text = "node $physnode " .
join(" ",@types) . " - " . join(" ",@features) .
" - " . join(" ",@flags);
print "$text\n";
}
print_node($physnode, \@types, \@features, \@flags, $uuid);
#
# Print out a link to the 'internet'.
......@@ -843,16 +806,9 @@ if ($widearea) {
# could put something real in there.
#
if ($iface) {
if ($do_xml) {
print_simple_link($physnode, $iface,
$fake_inet_switch, "(null)",
100000, 0, 0, @inet_protos);
} else {
print "link link-$physnode:$iface-$fake_inet_switch:(null) ".
"$physnode:$physnode/$iface $fake_inet_switch:(null) " .
"100000 0 0 1 ".
join(" ",@inet_protos). "\n";
}
print_simple_link($physnode, $iface,
$fake_inet_switch, "(null)",
100000, 0, 0, @inet_protos);
}
# Insert into nodes array in case there are wires entries.
......@@ -973,15 +929,9 @@ while (($node1,$card1,$port1,$node2,$card2,$port2) =
}
push @types, "$basetype-$bw";
if ($do_xml) {
print_simple_link($node1, $iface1,
$node2, $iface2,
$bw, 0, 0, @types);
} else {
print "link link-$node1:$iface1-$node2:$iface2" .
" $node1:$node1/$iface1" .
" $node2:$iface2 $bw 0 0 1 " . join(" ",@types) . "\n";
}
print_simple_link($node1, $iface1,
$node2, $iface2,
$bw, 0, 0, @types);
}
}
}
......@@ -1057,14 +1007,10 @@ foreach $interconnect (keys(%interconnects)) {
# This is really dumb - BigInts like to print out with a leading '+',
# which we don't want. Stript it off.
$speed =~ s/^\+|-//;
if ($do_xml) {
print_named_link("link-$interconnect",
$src, "(null)",
$dst, "(null)",
$speed, 0, 0, "ethernet");
} else {
print "link link-$interconnect $src $dst $speed 0 0 1 ethernet\n";
}
print_named_link("link-$interconnect",
$src, "(null)",
$dst, "(null)",
$speed, 0, 0, "ethernet");
}
#
......@@ -1072,15 +1018,9 @@ foreach $interconnect (keys(%interconnects)) {
#
my @wireless_protos = ("80211", "80211a", "80211b", "80211g", "flex900");
my $fake_switch = "airswitch";
if ($do_xml) {
if (!$genimode) {
print "<node name=\"$fake_switch\">\n";
print_node_types(map("*$_:*", @wireless_protos));
print "</node>\n\n";
}
}
else {
print "node $fake_switch ", join(" ",map("*$_:*",@wireless_protos)), "\n";
if (!$genimode) {
my @fake_switch_types = map("*$_:*", @wireless_protos);
print_node($fake_switch, \@fake_switch_types, [], []);
}
foreach my $interface (keys(%interfacetypes)) {
......@@ -1124,20 +1064,12 @@ foreach my $interface (keys(%interfacetypes)) {
$max_bw = $ifacebw;
}
}
if ($do_xml) {
print_simple_link($node, $iface,
$fake_switch, "(null)",
$max_bw, 0, 0, @intersection);
} else {
print "link link-$node:$iface-$fake_switch:(null) ".
"$node:$node/$iface $fake_switch:(null) $max_bw 0 0 1 ".
join(" ",@intersection). "\n";
}
print_simple_link($node, $iface,
$fake_switch, "(null)",
$max_bw, 0, 0, @intersection);
}
if ($do_xml) {
print "</ptop>\n";
}
print_footer();
exit(0);
......@@ -1195,6 +1127,68 @@ sub get_ifacecardport {
# Functions for printing XML
######################################################################
sub print_header {
if ($do_xml && !$genimode) {
print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print "<ptop testbed=\"@THISHOMEBASE@\" "
. "xmlns=\"http://emulab.net/resources/ptop/0.1\">\n";
} elsif ($do_xml && $genimode) {
print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print "<rspec xmlns=\"http://www.protogeni.net/resources/rspec/0.1\" ";
my @times = gmtime(time());
printf("generated=\"%04d-%02d-%02dT%02d:%02d:%02dZ\" ",
$times[5] + 1900, $times[4] + 1, $times[3],
$times[2], $times[1], $times[0]);
printf("valid_until=\"%04d-%02d-%02dT%02d:%02d:%02dZ\" ",
$times[5] + 1900, $times[4] + 1, $times[3],
$times[2], $times[1], $times[0]);
print ">\n";
}
}
sub print_footer {
if ($do_xml && !$genimode) {
print "</ptop>\n";
} elsif ($do_xml && $genimode) {
print "</rspec>\n";
}
}
# Special print function for switches.
sub print_switch
{
my $name = shift(@_);
my $uuid = shift(@_);
print_node($name, ["switch:1", "*lan:*"], [], [], $uuid);
}
sub print_node
{
my $name = shift(@_);
my $types = shift(@_);
my $features = shift(@_);
my $flags = shift(@_);
my $uuid = shift(@_);
if (!$do_xml) {
my $text = "node $name " .
join(" ", @$types) . " - " . join(" ", @$features) .
" - " . join(" ", @$flags);
print "$text\n";
} else {
print "<node name=\"$name\"";
if ($do_xml && $genimode && defined($uuid)) {
print " uuid=\"$uuid\"";
}
print ">\n";
print_node_types(@$types);
if ($do_xml && !$genimode) {
print_node_flags(@$flags);
print_node_features(@$features);
}
print "</node>\n";
}
}
# The order print_node_types(), print_node_features(),
# print_node_flags() must always be observed lest we break the schema.
sub print_node_types
......@@ -1272,20 +1266,22 @@ sub print_node_flags
}
}
# Special print function for switches.
sub print_switch
sub print_named_link_ptop
{
my $name = shift(@_);
my $uuid = shift(@_);
print "<node name=\"$name\"" .
(defined($uuid) ? " uuid=\"$uuid\"" : "") . ">\n";
print_node_types(("switch:1", "*lan:*"));
print "</node>\n\n";
my $source = shift(@_);
my $source_if = shift(@_);
my $dest = shift(@_);
my $dest_if = shift(@_);
my $bw = shift(@_);
my $delay = shift(@_);
my $loss = shift(@_);
my $proto_count = scalar(@_);
print "link $name $source:$source/$source_if "
. "$dest:$dest_if $bw $delay $loss 1 " . join(" ", @_) . "\n";
}
# Print a link with a unique name not necessarily related to source,
# dest, source_if, and dest_if.
sub print_named_link
sub print_named_link_xml
{
my $name = shift(@_);
my $source = shift(@_);
......@@ -1315,6 +1311,17 @@ sub print_named_link
print "</link>\n\n";
}
# Print a link with a unique name not necessarily related to source,
# dest, source_if, and dest_if.
sub print_named_link
{
if (!$do_xml) {
print_named_link_ptop(@_);
} elsif ($do_xml) {
print_named_link_xml(@_);
}
}
# Print a link where the name is just a recapitulation of the source
# and destination node and interface names.
sub print_simple_link
......
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