Commit f77a3169 authored by Leigh Stoller's avatar Leigh Stoller

Promote test to stable.

parent 0a814e9f
......@@ -21,7 +21,7 @@
#
# }}}
#
package libvtop_stable;
package libvtop_test;
use strict;
use Exporter;
......@@ -134,11 +134,15 @@ sub Create($$$$)
# Mostly for update mode.
$self->{'FIXEDNODES'} = {};
$self->{'CURRENT_V2P'} = {};
$self->{'CURRENT_V2P'} = {};
$self->{'CURRENT_P2V'} = {};
$self->{'CURRENT_V2V'} = {};
$self->{'OLDRSRVCLEAN_FLAG'} = 0;
$self->{'OLDRSRVCLEAN_NODES'} = {};
# This is just for lannodes.
$self->{'CURRENT_V2PMAP'} = {};
# Below is for interpretation of assign results.
$self->{'PNODES'} = {};
$self->{'SOLUTION'} = {};
......@@ -179,6 +183,7 @@ sub results($) { return $_[0]->{'RESULTS'}; }
sub current_v2p($) { return $_[0]->{'CURRENT_V2P'}; }
sub current_p2v($) { return $_[0]->{'CURRENT_P2V'}; }
sub current_v2v($) { return $_[0]->{'CURRENT_V2V'}; }
sub current_v2pmap($) { return $_[0]->{'CURRENT_V2PMAP'}; }
sub pnodes($) { return $_[0]->{'PNODES'}; }
sub fixednodes($) { return $_[0]->{'FIXEDNODES'}; }
sub newreserved($) { return $_[0]->{'NEWRESERVED'}; }
......@@ -201,6 +206,7 @@ sub virt_lan_lans($) { return $_[0]->virt_table("virt_lan_lans"); }
sub virt_paths($) { return $_[0]->virt_table("virt_paths"); }
sub virt_bridges($) { return $_[0]->virt_table("virt_bridges"); }
sub virt_desires($) { return $_[0]->virt_table("virt_node_desires"); }
sub virt_attributes($) { return $_[0]->virt_table("virt_node_attributes"); }
sub virt_startloc($) { return $_[0]->virt_table("virt_node_startloc"); }
sub virt_trafgens($) { return $_[0]->virt_table("virt_trafgens"); }
sub virt_lan_settings($){ return $_[0]->virt_table("virt_lan_settings"); }
......@@ -220,6 +226,7 @@ sub verbose($) { return $_[0]->flags() & $VTOP_FLAGS_VERBOSE; }
sub quiet($) { return $_[0]->flags() & $VTOP_FLAGS_QUIET; }
sub updating($) { return $_[0]->flags() & $VTOP_FLAGS_UPDATE; }
sub fixcurrent($) { return $_[0]->flags() & $VTOP_FLAGS_FIXNODES; }
sub fixlanodes($) { return $_[0]->flags() & $VTOP_FLAGS_FIXLANNODES; }
sub impotent($) { return $_[0]->flags() & $VTOP_FLAGS_IMPOTENT; }
sub alloconly($) { return $_[0]->flags() & $VTOP_FLAGS_ALLOCONLY; }
sub regression($) { return $_[0]->flags() & $VTOP_FLAGS_REGRESSION; }
......@@ -764,7 +771,7 @@ sub doesimplement($$)
#############################################################################
# Back to the main package.
#
package libvtop_stable;
package libvtop_test;
#
# Load some physical info (for types, interfaces, speeds).
......@@ -936,6 +943,7 @@ sub interfacespeedmbps($$$)
sub LoadCurrentResources($)
{
my ($self) = @_;
my $exptidx = $self->exptidx();
$self->counters()->{'reserved_simcount'} = 0;
$self->counters()->{'reserved_virtcount'} = 0;
......@@ -1053,6 +1061,20 @@ sub LoadCurrentResources($)
}
}
}
#
# Grab the v2pmap table so we can find out where lan nodes were
# assigned last time.
#
my $query_result =
DBQueryWarn("select vname,node_id from v2pmap where exptidx='$exptidx'");
return -1
if (!$query_result);
while (my ($vname,$nodeid) = $query_result->fetchrow_array()) {
$self->printdb("current v2p: $nodeid -> $vname\n");
$self->current_v2pmap()->{$vname} = $nodeid;
}
return 0;
}
......@@ -1071,6 +1093,7 @@ sub LoadVirtNodes($)
my $vnode = libvtop::virt_node->Create($self, $virt_node);
my $vname = $vnode->vname();
my $desires = {};
my $attrs = {};
my $startloc = undef;
# Other fields we need.
......@@ -1359,6 +1382,58 @@ sub LoadVirtNodes($)
}
$vnode->_desires($desires);
#
# Add in attributes.
#
foreach my $attr ($self->virt_attributes()->Rows()) {
next
if ($attr->vname() ne $vname);
$attrs->{$attr->attrkey()} = $attr->attrvalue();
if ($attr->attrkey() eq "XEN_MEMSIZE" ||
$attr->attrkey() eq "MEMORYSIZE") {
$vnode->_desires()->{"?+ram"} = $attr->attrvalue();
}
}
$vnode->_atttributes($attrs);
#
# Need to set a default. But this needs to be seen on
# the client too, via virt_node_attributes.
#
# We need a way to associate these defaults with the virtualization
# type, but that is a function of the image. Needs more thought.
#
if ($isvirt && $vnode->type() ne "blockstore") {
my $defmem = 128;
my $maxmem = 128;
if (defined($vnode->_parent_osinfo())
&& $vnode->_parent_osinfo()->osname() =~ /xen/i) {
$defmem = 256;
$maxmem = 512;
}
if (!exists($vnode->_desires()->{"?+ram"})) {
$self->printdb("Setting VM memsize to $defmem for $vname\n");
$vnode->_desires()->{"?+ram"} = $defmem;
}
else {
#
# If the user wants a shared node, they are not allowed to
# ask for more then the max, unless its an admin.
#
if ($vnode->_desires()->{"?+ram"} > $maxmem &&
$vnode->_sharedokay() &&
!$self->user()->IsAdmin()) {
tberror("You asked for too much memory on $vnode\n");
return -1;
}
}
$self->experiment()->SetVirtNodeAttribute($vname, "VM_MEMSIZE",
$vnode->_desires()->{"?+ram"});
}
#
# And the startloc, but doubt this is used anymore.
#
......@@ -1480,6 +1555,13 @@ sub LoadVirtNodes($)
return -1;
}
# XXX: If the virt blockstore object isn't fixed to a
# blockstore pseudo-VM, then abort the bookkeeping and mapping
# for it. This means we are dealing with local node storage
# via a features and desires hack.
next
if $fixnode->type() ne "blockstore";
#
# We need a place to hang the attributes, but they are split
# between the blockstore and the blockstore_attributes. Another
......@@ -1499,9 +1581,14 @@ sub LoadVirtNodes($)
my $vname = $virt_bs_attr->vname();
my $attrkey = $virt_bs_attr->attrkey();
my $attrval = $virt_bs_attr->attrvalue();
my $isdesire = $virt_bs_attr->isdesire();
# Skip any blockstores that don't have a corresponding entry in the
# 'blockstores' libvtop hash. Also skip any attributes that are not
# marked as a desire.
next
if (! exists($self->blockstores()->{$vname}));
if (! exists($self->blockstores()->{$vname}) ||
! $isdesire);
my $fixnode = $self->blockstores()->{$vname};
$fixnode->_blockstore_attributes()->{$attrkey} = $attrval;
......@@ -1614,6 +1701,7 @@ sub LoadVirtLans($)
$virtlan->_implemented_by($implemented_by);
$virtlan->_vpath(undef);
$virtlan->_bridged(0);
$virtlan->_wiretype("ethernet");
if (defined($encap) &&
($encap eq "vtun" || $encap eq "gre" || $encap eq "egre")) {
......@@ -1729,6 +1817,20 @@ sub LoadVirtLans($)
}
}
#
# Look for lans with reserved tags in the highvlan range. Ick.
# Luckily, only at Utah.
#
if ($MAINSITE) {
foreach my $virtlan (values(%{ $self->vlans() })) {
my $tag = VLan::GetReservedVlanTag($self->experiment(),
$virtlan->vname());
if (defined($tag) && $tag > 1000) {
$virtlan->_wiretype("ethernet-highvlan");
}
}
}
#
# Sanity check the shared lan requests.
#
......@@ -1770,9 +1872,10 @@ sub LoadVirtLans($)
#
# Add a desire to all of the nodes.
#
foreach my $member ($virtlan->memberlist()) {
$member->virt_node()->_desires()->{"highvlan"} = "1.0";
}
#foreach my $member ($virtlan->memberlist()) {
# $member->virt_node()->_desires()->{"highvlan"} = "1.0";
#}
$virtlan->_wiretype("ethernet-highvlan");
}
}
# Convert to actual object for later
......@@ -2239,6 +2342,26 @@ sub GenFixNodes($)
$self->createFixedNode($vname, $fixed);
}
}
if ($self->fixlanodes()) {
#
# Add lan node fixnodes.
#
foreach my $lannode (sort(keys(%{ $self->lannodes() }))) {
next
if (!exists($self->current_v2pmap()->{$lannode}));
$self->createFixedNode($lannode,
$self->current_v2pmap()->{$lannode});
}
foreach my $delaynode (sort(keys(%{ $self->delaynodes() }))) {
next
if (exists($self->fixednodes()->{$delaynode}) ||
! exists($self->current_v2pmap()->{$delaynode}));
$self->createFixedNode($delaynode,
$self->current_v2pmap()->{$delaynode});
}
}
return 0;
}
......@@ -2570,9 +2693,7 @@ sub GenVirtLans($)
# for all vlinks on a physical link to use the same style!
# But we don't want to go there right now, so for simplicity,
# we require that the user specify identical values for all
# members of a virt_lan. For now, we do this by ignoring per-link
# settings ($encap) and using only the global setting ($encapstyle)
# except for backward compat (see next paragraph).
# members of a virt_lan.
#
# XXX this is made hideous by having both global and per-link
# encapsulation values that were previously used for two
......@@ -2629,11 +2750,9 @@ sub GenVirtLans($)
# some pseudo-device on which to hang a route table ID; i.e:
# we cannot just do IP aliasing.
#
#
# Encapsulation can be specified per link. The default link
# encapsulation can also be specified by a per-experiment
# setting. At the moment, only the latter (global) is
# implemented.
# setting.
#
my $globalencap = $experiment->encap_style();
......@@ -2650,12 +2769,6 @@ sub GenVirtLans($)
$errors++;
next;
}
if ($linkencap ne "default" && $linkencap ne $globalencap) {
tbwarn("$vname: per-link encapsulation type not supported\n");
$errors++;
next;
}
if ($virtnodes) {
#
# At the present time, links with virtnodes require that we
......@@ -2670,7 +2783,11 @@ sub GenVirtLans($)
# resource, and most VM implementations should support them in
# some manner (eg: openvz veth device).
#
if ($globalencap eq "default") {
if ($linkencap ne "default") {
# Non default link encap overrides global encap.
$encapval = $linkencap;
}
elsif ($globalencap eq "default") {
$encapval = "veth-ne";
}
else {
......@@ -2683,19 +2800,27 @@ sub GenVirtLans($)
# be multiplexed (emulated). This allows the experimentor to
# have more links then just the number of physical interfaces.
# Encapsulation without multiplexing is okay, although useful
# mostly for testing purposes. If the link is emulated but not
# mostly for testing purposes. If the link is multiplexed but not
# encapsulated, an encapsulation method must be chosen. We
# prefer vlan these days cause it runs everywhere. Might want
# to look at the nodesdo info at some point.
#
if ($emulated) {
if ($globalencap eq "default") {
if ($linkencap ne "default") {
# Non default link encap overrides global encap.
$encapval = $linkencap;
}
elsif ($globalencap eq "default") {
$encapval = "vlan";
}
else {
$encapval = $globalencap;
}
}
elsif ($linkencap ne "default") {
# Non default link encap overrides global encap.
$encapval = $linkencap;
}
elsif ($globalencap ne "default") {
$encapval = $globalencap;
}
......@@ -2880,16 +3005,29 @@ sub GenVirtLans($)
my $lannode = "portlan/$vname";
# Lan node for assign.
$self->createNode($lannode, $mycmurn, "lan", '1', '',
$self->createNode($lannode, $mycmurn, "lan", '1',
{ 'real-switch' => ['' , "1.0"] },
{ 'virtualization_type' => 'raw' });
# So we ignore it when it comes back from assign.
$self->lannodes()->{$lannode} = 1;
my $others = {};
my $bw = '*';
#
# We do not do link delays, but we do want to multiplex
# these links. For now, use usevirtiface() as an indicator.
#
if ($vlan->usevirtiface()) {
$others->{'emulated'} = 1;
# assign seems to require this, but it seems wrong.
$others->{'trivial_ok'} = 1;
$bw = 1000;
}
foreach my $member (@members) {
my $virtnode = $member->virt_node();
my $vnodevname = $virtnode->vname();
my $others = {};
my $plink = "portlan/$vname/$member";
$self->createLink($vname, $plink,
......@@ -2897,7 +3035,7 @@ sub GenVirtLans($)
{'virtual_node_id' => $vnodevname,
'virtual_interface_id' =>"$member" },
{'virtual_node_id' => $lannode },
'*', $protocol, $others);
$bw, $vlan->_wiretype(), $others);
}
}
elsif (@members == 2 && !$vlan->_bridged()) {
......@@ -3005,7 +3143,7 @@ sub GenVirtLans($)
# check is only made for links comprised of physical nodes,
# since if the OS supports virtual nodes, it supports linkdelays.
#
if ($shaped && $virtnodes == 0 &&
if ($shaped && $virtnodes != scalar(@members) &&
$self->virtlan_use_linkdelay($vlan, $shaped)) {
#
# The user had to specify the OS.
......@@ -3023,6 +3161,11 @@ sub GenVirtLans($)
#
foreach my $virtnode ($virtnode0, $virtnode1) {
my $osinfo = $virtnode->_osinfo();
# Always supports.
# XXX Ignore for GEC16
next
if (1 || $virtnode->_isvirtnode());
if (! $osdoeslinkdelays{$osinfo->osid()}) {
my $osname = $osinfo->osname();
......@@ -3101,7 +3244,8 @@ sub GenVirtLans($)
{'virtual_node_id' => $vname1,
'virtual_interface_id' => "$member1" },
($top_bw == 0 ? "*" :
max($top_bw, $top_rbw)), $protocol,
max($top_bw, $top_rbw)),
$vlan->_wiretype(),
$others);
}
my @delayinfo = ($delay,$bw,$backfill,$loss,
......@@ -3141,7 +3285,7 @@ sub GenVirtLans($)
{'virtual_node_id' => $delayname,
'virtual_interface_id' => "$member1" },
($top_bw == 0 ? "*" : $top_bw),
$protocol, $others);
$vlan->_wiretype(), $others);
$self->createLink($vname,
"linksdelaydst/$vname/$member1,$member0",
......@@ -3151,7 +3295,7 @@ sub GenVirtLans($)
{'virtual_node_id' => $delayname,
'virtual_interface_id' =>"$member0" },
($top_bw == 0 ? "*" : $top_bw),
$protocol, $others);
$vlan->_wiretype(), $others);
$self->printdb("Delay node $plink ($delayname) = " .
join(" ", @delayinfo) . "\n");
......@@ -3241,7 +3385,7 @@ sub GenVirtLans($)
'virtual_interface_id' =>"$member0" },
{'virtual_node_id' => $vname1,
'virtual_interface_id' =>"$member1" },
$bw, $protocol, $others);
$bw, $vlan->_wiretype(), $others);
}
}
}
......@@ -3281,7 +3425,7 @@ sub GenVirtLans($)
my ($delay,$bw,$ebw,$backfill,$loss,
$rdelay,$rbw,$rebw,$rbackfill,$rloss) =
@{$member->_delayinfo()};
# Need to know about tracing on a per queue basis, since the
# user can specify tracing asymmetrically.
my ($traced,$trace_endnode) = @{$member->_traceinfo()};
......@@ -3322,7 +3466,7 @@ sub GenVirtLans($)
# nodes, since if the OS supports virtual nodes, it
# supports linkdelays.
#
if ($shaped && $virtnodes == 0 &&
if ($shaped && $virtnodes != scalar(@members) &&
$self->virtlan_use_linkdelay($vlan, $shaped)) {
#
# The user had to specify the OS.
......@@ -3333,7 +3477,7 @@ sub GenVirtLans($)
"(endnode traffic shaping)\n");
$errors++;
}
else {
elsif (!$virtnode->_isvirtnode()) {
#
# All the OSes have to support linkdelays.
#
......@@ -3401,7 +3545,7 @@ sub GenVirtLans($)
{'virtual_node_id' => "$lannode" },
$top_bw == 0 ? "*" :
max($top_bw,$top_rbw),
$protocol, $others);
$vlan->_wiretype(), $others);
$self->printdb("Delay link $plink = " .
join(" ", @delayinfo) . "\n");
......@@ -3436,7 +3580,7 @@ sub GenVirtLans($)
{'virtual_node_id' => $delayname,
'virtual_interface_id' =>"$member" },
$top_bw == 0 ? "*" : $top_bw,
$protocol, $others);
$vlan->_wiretype(), $others);
$self->createLink($vname,
"linkdelaydst/$vname/$member",
......@@ -3446,7 +3590,7 @@ sub GenVirtLans($)
{'virtual_node_id' => $delayname,
'virtual_interface_id' =>"$member" },
$top_bw == 0 ? "*" : $top_bw,
$protocol, {});
$vlan->_wiretype(), {});
$self->printdb("Delay node $plink ($delayname) = " .
join(" ", @delayinfo) . "\n");
......@@ -3487,6 +3631,9 @@ sub GenVirtLans($)
if (defined($virtnode->_fixedvm())) {
$vnodevname = $virtnode->_fixedvm()->vname();
}
elsif (defined($virtnode->_sanhostname())) {
$vnodevname = $virtnode->_sanhostname();
}
#
# We store this info in case assign actually does
......@@ -3510,7 +3657,7 @@ sub GenVirtLans($)
'virtual_interface_id' =>"$member" },
{'virtual_node_id' => $lannode },
($top_bw == 0 ? "*" : $top_bw),
$protocol, $others);
$vlan->_wiretype(), $others);
}
}
}
......@@ -3918,12 +4065,12 @@ sub requires_delay($$$$)
# A target bandwidth of zero indicates that we want assign to choose.
# Therefore, no delay is needed since assign picks the native bw.
#
return 0
goto norequire
if ($targetbw == 0);
if (!exists($linkbws->{$node_type}{$protocol})) {
warn("requires_delay(): $virtnode - invalid type $node_type!\n");
return 0;
goto norequire;
}
if (! $virtnode->_isvtyped()) {
......@@ -3931,21 +4078,26 @@ sub requires_delay($$$$)
if (!exists($linkbws->{$node_class}{$protocol})) {
warn("requires_delay(): $virtnode - invalid class $node_class!\n");
return 0;
goto norequire;
}
}
foreach my $bw (keys(%{ $linkbws->{$node_type}{$protocol} })) {
return 0
goto norequire
if ($targetbw == $bw);
}
if (defined($node_class)) {
foreach my $bw (keys(%{ $linkbws->{$node_class}{$protocol} })) {
return 0
goto norequire
if ($targetbw == $bw);
}
}
$self->printdb("requires_delay:1 $virtnode, $virtlan, $targetbw\n");
return 1;
norequire:
$self->printdb("requires_delay:0 $virtnode, $virtlan, $targetbw\n");
return 0;
}
#
......@@ -4121,9 +4273,13 @@ sub AddNodeToSolution($$$)
{
my ($self, $virtual, $physical) = @_;
# Skip LAN/Fake nodes.
return 0
if (exists($self->lannodes()->{$virtual}));
#
# We generally ignore lannodes, but lets remember the mapping.
#
if (exists($self->lannodes()->{$virtual})) {
$self->lannodes()->{$virtual} = $physical;
return 0;
}
#
# XXX Must distinguish between local and ProtoGeni resources
......@@ -4283,7 +4439,9 @@ sub AddLinkToSolution($$$$$$$$;$)
$self->printdb(" $vlink ".
(defined($nodeA) ? "A:$nodeA:$portA " : "") .
(defined($nodeB) ? "B:$nodeB:$portB " : "") .
($direct ? " (direct)" : "") . "\n");
($direct ? " (direct)" : "") .
(defined($switchpath) ? " $switchpath" : "") .
"\n");
}
else {
$self->printdb(" $vlink trivial\n");
......@@ -4455,10 +4613,13 @@ sub ReadRspecSolution($$)
my $node_urn = GeniXML::GetNodeId($ref);
my $virtual = GeniXML::GetVirtualId($ref);
# Skip LAN/Fake nodes.
return 0
if (exists($self->lannodes()->{$virtual}));
#
# We generally ignore lannodes, but lets remember the mapping.
#
if (exists($self->lannodes()->{$virtual})) {
$self->lannodes()->{$virtual} = $node_urn;
return 0;
}
$self->AddNodeToSolution($virtual, $node_urn);
$ifacemap{$virtual} = {};
......@@ -4721,6 +4882,16 @@ sub InterpNodes($)
}
}
}
# Check nodes for shared members that require special address
# treatment. Perform address substitution and reservation
# on attached lans / lan members. Have to do this before InterpLinks
# because node allocation results in the creation of 'vinterfaces'
# entries prior to InterpLinks.
$self->CheckIPAddressReservations() == 0
or return -1;
return 0;
}
#
......@@ -5184,8 +5355,7 @@ sub AllocNodes($)
}
#
# Upload the v2pmap table. The only place I know that cares about
# this table is dohosts() in tmcd.c
# Upload the v2pmap table.
#
foreach my $vnodename (keys(%{ $self->solution_v2p() })) {
#
......@@ -5203,7 +5373,16 @@ sub AllocNodes($)
" vname='$vnodename', node_id='$pnodename'")
or return -1 if (!($self->impotent() || $self->alloconly()));
}
foreach my $vnodename (keys(%{ $self->lannodes() })) {
my $pnodename = $self->lannodes()->{$vnodename};
$self->printdb("v2pmap (lannode): $vnodename $pnodename\n");
DBQueryWarn("insert into v2pmap set ".
" pid='$pid', eid='$eid', exptidx='$idx', ".
" vname='$vnodename', node_id='$pnodename'")
or return -1 if (!($self->impotent() || $self->alloconly()));
}
return 0;
}
......@@ -5670,7 +5849,7 @@ sub InterpLinksAux($)
else {
$self->printdb("plink $plink\n");
}
$self->printdb(" path - $pathA\n")
$self->printdb(" pathA - $pathA\n")
if (defined($pathA));
# There is always a member0.
......@@ -5802,6 +5981,7 @@ sub InterpLinksAux($)
}
$protolanlan->AddMember($nodeD, $portD);
if (defined($pathB)) {
$self->printdb(" pathB - $pathB\n");
my $path = $protolanlan->GetAttribute("switchpath");
$protolanlan->SetAttribute("switchpath",
AddToSwitchPath($path, $pathB));
......@@ -6336,7 +6516,7 @@ sub InterpLinksAux($)
# If the "lannode" is placed on a node, and that node is
# different than the current node, we have to connect the
# two in the vlan. Typically, the lannode is placed on a
# switch, and this is not an issue. Rob understands this!
# switch, and this is not an issue.
#
if (!$virtnodeA->_onsharednode() &&
! ($member0->_lannode() ne "null" &&
......@@ -7085,7 +7265,10 @@ sub NewVirtIface($$$$;$)
if (!defined($virtiface)) {
return undef;
}
$self->printdb("$virtiface: $member, isvdev:$isvdev, isveth:$isveth\n");
$self->printdb("$virtiface: $member, ".
"isvdev:$isvdev, isveth:$isveth" .
(defined($pport) ? ", pport:$pport" : "") . "\n");
my $newid = $virtiface->unit();
# Record this vinterface mapping.
......@@ -7117,7 +7300,7 @@ sub NewVirtIface($$$$;$)
}
#
# XXX hackery that only Rob and Leigh understand.
# This is to assist with patching up virts. See AddVirtPatch().
# A LAN of vnodes split across multiple physical machines may
# not have the correct physical LAN info coming out of assign
# and may need to be patched up later.
......@@ -7128,7 +7311,7 @@ sub NewVirtIface($$$$;$)
$self->solution_vethmap()->{$lan}->{$pnodename} = []
if (!exists($self->solution_vethmap()->{$lan}->{$pnodename}));
push(@{ $self->solution_vethmap()->{$lan}->{$pnodename} }, $newid);
push(@{ $self->solution_vethmap()->{$lan}->{$pnodename} }, $virtiface);
}
return $virtiface;
}
......@@ -7643,6 +7826,143 @@ sub SetUpTracing($$$$$)
return 0;
}
#
# Look for shared entities that require special IP address treatment.
# This usually means getting a new mutually exclusive address range,
# reserving it for this experiment in the database. Substitute
# addresses on co-located link/lan members to accomodate. This
# reservation purposely does _NOT_ persist across swapins.
#
sub CheckIPAddressReservations($) {
my ($self) = @_;
# For stashing lans we need to take a closer look at.
my @sharedlans = ();
$self->printdb("Checking IP Address Reservations.\n");
# Round 1, peel off lans that contain members that need special
# address treatment. These lans could probably be marked when
# such a node is added to them, but doing it here keeps this
# procedure self-contained.
virtlans:
foreach my $virtlan (values(%{ $self->vlans() })) {
next
if ($virtlan->_layer() != 2); # foo from the beyond.
foreach my $member ($virtlan->memberlist()) {
my $vnodename = $member->vnode();
my $virtnode = $member->virt_node();
my $vtype = $virtnode->type();
# XXX: This isn't quite right. Need to figure out how to
# check to see if the current lan member is attached to a
# 'sanhost', but I can't figure out the right path through
# the libvtop objects...
if ($vtype eq "blockstore") {
push @sharedlans, $virtlan;
next virtlans;
}
}
}
# Round 2: re-assign addresses using the IP buddy allocator, via
# its testbed wrapper. Note that this amends the addresses assigned
# in the virt_lans table as well.
if (@sharedlans) {
$self->printdb("Modifying address allocations for: ".
join(", ", map { $_->vname() } @sharedlans) .
"\n");
require Socket;
# Don't pull this module in until now to avoid unnecessary
# dependencies. If we find ourselves using it in other places,
# then move this up to package scope.
require IPBuddyWrapper;
# Tie this buddy allocator to the "storage_pool" global address range.
my $buddy = IPBuddyWrapper->new("storage_pool");
return -1
unless defined($buddy);
# Grab the reserved addresses buddy allocator lock.
$buddy->lock()
or return -1;
# Now preload the reservations in the DB, including those associated
# with this experiment. The buddy allocator will allocate around
# these.
$buddy->loadReservedRanges($self->experiment()) == 0
or return -1;
foreach my $virtlan (@sharedlans) {