Commit c47af348 authored by Jonathon Duerig's avatar Jonathon Duerig

Add support for stitching Emulab as a transit network.

parent 1b65c4d6
...@@ -3956,7 +3956,7 @@ sub VlanTagOkay($$) ...@@ -3956,7 +3956,7 @@ sub VlanTagOkay($$)
{ {
my ($self, $tag) = @_; my ($self, $tag) = @_;
return ($tag >= $self->min_vlan() && $tag < $self->max_vlan() ? 1 : 0); return ($tag >= $self->min_vlan() && $tag <= $self->max_vlan() ? 1 : 0);
} }
# _Always_ make sure that this 1 is at the end of the file... # _Always_ make sure that this 1 is at the end of the file...
......
...@@ -41,7 +41,7 @@ LIB_SCRIPTS = GeniDB.pm GeniUser.pm \ ...@@ -41,7 +41,7 @@ LIB_SCRIPTS = GeniDB.pm GeniUser.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \ GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
GeniUtil.pm GeniRegistry.pm GeniUsage.pm GeniHRN.pm \ GeniUtil.pm GeniRegistry.pm GeniUsage.pm GeniHRN.pm \
GeniSES.pm GeniResource.pm GeniXML.pm GeniAM.pm \ GeniSES.pm GeniResource.pm GeniXML.pm GeniAM.pm \
GeniEmulab.pm GeniFoam.pm GeniEmulab.pm GeniFoam.pm GeniStitch.pm
SBIN_SCRIPTS = plabnodewrapper plabslicewrapper SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
SCRIPTS = genischemacheck.pl SCRIPTS = genischemacheck.pl
......
This diff is collapsed.
...@@ -54,6 +54,7 @@ use GeniUtil; ...@@ -54,6 +54,7 @@ use GeniUtil;
use GeniCM; use GeniCM;
use GeniHRN; use GeniHRN;
use GeniXML; use GeniXML;
use GeniStitch;
use emutil; use emutil;
use English; use English;
use Data::Dumper; use Data::Dumper;
...@@ -1964,39 +1965,14 @@ sub ReserveVlanTags($) ...@@ -1964,39 +1965,14 @@ sub ReserveVlanTags($)
goto done; goto done;
} }
# my $stitchpath = GeniStitch->Lookup($linkname, $rspec);
# Need to dig inside the stitching section to find the path. if (defined($stitchpath->error())) {
# $response = $stitchpath->error();
my $stitching_path;
foreach my $ref (GeniXML::FindNodesNS("n:stitching",
$rspec,
$GeniXML::STITCH_NS)->get_nodelist()){
foreach my $path (GeniXML::FindNodes("n:path",
$ref)->get_nodelist()) {
my $path_id = GeniXML::GetText("id", $path);
if ($path_id eq $linkname) {
$stitching_path = $path;
last;
}
}
}
if (!defined($stitching_path)) {
$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Could not find path in rspec");
goto done; goto done;
} }
if (!defined($stitchpath)) {
# $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
# Look at the hop list to find the edge point. "Could not find stitchpath in rspec");
#
my @hoplist = GeniXML::FindNodes("n:hop", $stitching_path)->get_nodelist();
my (undef, $network, undef, $edgeresponse)
= GeniCM::findStitchPoint($linkname, @hoplist);
if (defined($edgeresponse)) {
$response = $edgeresponse;
goto done;
} }
# #
...@@ -2056,15 +2032,15 @@ sub ReserveVlanTags($) ...@@ -2056,15 +2032,15 @@ sub ReserveVlanTags($)
my @tags = (); my @tags = ();
foreach my $tag (@{ $taglist }) { foreach my $tag (@{ $taglist }) {
push(@tags, $tag) push(@tags, $tag)
if ($network->VlanTagOkay($tag)); if ($stitchpath->vlan_ok($tag));
} }
if (!@tags) { if (!@tags) {
# #
# Return a list of okay tags. # Return a list of okay tags.
# #
my @okaytags = (); my @okaytags = ();
for (my $i = $network->min_vlan(); for (my $i = $stitchpath->min_vlan();
$i < $network->max_vlan(); $i++) { $i < $stitchpath->max_vlan(); $i++) {
push(@okaytags, $i); push(@okaytags, $i);
} }
$response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, $response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2013 University of Utah and the Flux Group.
#
# {{{GENIPUBLIC-LICENSE
#
# GENI Public License
#
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
#
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
#
# }}}
#
package GeniStitch;
use strict;
use Exporter;
use vars qw(@ISA);
@ISA = "Exporter";
# Must come after package declaration!
use GeniDB;
use English;
use libEmulab;
use GeniResponse;
use overload ('""' => 'Stringify');
our $TB = "@prefix@";
our $OURDOMAIN = "@OURDOMAIN@";
our %stitchpoints = ();
sub Lookup($$$)
{
my ($class, $linkname, $rspec) = @_;
my $result;
if (! exists($stitchpoints{$linkname})) {
LookupAll($class, $rspec);
}
if (exists($stitchpoints{$linkname})) {
$result = $stitchpoints{$linkname};
}
return $result;
}
sub LookupAll($$)
{
my ($class, $rspec) = @_;
my @hops = GeniXML::FindNodesNS("n:stitching", $rspec,
$GeniXML::STITCH_NS)->get_nodelist();
foreach my $ref (@hops) {
foreach my $path (GeniXML::FindNodes("n:path",
$ref)->get_nodelist()) {
my $current = CreatePath($class, $path);
$stitchpoints{$current->linkname()} = $current;
}
}
}
sub CreatePath($$)
{
my ($class, $rspec) = @_;
my $self = {};
$self->{'linkname'} = GeniXML::GetText("id", $rspec);
$self->{'rspec'} = $rspec;
my @hoplist = GeniXML::FindNodes("n:hop",
$rspec)->get_nodelist();
my %hophash = ();
foreach my $hop (@hoplist) {
my $hop_id = GeniXML::GetText("id", $hop);
$hophash{$hop_id} = $hop;
}
$self->{'hophash'} = \%hophash;
$self->{'hoplist'} = \@hoplist;
$self->{'points'} = [];
$self->{'error'} = undef;
bless ($self, $class);
$self->findStitchPoint();
return $self;
}
# accessors
sub field($$) { return ($_[0]->{$_[1]}); }
sub linkname($) { return field($_[0], 'linkname'); }
sub rspec($) { return field($_[0], 'rspec'); }
sub hophash($) { return field($_[0], 'hophash'); }
sub hoplist($) { return field($_[0], 'hoplist'); }
sub points($) { return field($_[0], 'points'); }
sub error($) { return field($_[0], 'error'); }
sub min_vlan($)
{
my ($self) = @_;
my $result = undef;
foreach my $point (@{ $self->points() }) {
my $network = $point->{'network'};
if (! defined($result) || $network->min_vlan() > $result) {
$result = $network->min_vlan();
}
}
return $result;
}
sub max_vlan($)
{
my ($self) = @_;
my $result = undef;
foreach my $point (@{ $self->points() }) {
my $network = $point->{'network'};
if (! defined($result) || $network->max_vlan() < $result) {
$result = $network->max_vlan();
}
}
return $result;
}
sub vlan_ok($$)
{
my ($self, $vlan) = @_;
my $ok = 1;
foreach my $point (@{ $self->points() }) {
my $network = $point->{'network'};
$ok = $ok && $network->VlanTagOkay($vlan);
}
return $ok;
}
sub mode($)
{
my ($self) = @_;
my $mode = "chain";
foreach my $point (@{ $self->points() }) {
my $network = $point->{'network'};
if ($network->mode() eq "tree") {
$mode = "tree";
}
}
return $mode;
}
sub suggested_vlan($)
{
my ($self) = @_;
my $result = 0;
foreach my $point (@{ $self->points() }) {
my $hop = $point->{'internal_hop'};
my $vlan = GeniXML::GetSuggestedVlanFromHop($hop);
if (defined($vlan) && ! $result) {
$result = $vlan;
}
# All the suggested vlans bordering this AM must agree.
if (defined($vlan) && $result != $vlan) {
$result = 0;
last;
}
}
return $result;
}
sub edge_iface($$)
{
my ($self, $count) = @_;
my $result = undef;
my @points = @{ $self->points() };
if (scalar(@points) > $count) {
$result = $points[$count]->{'edgeiface'};
}
return $result;
}
sub network($$)
{
my ($self, $count) = @_;
my $result = undef;
my @points = @{ $self->points() };
if (scalar(@points) > $count) {
$result = $points[$count]->{'network'};
}
return $result;
}
sub network_id($)
{
my ($self) = @_;
my @points = @{ $self->points() };
return $points[0]->{'network'}->network_id();
}
sub findStitchPoint($)
{
my ($self) = @_;
my @hoplist = @{ $self->hoplist() };
if (! @hoplist) {
my $lanname = $self->linkname();
$self->{'error'} =
GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"$lanname: No hops in the stitching path");
return;
}
$self->addStitchPoint(@hoplist);
$self->addStitchPoint(reverse(@hoplist));
}
sub addStitchPoint($@)
{
my $self = shift(@_);
my @hoplist = @_;
my ($external, $internal) = WalkHops(@hoplist);
my $lanname = $self->linkname();
if (!defined($external) || !defined($internal)) {
$self->{'error'} =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$lanname: no edge hop");
return;
}
my $internalurn = GeniXML::GetHopLinkID($internal);
if (!defined($internalurn)) {
$self->{'error'} =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$lanname: missing urn on path");
return;
}
foreach my $point ($self->points()) {
if (GeniXML::GetHopLinkID($point->{'internal'} eq $internalurn)) {
# If there is just one stitch point, this may be a duplicate
return;
}
}
#
# Look inside the external hop urn; it tells the local iface/node
# which corresponds to our "fake" nodes.
#
my $edgeurn = GeniXML::GetHopLinkID($external);
my $edgewire = Interface::Wire->Lookup($edgeurn);
my $network;
my $edgenodeid;
my $edgecard;
my $edgeport;
#
# The external network may contain the edge URN directly.
#
$network = ExternalNetwork->Lookup($edgeurn);
if (defined($network)) {
$edgenodeid = $network->node_id();
my @networkIfs = ();
Interface->LookupAll($edgenodeid, \@networkIfs);
if (scalar(@networkIfs) == 1) {
$edgecard = $networkIfs[0]->card();
$edgeport = $networkIfs[0]->port();
} else {
$self->{'error'} =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Internal Error. Ambiguous stitchpoint ".
"for external_interface " . $edgeurn);
return;
}
}
#
# The external network may be attached to node_id1
#
if (! defined($network) && defined($edgewire)) {
$edgenodeid = $edgewire->node_id1();
$edgecard = $edgewire->card1();
$edgeport = $edgewire->port1();
$network = ExternalNetwork->Lookup($edgenodeid);
}
# The external network may be attached to node_id2
if (! defined($network)) {
$edgenodeid = $edgewire->node_id2();
$edgecard = $edgewire->card2();
$edgeport = $edgewire->port2();
$network = ExternalNetwork->Lookup($edgenodeid);
}
if (!defined($network)) {
$self->{'error'} =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$lanname: unknown network for ".
"external_interface " . $edgeurn);
return;
}
#
# The edge interface must exist.
#
my $edgeiface = Interface->Lookup($edgenodeid, $edgecard,
$edgeport);
if (!defined($edgeiface)) {
$self->{'error'} =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$lanname: unknown iface for ".
"$edgenodeid:$edgecard.$edgeport");
return;
}
my $stitch = {};
$stitch->{'internal_hop'} = $internal;
$stitch->{'external_hop'} = $external;
$stitch->{'network'} = $network;
$stitch->{'edgeiface'} = $edgeiface;
push(@{ $self->{'points'} }, $stitch);
}
sub WalkHops(@)
{
my @hoplist = @_;
my $external;
my $internal;
my $lasthop;
my $is_inside;
#
# Go through the hop list to find the edge point. This will be
# either the first hop not in our domain or the first hop inside
# of our domain
#
foreach my $hop (@hoplist) {
my $hopurn = GeniXML::GetHopLinkID($hop);
next
if (! GeniHRN::IsValid($hopurn));
my ($auth,undef,undef) = GeniHRN::Parse($hopurn);
next
if (!defined($auth));
if (! defined($is_inside) && $auth ne $OURDOMAIN) {
$is_inside = 0;
} elsif (! defined($is_inside) && $auth eq $OURDOMAIN) {
$is_inside = 1;
} elsif ($is_inside && $auth ne $OURDOMAIN) {
$external = $hop;
$internal = $lasthop;
last;
} elsif (! $is_inside && $auth eq $OURDOMAIN) {
$external = $lasthop;
$internal = $hop;
last;
}
$lasthop = $hop;
}
return ($external, $internal);
}
1;
...@@ -42,7 +42,8 @@ GetManagerId GetColocate GetSubnodeOf GetStartupCommand GetTarball ...@@ -42,7 +42,8 @@ GetManagerId GetColocate GetSubnodeOf GetStartupCommand GetTarball
GetVirtualizationType SetVirtualizationSubtype GetVirtualizationSubtype GetVirtualizationType SetVirtualizationSubtype GetVirtualizationSubtype
GetExclusive SetExclusive GetLinkManager SetText GetText Serialize GetExclusive SetExclusive GetLinkManager SetText GetText Serialize
CreateDocument AddElement RemoveChild PolicyExists GetMask CreateDocument AddElement RemoveChild PolicyExists GetMask
GetDiskImage IsUntaggedLan IsTaggedLan); GetDiskImage IsUntaggedLan IsTaggedLan GetHopLinkID GetCapabilitySection
GetSuggestedVlanFromHop SetVlanTagInHop);
use English; use English;
use XML::LibXML; use XML::LibXML;
...@@ -913,5 +914,63 @@ sub PolicyExists($$) ...@@ -913,5 +914,63 @@ sub PolicyExists($$)
return $exists; return $exists;
} }
sub GetHopLinkID($)
{
my ($ref) = @_;
my $result = "";
my $link = FindFirst("n:link", $ref);
if (defined($link)) {
$result = GetText("id", $link);
}
return $result;
}
sub GetHopCapabilitySection($)
{
my ($hopref) = @_;
#
# Dig out the section we need from the hop.
#
my $tmp = FindFirst("n:link", $hopref);
$tmp = (FindFirst("n:switchingCapabilityDescriptor", $tmp) ||
FindFirst("n:switchingCapabilityDescriptors", $tmp))
if (defined($tmp));
$tmp = FindFirst("n:switchingCapabilitySpecificInfo", $tmp)
if (defined($tmp));
if (defined($tmp) &&
FindFirst("n:switchingCapabilitySpecificInfo_L2sc", $tmp)) {
$tmp = FindFirst("n:switchingCapabilitySpecificInfo_L2sc", $tmp)
}
return $tmp;
}
sub GetSuggestedVlanFromHop($)
{
my ($hopref) = @_;
my $capref = GetHopCapabilitySection($hopref);
return undef
if (!defined($capref));
my $tag = GeniXML::GetText("suggestedVLANRange", $capref);
$tag = undef
if (defined($tag) && ! looks_like_number($tag));
return $tag;
}
sub SetVlanTagInHop($$)
{
my ($hopref, $tag) = @_;
my $capref = GetHopCapabilitySection($hopref);
return undef
if (!defined($capref));
GeniXML::SetText("vlanRangeAvailability", $capref, "$tag");
GeniXML::SetText("suggestedVLANRange", $capref, "$tag");
return 0;
}
# _Always_ make sure that this 1 is at the end of the file... # _Always_ make sure that this 1 is at the end of the file...
1; 1;
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