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($$)
{
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...
......
......@@ -41,7 +41,7 @@ LIB_SCRIPTS = GeniDB.pm GeniUser.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
GeniUtil.pm GeniRegistry.pm GeniUsage.pm GeniHRN.pm \
GeniSES.pm GeniResource.pm GeniXML.pm GeniAM.pm \
GeniEmulab.pm GeniFoam.pm
GeniEmulab.pm GeniFoam.pm GeniStitch.pm
SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
SCRIPTS = genischemacheck.pl
......
This diff is collapsed.
......@@ -54,6 +54,7 @@ use GeniUtil;
use GeniCM;
use GeniHRN;
use GeniXML;
use GeniStitch;
use emutil;
use English;
use Data::Dumper;
......@@ -1964,39 +1965,14 @@ sub ReserveVlanTags($)
goto done;
}
#
# Need to dig inside the stitching section to find the path.
#
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");
my $stitchpath = GeniStitch->Lookup($linkname, $rspec);
if (defined($stitchpath->error())) {
$response = $stitchpath->error();
goto done;
}
#
# Look at the hop list to find the edge point.
#
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;
if (!defined($stitchpath)) {
$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Could not find stitchpath in rspec");
}
#
......@@ -2056,15 +2032,15 @@ sub ReserveVlanTags($)
my @tags = ();
foreach my $tag (@{ $taglist }) {
push(@tags, $tag)
if ($network->VlanTagOkay($tag));
if ($stitchpath->vlan_ok($tag));
}
if (!@tags) {
#
# Return a list of okay tags.
#
my @okaytags = ();
for (my $i = $network->min_vlan();
$i < $network->max_vlan(); $i++) {
for (my $i = $stitchpath->min_vlan();
$i < $stitchpath->max_vlan(); $i++) {
push(@okaytags, $i);
}
$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
GetVirtualizationType SetVirtualizationSubtype GetVirtualizationSubtype
GetExclusive SetExclusive GetLinkManager SetText GetText Serialize
CreateDocument AddElement RemoveChild PolicyExists GetMask
GetDiskImage IsUntaggedLan IsTaggedLan);
GetDiskImage IsUntaggedLan IsTaggedLan GetHopLinkID GetCapabilitySection
GetSuggestedVlanFromHop SetVlanTagInHop);
use English;
use XML::LibXML;
......@@ -913,5 +914,63 @@ sub PolicyExists($$)
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...
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