All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

Commit dae29101 authored by Leigh B Stoller's avatar Leigh B Stoller

So this commit allows a vlan to be "shared" bewteen experiments. By

shared, I mean that an experiment can request that a port be put into
a vlan belonging to another experiment. This started out as a hack to
support openflow enabled vlans in Geni, but then I got a request to
make it a little more general purpose. You all know how that goes.

Okay, say you have an experiment E1 in some project and that
experiment has a link or lan call "lan0". You want other experiments
to be able to stick ports in that vlan. On boss, you would do this
after E1 is swapped in:

boss> wap sharevlan -o testbed,E1 lan0 mysharedlan

The -o option says to make the vlan open to anyone; without that
option, only admins can swap in an experiment that requests a port in
lan0.  The token "mysharedlan" is just a level of indirection for the
NS file (or rspec).

Next you create a new experiment E2, and in your NS file:

	$ns make-portinvlan $n1 "mysharedlan"

which says to create a lan with a interface on node n1, in the vlan
named by the token mysharedlan. The token keeps specific pid/eids out
of the NS file. 

When E2 is swapped in, assign does its thing, and the selected port is
added to the members list for lan0 in testbed,E1 and then we call
snmpit with the syncvlansfromtables (-X) option to get the port added.

When E2 is swapped out, we undo the members list and call snmpit with
the -X option again.

The access issue is a bit of hack of course (open or admins) but I did
not want to invent a new permission mechanism (yet).

And of course, this is still a work in progress.
parent 42c7cf90
......@@ -5079,5 +5079,158 @@ sub MarkNodesForUpdate($)
return 0;
}
#
# Look for a lan with ports in another lan. These are currently labled
# with the incredibly obtuse "portlan" type instead of vlan. If one of
# these exist, then we have to call snmpit on the experiment that holds
# the target vlan so it can update its ports.
#
sub SyncPortLans($)
{
my ($self) = @_;
require Lan;
my @lans;
if (Lan->ExperimentLans($self, \@lans) != 0) {
tberror("Could not get list of all lans for $self\n");
return -1;
}
my %portlans = ();
foreach my $lan (@lans) {
next
if ($lan->type() ne "portlan");
my $target_lanid;
$lan->GetAttribute("target_lanid", \$target_lanid) == 0
or return -1;
my $portvlan = Lan->Lookup($target_lanid);
if (!defined($portvlan)) {
tberror("Could not lookup portvlan $target_lanid\n");
return -1;
}
#
# Call snmpit once for each experiment that owns one of the
# target vlans.
#
my $experiment = $portvlan->GetExperiment();
return -1
if (!defined($experiment));
$portlans{$experiment->idx()} = $experiment;
}
#
# Now do it.
#
foreach my $idx (keys(%portlans)) {
my $experiment = $portlans{$idx};
my $pid = $experiment->pid();
my $eid = $experiment->eid();
print "Syncing target vlans in $experiment\n";
mysystem("$TB/bin/snmpit -f --redirect-err -X $pid $eid");
return -1
if ($?);
}
return 0;
}
#
# When swapping out an experiment, need to clear the ports from the
# shared lans.
#
sub ClearPortLans($)
{
my ($self) = @_;
require Lan;
my @lans;
if (Lan->ExperimentLans($self, \@lans) != 0) {
tberror("Could not get list of all lans for $self\n");
return -1;
}
my %portlans = ();
foreach my $lan (@lans) {
next
if ($lan->type() ne "portlan");
my $target_lanid;
$lan->GetAttribute("target_lanid", \$target_lanid) == 0
or return -1;
my $portvlan = Lan->Lookup($target_lanid);
if (!defined($portvlan)) {
tberror("Could not lookup portvlan $target_lanid\n");
return -1;
}
#
# The idea here is to remove any members for this lan
# from the target lan. Then sync the target.
#
my @members;
if ($portvlan->MemberList(\@members) != 0) {
tberror("Could not get member list for $portvlan\n");
return -1;
}
foreach my $member (@members) {
my $member_exptidx;
my $member_lanname;
$member->GetAttribute("portlan_exptidx", \$member_exptidx);
$member->GetAttribute("portlan_lanname", \$member_lanname);
# Not a port in an external lan; a native port.
next
if (!defined($member_exptidx) && !defined($member_lanname));
if (! (defined($member_exptidx) || defined($member_lanname))) {
tberror("Could not get idx/lanname from $member\n");
return -1;
}
next
if (! ($member_exptidx == $self->idx() &&
$member_lanname eq $lan->vname()));
# Delete the member.
if ($portvlan->DelMember($member)) {
tberror("Could not delete $member from $portvlan\n");
return -1;
}
}
#
# Call snmpit once for each experiment that owns one of the
# target vlans.
#
my $experiment = $portvlan->GetExperiment();
return -1
if (!defined($experiment));
my $pid = $experiment->pid();
my $eid = $experiment->eid();
print "Syncing target vlans in $experiment\n";
mysystem("$TB/bin/snmpit -f --redirect-err -X $pid $eid");
return -1
if ($?);
}
return 0;
}
#
# Is this experiment sharing any vlans.
#
sub SharingVlans($)
{
my ($self) = @_;
my $query_result =
DBQueryWarn("select * from shared_vlans ".
"where exptidx='$idx'");
return -1
if (!$query_result);
return $query_result->numrows;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2007-2011 University of Utah and the Flux Group.
# Copyright (c) 2007-2012 University of Utah and the Flux Group.
# All rights reserved.
#
package Lan;
......@@ -232,6 +232,21 @@ sub ready($) { return field($_[0], 'ready'); }
sub link($) { return field($_[0], 'link'); }
sub type($) { return field($_[0], 'type'); }
#
# Lookup an internal vlan (in the vlan-holding experiment).
#
sub LookupInternal($$)
{
my ($class, $vname) = @_;
require Experiment;
my $experiment = Experiment->Lookup(VLAN_PID(), VLAN_EID());
return undef
if (!defined($experiment));
return Lan->Lookup($experiment, $vname);
}
#
# Create a new (empty) lan. Ready bit is set to zero.
#
......@@ -1228,6 +1243,23 @@ sub Initialize($)
return 0;
}
#
# Look for a shared vlan by token. Just return the row reference.
# Be fancy later if needed.
#
sub LookupSharedVLanByToken($$)
{
my ($class, $token) = @_;
my $query_result =
DBQueryWarn("select * from shared_vlans ".
"where token='$token'");
return undef
if (!$query_result || !$query_result->numrows);
return $query_result->fetchrow_hashref();
}
############################################################################
#
# Lan::Member is just a set of attributes in the DB associated with an
......@@ -1305,6 +1337,7 @@ sub lanid($) { return $_[0]->GetLan()->lanid(); }
sub vname($) { return $_[0]->GetLan()->vname(); }
sub GetLan($) { return $_[0]->{'LAN'}; }
sub memberid($) { return $_[0]->{'MEMBERID'}; }
sub attributes($) { return $_[0]->{'ATTRS'}; }
#
# Stringify for output.
......
......@@ -3536,6 +3536,27 @@ CREATE TABLE `session_info` (
PRIMARY KEY (`session`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `shared_vlans`
--
DROP TABLE IF EXISTS `shared_vlans`;
CREATE TABLE `shared_vlans` (
`pid` varchar(48) default NULL,
`eid` varchar(32) default NULL,
`exptidx` int(11) NOT NULL default '0',
`vname` varchar(32) NOT NULL default '',
`lanid` int(11) NOT NULL default '0',
`token` varchar(128) NOT NULL default '',
`created` datetime default NULL,
`creator` varchar(8) NOT NULL default '',
`creator_idx` mediumint(8) unsigned NOT NULL default '0',
`open` tinyint(1) NOT NULL default '0',
PRIMARY KEY (`token`),
UNIQUE KEY `lan` (`exptidx`,`vname`),
UNIQUE KEY `lanid` (`lanid`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `sitevariables`
--
......
#
#
#
use strict;
use libdb;
sub DoUpdate($$$)
{
my ($dbhandle, $dbname, $version) = @_;
if (!DBTableExists("shared_vlans")) {
DBQueryFatal("CREATE TABLE `shared_vlans` ( ".
" `pid` varchar(48) default NULL, ".
" `eid` varchar(32) default NULL, ".
" `exptidx` int(11) NOT NULL default '0', ".
" `vname` varchar(32) NOT NULL default '', ".
" `lanid` int(11) NOT NULL default '0', ".
" `token` varchar(128) NOT NULL default '', ".
" `created` datetime default NULL, ".
" `creator` varchar(8) NOT NULL default '', ".
" `creator_idx` mediumint(8) unsigned NOT NULL default '0', ".
" `open` tinyint(1) NOT NULL default '0', ".
" PRIMARY KEY (`token`), ".
" UNIQUE KEY `lan` (`exptidx`,`vname`), ".
" UNIQUE KEY `lanid` (`lanid`) ".
") ENGINE=MyISAM DEFAULT CHARSET=latin1");
}
return 0;
}
1;
# Local Variables:
# mode:perl
# End:
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2011 University of Utah and the Flux Group.
# Copyright (c) 2000-2012 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
......@@ -206,6 +206,14 @@ if ($experiment->IsInstance() && !$template_mode) {
" $pid/$eid is a template instance; use another command!\n");
}
#
# Not allowed to terminate an experiment that is sharing vlans.
#
if ($experiment->SharingVlans()) {
die("*** $0:\n".
" $pid/$eid is sharing vlans. Clear those first!\n");
}
#
# Verify that this person is allowed to end the experiment.
#
......
......@@ -2651,6 +2651,75 @@ sub GenVirtLans($)
next;
}
}
elsif (@members == 1) {
#
# Special case that we use to connect a port to a vlan
# in another experiment. There is no delay or other stuff.
#
my $member = $members[0];
my $lannode = "portlan/$vname";
my $virtnode = $member->virt_node();
my $vnodevname = $virtnode->vname();
my $porttoken;
#
# Need to map the name of the lan we want to join, to
# a real vlan object.
#
foreach my $lan_setting ($self->virt_lan_settings()->Rows()) {
next
if ($vname ne $lan_setting->vname());
my $capkey = $lan_setting->capkey();
my $capval = $lan_setting->capval();
if ($capkey eq "portvlan") {
$porttoken = $capval;
last;
}
}
if (!defined($porttoken)) {
tberror("No target vlan for $vname!\n");
return -1;
}
#
# Map the token.
#
my $rowref = Lan->LookupSharedVLanByToken($porttoken);
if (!defined($rowref)) {
tberror("No shared vlan exists for $porttoken!\n");
return -1;
}
my $portvlan = Lan->Lookup($rowref->{'lanid'});
if (!defined($portvlan)) {
tberror("Target vlan for $porttoken does not exist!\n");
return -1;
}
# Very primitive access check.
if (! ($rowref->{'open'} || $self->user()->IsAdmin())) {
tberror("Target vlan for $porttoken is not open!\n");
return -1;
}
$vlan->_portvlan($portvlan);
# Lan node for assign.
$self->createNode($lannode, $mycmurn, "lan", '1', '',
{ 'virtualization_type' => 'raw' });
# So we ignore it when it comes back from assign.
$self->lannodes()->{$lannode} = 1;
my $others = {};
my $plink = "portlan/$vname/$member";
$self->createLink($vname, $plink,
[$virtnode->_cmurn()],
{'virtual_node_id' => $vnodevname,
'virtual_interface_id' =>"$member" },
{'virtual_node_id' => $lannode,
'virtual_interface_id' =>"$member" },
'*', $protocol, $others);
}
elsif (@members == 2 && !$vlan->_bridged()) {
#
# We treat LANs with two members specially - they are just links
......@@ -3955,7 +4024,7 @@ sub AddLinkToSolution($$$$$$$$;$)
}
}
elsif (($lan,$virtA) =
($vlink =~ m|^fakelan/([^/]+)/(.+)$|)) {
($vlink =~ /^(?:fakelan|portlan)\/([^\/]+)\/(.+)$/)) {
$virtlan = $self->vlans()->{$lan};
$member0 = $virtlan->members()->{$virtA};
$member0->_pnode($nodeA);
......@@ -6201,6 +6270,26 @@ sub InterpLinksAux($)
#
$self->SetUpTracing($virtlan, $member0, $nodeA, undef, $portA);
}
elsif ($linktag eq "portlan") {
my $portvlan = $virtlan->_portvlan();
#
# No trivial links, emulated links, delays, vlans.
# This is a port in an existing lan in another experiment.
#
$self->printdb("PortLan - $virtA - $nodeA:$portA\n");
my $protolan = ProtoLan->Lookup($experiment, $lan);
$protolan = ProtoLan->Create($experiment, $lan,
$self->impotent() || $self->alloconly())
if (!defined($protolan));
$protolan->SetType("portlan");
$protolan->SetRole("port/lan");
$protolan->AddInterface($nodeA, $vnodeA, $vportA, $portA);
$protolan->SetAttribute("link/lan", $lan);
$protolan->SetAttribute("target_lanid", $portvlan->lanid());
$portmap{$virtA} = $portA;
}
elsif ($plink =~ m|^linkdelaydst/([^/]+)/(.+)$| ||
$plink =~ m|^linksdelaydst/(.+)/(.+),(.+)$|) {
next;
......@@ -7733,6 +7822,82 @@ sub UploadVlans($)
or return -1;
}
}
#
# Deal with port vlans.
#
foreach my $lan (@lans) {
next
if ($lan->type() ne "portlan");
my $lanname;
$lan->GetAttribute("link/lan", \$lanname);
my $virtlan = $self->vlans()->{$lanname};
if (!defined($virtlan)) {
tberror("$lanname does not exist for portvlan\n");
return -1;
}
my $portvlan = $virtlan->_portvlan();
#
# The idea here is to remove any members for this lan
# from the target lan, and then add the new ones. This
# violates update, in that an error after this will not
# restore the missing ports. Need to fix that.
#
my @members;
if ($portvlan->MemberList(\@members) != 0) {
tberror("Could not get member list for $portvlan\n");
return -1;
}
foreach my $member (@members) {
my $member_exptidx;
my $member_lanname;
$member->GetAttribute("portlan_exptidx", \$member_exptidx);
$member->GetAttribute("portlan_lanname", \$member_lanname);
# Not a port in an external lan; a native port.
next
if (!defined($member_exptidx) && !defined($member_lanname));
if (! (defined($member_exptidx) && defined($member_lanname))) {
tberror("Could not get idx/lanname from $member\n");
return -1;
}
next
if (! ($member_exptidx == $exptidx &&
$member_lanname eq $lanname));
# Delete the member.
$self->printdb("Deleting $member from $portvlan\n");
if ($portvlan->DelMember($member)) {
tberror("Could not delete $member from $portvlan\n");
return -1;
}
}
#
# Now add new members.
#
if ($lan->MemberList(\@members) != 0) {
tberror("Could not get member list for $lan\n");
return -1;
}
foreach my $member (@members) {
my $nodeid;
my $iface;
$member->GetNodeIface(\$nodeid, \$iface);
my $newmember = $portvlan->AddMember($nodeid, $iface);
if (!defined($newmember)) {
tberror("Could not add $member to $portvlan\n");
return -1;
}
$self->printdb("Added $newmember to $portvlan\n");
# Mark where the member came from.
$newmember->SetAttribute("portlan_exptidx", $exptidx);
$newmember->SetAttribute("portlan_lanname", $lanname);
}
}
}
else {
$self->printdb("Dumping final protolans table.\n");
......@@ -7819,7 +7984,6 @@ sub UploadVlans($)
}
}
}
return 0;
}
#
......
......@@ -309,6 +309,9 @@ Simulator instproc make-cloud {nodes bw delay args} {
Simulator instproc make-path {linklist} {
}
Simulator instproc make-portinvlan {node token} {
}
Node instproc program-agent {args} {
}
......
......@@ -308,6 +308,23 @@ Simulator instproc make-lan {nodelist bw delay args} {
return $curlan
}
# A variant that creates a lan with a single member.
Simulator instproc make-portinvlan {node token} {
var_import ::GLOBALS::last_class
$self instvar id_counter
$self instvar lanlink_list
set curlan tblan-lan[incr id_counter]
Lan $curlan $self $node 0 0 {}
set lanlink_list($curlan) {}
set last_class $curlan
$curlan set_setting "portvlan" $token
return $curlan
}
# make-path <linklist>
Simulator instproc make-path {linklist args} {
var_import ::GLOBALS::last_class
......@@ -535,13 +552,6 @@ Simulator instproc run {} {
}
}
# Check for one node lans
foreach lan [array names lanlink_list] {
if {[llength [$lan set nodelist]] <= 1} {
perror "\[run] $lan has only a single node. LANs must have at least 2 nodes in them."
}
}
# If any errors occur stop here.
if {$errors == 1} {return}
......
......@@ -611,6 +611,18 @@ sub doSwapout($) {
if ($type >= RETRY) {
print "Removing dynamic blobs.\n";
$experiment->RemoveBlobs();
print "Clearing shared port vlans.\n";
if ($experiment->ClearPortLans()) {
tberror({type => 'summary', severity => SEV_SECONDARY,
error => ['vlan_reset_failed']},
"Failed to remove ports from shared vlans");
#
# If this fails, we cannot release the nodes cause they
# have ports in someone elses vlan. Bad.
#
return -1;
}
}
if ($type >= CLEANUP) {
......@@ -1430,6 +1442,19 @@ sub doSwapin($) {
TBDebugTimeStamp("snmpit finished");
}
#
# Look for ports in shared vlans. This method will call snmpit
# as needed,
#
if (!$experiment->skipvlans()) {
if ($experiment->SyncPortLans()) {
tberror({type => 'summary', severity => SEV_SECONDARY,
error => ['vlan_setup_failed']},
"Failed to sync port lans");
return 1;
}
}
# No need to do this except during a real swapin.
if ($type == REAL) {
print "Setting up email lists.\n";
......
......@@ -28,7 +28,7 @@ SBIN_SCRIPTS = vlandiff vlansync withadminprivs export_tables cvsupd.pl \
dumpdescriptor subboss_tftpboot_sync testbed-control \
archive-expinfo grantfeature emulabfeature addblob readblob \
prereserve grantimage getimages localize_mfs \
management_iface
management_iface sharevlan
WEB_SBIN_SCRIPTS= webnewnode webdeletenode webspewconlog webarchive_list \
webwanodecheckin webspewimage
......
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2003-2012 University of Utah and the Flux Group.
# All rights reserved.
#
use strict;
use English;
use Getopt::Std;
#
# Grant and revoke shared vlan access.
#
sub usage()
{
print STDERR "Usage: sharevlan [-o] eid lanname token\n";
print STDERR " sharevlan -r eid lanname\n";
print STDERR " -r Revoke sharing instead\n";
print STDERR " -o Sharing is open to everyone.\n";
exit(-1);
}
my $optlist = "hro";
my $revoke = 0;
my $open = 0;
# Protos
sub fatal($);
#
# Please do not run as root. Hard to track what has happened.
#
if ($UID == 0) {
die("*** $0:\n".
" Please do not run this as root!\n");
}
#
# Configure variables
#
my $TB = "@prefix@";
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use emdb;
use libtestbed;
use Experiment;
use EmulabConstants;
use Lan;
use User;