Add share/unshare vlan extrypoints to that an existing vlan can be

shared. This was requested at GEC 18.

When unsharing (or terminating) a slice that contains shared vlans,
the sharing is revoked from all slices using that vlan.

db/Experiment.pm.in

@@ -5569,6 +5569,20 @@ sub SetupPortLans($)
 	    tberror("Could not lock $portvlan for a long time!\n");
 	    return -1;
 	}
+	#
+	# Once we get the lock, make sure the lan is actually still
+	# shared. 
+	#
+	if ($portvlan->Refresh() != 0) {
+	    tberror("Could not refresh $portvlan after locking!\n");
+	    $portvlan->Unlock();
+	    return -1;
+	}
+	if (! $portvlan->IsShared()) {
+	    tberror("$portvlan is no longer shared!\n");
+	    $portvlan->Unlock();
+	    return -1;
+	}
 
 	#
 	# The idea here is to remove any members for this lan
@@ -5639,13 +5653,13 @@ sub SetupPortLans($)
 # When swapping out an experiment, need to clear the ports from the
 # shared lans. 
 #
-sub ClearPortLans($)
+sub ClearPortLans($;$@)
 {
-    my ($self) = @_;
+    my ($self, $nolock, @lans) = @_;
+    $nolock = 0 if (!defined($nolock));
     require Lan;
 
-    my @lans;
-    if (Lan->ExperimentLans($self, \@lans) != 0) {
+    if (!@lans && Lan->ExperimentLans($self, \@lans) != 0) {
 	tberror("Could not get list of all lans for $self\n");
 	return -1;
     }
@@ -5660,8 +5674,8 @@ sub ClearPortLans($)
 
 	my $portvlan = Lan->Lookup($target_lanid);
 	if (!defined($portvlan)) {
-	    tberror("Could not lookup portvlan $target_lanid\n");
-	    return -1;
+	    tbinfo("portvlan $target_lanid no longer exists. Skipping ...\n");
+	    next;
 	}
 
 	#
@@ -5670,11 +5684,34 @@ sub ClearPortLans($)
 	# timeout should not be too long; indicates an error if
 	# it is.
 	#
-	if ($portvlan->Lock(180) != 0) {
+	if (!$nolock && $portvlan->Lock(180) != 0) {
 	    tberror("Could not lock $portvlan for a long time!\n");
 	    return -1;
 	}
 
+	#
+	# Once we get the lock, make sure the lan is actually still
+	# shared. 
+	#
+	if ($portvlan->Refresh() != 0) {
+	    tberror("Could not refresh $portvlan after locking!\n");
+	    $portvlan->Unlock()
+		if (!$nolock);
+	    return -1;
+	}
+	#
+	# This does not need to be a fatal error since snmpit will not
+	# allow a shared vlan to removed. The only way to get here is
+	# if sharevlan -r -f is called, in which case the port was
+	# forcibly yanked out of the target vlan already, so we can just
+	# skip it. 
+	#
+	if (! $portvlan->IsShared()) {
+	    $portvlan->Unlock()
+		if (!$nolock);
+	    next;
+	}
+
 	#
 	# The idea here is to remove any members for this lan
 	# from the target lan. Then sync the target. 
@@ -5682,7 +5719,8 @@ sub ClearPortLans($)
 	my @members;
 	if ($portvlan->MemberList(\@members) != 0) {
 	    tberror("Could not get member list for $portvlan\n");
-	    $portvlan->Unlock();
+	    $portvlan->Unlock()
+		if (!$nolock);
 	    return -1;
 	}
 	foreach my $member (@members) {
@@ -5707,7 +5745,8 @@ sub ClearPortLans($)
 	    # Delete the member.
 	    if ($portvlan->DelMember($member)) {
 		tberror("Could not delete $member from $portvlan\n");
-		$portvlan->Unlock();
+		$portvlan->Unlock()
+		    if (!$nolock);
 		return -1;
 	    }
 	}
@@ -5716,7 +5755,8 @@ sub ClearPortLans($)
 	#
 	my $experiment = $portvlan->GetExperiment();
 	if (!defined($experiment)) {
-	    $portvlan->Unlock();
+	    $portvlan->Unlock()
+		if (!$nolock);
 	    return -1;
 	}
 	my $pid = $experiment->pid();
@@ -5726,10 +5766,12 @@ sub ClearPortLans($)
 	print "Syncing target vlan $lanid in $experiment\n";
 	mysystem("$TB/bin/snmpit_test -f --redirect-err -X $pid $eid $lanid");
 	if ($?) {
-	    $portvlan->Unlock();
+	    $portvlan->Unlock()
+		if (!$nolock);
 	    return -1;
 	}
-	$portvlan->Unlock();
+	$portvlan->Unlock()
+		if (!$nolock);
     }
     return 0;
 }
@@ -5775,6 +5817,32 @@ sub SharingVlans($)
     return $query_result->numrows;
 }
 
+#
+# List of shared vlans
+#
+sub SharedVlanList($$)
+{
+    my ($self, $pref) = @_;
+    my @result = ();
+    my $idx = $self->idx();
+
+    my $query_result =
+	DBQueryWarn("select lanid from shared_vlans where exptidx='$idx'");
+    return -1
+	if (!$query_result);
+
+    while (my ($lanid) = $query_result->fetchrow_array()) {
+	my $vlan = VLan->Lookup($lanid);
+	if (!defined($vlan)) {
+	    tberror("Could not lookup shared vlan $lanid\n");
+	    return -1;
+	}
+	push(@result, $vlan);
+    }
+    @$pref = @result;
+    return 0;
+}
+
 #
 # Do IP allocation for switch network fabrics that require it.
 #

protogeni/lib/GeniAM.pm.in

@@ -579,9 +579,7 @@ sub RenewSliver()
 
     # Return an XML-RPC boolean
     my $coder = Frontier::RPC2->new();
-    return GeniResponse->Create(GENIRESPONSE_SUCCESS,
-				GeniResponse::value($response),
-				GeniResponse::value($response));
+    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $coder->boolean(1));
 }
 
 sub Shutdown()
@@ -1127,6 +1125,28 @@ sub PerformOperationalAction
 	$slice->UnLock();
 	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
     }
+    elsif ($action eq 'geni_sharelan') {
+	if (!exists($options->{"geni_sharelan_lanname"})) {
+	    return GeniResponse->MalformedArgsResponse("No lanname provided!");
+	}
+	if (!exists($options->{"geni_sharelan_token"})) {
+	    return GeniResponse->MalformedArgsResponse("No token provided!");
+	}
+	$args->{'slice_urn'} = $slice->urn();
+	$args->{'token'}     = $options->{"geni_sharelan_token"};
+	$args->{'lanname'}   = $options->{"geni_sharelan_lanname"};
+	
+	return GeniCMV2::ShareLan($args);
+    }
+    elsif ($action eq 'geni_unsharelan') {
+	if (!exists($options->{"geni_unsharelan_lanname"})) {
+	    return GeniResponse->MalformedArgsResponse("No lanname provided!");
+	}
+	$args->{'slice_urn'} = $slice->urn();
+	$args->{'lanname'}   = $options->{"geni_unsharelan_lanname"};
+	
+	return GeniCMV2::UnShareLan($args);
+    }
     return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
 				"Invalid operational action");
 }

protogeni/lib/GeniCM.pm.in

@@ -75,6 +75,7 @@ use Compress::Zlib;
 use File::Temp qw(tempfile);
 use MIME::Base64;
 use Digest::SHA1 qw(sha1_hex);
+use POSIX ":sys_wait_h";
 
 # Configure variables
 my $TB		   = "@prefix@";
@@ -119,6 +120,7 @@ my $ADDAUTHORITY   = "$TB/sbin/protogeni/addauthority";
 my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
 my $TARINSTALL     = "/usr/local/bin/install-tarfile";
 my $IMAGE_SETUP    = "$TB/sbin/image_setup";
+my $SHAREVLAN      = "$TB/sbin/sharevlan";
 my $FWNAME	   = "fw";
 my $API_VERSION    = 1;
 my $USELOCALPROJ   = 0;
@@ -916,7 +918,6 @@ sub GetTicketAuxAux($$$$$$$$$$)
 				     "Hostname > 63 characters: $fullhostname");
 	    goto bad;
 	}
-	    
 	#
 	# Check for disk_image request. Specified as a URN. 
 	#
@@ -5470,6 +5471,35 @@ sub CleanupDeadSlice($;$)
 	    print STDERR "Could not clear portvlans\n";
 	    return -1;
 	}
+
+	#
+	# If this experiment has shared a lan to others, then must
+	# revoke them. This will yank them out from underneath the
+	# slices using them, but thats the way it has to be.
+	#
+	if ($experiment->SharingVlans()) {
+	    my @sharedvlans = ();
+	    if ($experiment->SharedVlanList(\@sharedvlans)) {
+		print STDERR "Failed to get shared VLANs\n";
+		return -1;
+	    }
+	    while (@sharedvlans) {
+		my $vlan  = shift(@sharedvlans);
+		my $vname = $vlan->vname();
+		print STDERR "Unsharing vlan $vname in $pid,$eid\n";
+		#
+		# This operation has to be done as an admin person. 
+		#
+		GeniUtil::FlipToElabMan();
+		system("$WAP $SHAREVLAN -r -f $pid,$eid $vname");
+		my $ecode = $?;
+		FlipToUser($slice);
+		if ($ecode) {
+		    print STDERR "Failed to unshare vlan!\n";
+		    return -1;
+		}
+	    }
+	}
 	
 	system("$SNMPIT -C -r $pid $eid");
 	if ($?) {
@@ -6313,8 +6343,6 @@ sub KillMonitor($)
 
     return 0
 	if (!$pid);
-	
-    print STDERR "Monitor in progress: process id $pid ...\n";
 
     my $experiment = $slice->GetExperiment();
     if (!defined($experiment)) {
@@ -6322,6 +6350,21 @@ sub KillMonitor($)
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "No slice experiment");
     }
+    #
+    # See if the process still exists.
+    #
+    if (kill(0, $pid) == 0) {
+	if ($!{ESRCH}) {
+	    print STDERR "Monitor process $pid no longer exists.\n";
+	    $experiment->SetCancelFlag(0);
+	    $slice->ClearMonitorPid();
+	    return 0;
+	}
+	# What does getting here mean?
+    }
+	
+    print STDERR "Monitor in progress: process id $pid ...\n";
+
     if ($experiment->canceled()) {
 	print STDERR "Cancel flag already set for $experiment\n";
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,

protogeni/lib/GeniCMV2.pm.in

@@ -99,6 +99,8 @@ my $SNMPIT         = "$TB/bin/snmpit";
 my $CLONEIMAGE     = "$TB/sbin/clone_image";
 my $CREATEIMAGE    = "$TB/bin/create_image";
 my $DELETEIMAGE    = "$TB/sbin/delete_image";
+my $WAP            = "$TB/sbin/withadminprivs";
+my $SHAREVLAN      = "$TB/sbin/sharevlan";
 my $XMLLINT	   = "/usr/local/bin/xmllint";
 my $PRERENDER      = "$TB/libexec/vis/prerender";
 my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
@@ -736,6 +738,8 @@ sub GetSliver($)
     my $slice_urn    = $argref->{'slice_urn'};
     my $credentials  = $argref->{'credentials'};
 
+    sleep(100);
+
     if (! (defined($credentials) && defined($slice_urn))) {
 	return GeniResponse->MalformedArgsResponse("Missing arguments");
     }
@@ -2709,5 +2713,154 @@ sub ListActiveSlivers($)
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
 }
 
+#
+# Emulab specific function to share and unshare vlans. 
+#
+sub ShareLan($)
+{
+    my ($argref) = @_;
+    
+    return ShareLanAux($argref, 0);
+}
+sub UnShareLan($)
+{
+    my ($argref) = @_;
+    
+    return ShareLanAux($argref, 1);
+}
+
+sub ShareLanAux($$)
+{
+    my ($argref, $revoke) = @_;
+    my $slice_urn    = $argref->{'slice_urn'};
+    my $credentials  = $argref->{'credentials'};
+    my $linkname     = $argref->{'lanname'};
+    my $token        = $argref->{'token'};
+
+    require Lan;
+    
+    if (! (defined($credentials) && 
+	   defined($slice_urn) && defined($linkname))) {
+	return GeniResponse->MalformedArgsResponse("Missing arguments");
+    }
+    if (! ($linkname =~ /^[-\w]*$/)) {
+	return GeniResponse->MalformedArgsResponse("Improper lanname argument");
+    }
+    if (!$revoke) {
+	if (!defined($token)) {
+	    return GeniResponse->MalformedArgsResponse("Missing token");
+	}
+	if (! ($token =~ /^[-\w]*$/)) {
+	    return GeniResponse->MalformedArgsResponse("Improper token");
+	}
+    }
+    
+    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
+    return $credential
+	if (GeniResponse::IsResponse($credential));
+
+    my $user = GeniCM::CreateUserFromCertificate($credential);
+    return $user
+	if (GeniResponse::IsResponse($user));
+    
+    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
+    return $slice
+	if (defined($slice) && GeniResponse::IsResponse($slice));
+
+    if (! (defined($slice) && defined($aggregate))) {
+	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
+				    "Slice does not exist");
+    }
+    main::AddLogfileMetaDataFromSlice($slice);
+
+    # If a monitor process is running, we are "busy".
+    if ($slice->monitor_pid()) {
+	return GeniResponse->MonitorResponse();
+    }
+    
+    if ($slice_urn ne $slice->urn()) {
+	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
+				    "Credential does not match the URN");
+    }
+    #
+    # Lock the slice; we do not the user to mess with things.
+    #
+    if ($slice->Lock() != 0) {
+	return GeniResponse->BusyResponse();
+    }
+    my $experiment = $slice->GetExperiment();
+    if (!defined($experiment)) {
+	$slice->UnLock();
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "No local experiment for slice");
+    }
+    my $pid  = $experiment->pid();
+    my $eid  = $experiment->eid();
+    my $vlan = VLan->Lookup($experiment, $linkname);
+    if (!defined($vlan)) {
+	$slice->UnLock();
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "No such lan in sliver");
+    }
+    if ($vlan->IsShared() && !$revoke) {
+	$slice->UnLock();
+	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
+				    "Lan is already shared");
+    }
+    if (!$revoke) {
+	#
+	# This operation has to be done as an admin person. 
+	#
+	GeniUtil::FlipToElabMan();
+	my $output = GeniUtil::ExecQuiet("$WAP $SHAREVLAN -o $pid,$eid ".
+					 "  $linkname $token");
+	my $ecode  = $?;
+	GeniUtil::FlipToGeniUser();
+	if ($ecode) {
+	    print STDERR "Failed to share vlan:\n";
+	    print STDERR $output;
+	    $slice->UnLock();
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef, $output);
+	}
+	libtestbed::SENDMAIL($TBOPS, "$linkname has been shared",
+			     "$linkname in $slice_urn has been\n".
+			     "shared by $user\n\n". 
+			     "Slice: $slice\n".
+			     "Experiment: $experiment\n",
+			     $TBOPS);
+	
+	$slice->UnLock();
+	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
+    }
+    #
+    # Revoking is a litte trickier since we have to worry about the
+    # experiments that are actually using the shared vlan. But the
+    # backend program is going to revoke access from all the experiments
+    # using those ports. Oh well.
+    #
+    # This operation has to be done as an admin person. 
+    #
+    GeniUtil::FlipToElabMan();
+    my $output = GeniUtil::ExecQuiet("$WAP $SHAREVLAN -r -f $pid,$eid ".
+				     "  $linkname ");
+    my $ecode  = $?;
+    GeniUtil::FlipToGeniUser();
+    if ($ecode) {
+	print STDERR "Failed to unshare vlan:\n";
+	print STDERR $output;
+	$slice->UnLock();
+	return GeniResponse->Create(GENIRESPONSE_ERROR);
+    }
+    libtestbed::SENDMAIL($TBOPS, "$linkname has been unshared",
+			 "$linkname in $slice_urn has been\n".
+			 "unshared by $user\n\n". 
+			 "Slice: $slice\n".
+			 "Experiment: $experiment\n",
+			 $TBOPS);
+
+    $slice->UnLock();
+    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
+}
+
 # _Always_ make sure that this 1 is at the end of the file...
 1;

protogeni/test/sharelan.py

+#! /usr/bin/env python
+#
+# Copyright (c) 2008-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.
+# 
+# }}}
+#
+
+#
+#
+import sys
+import pwd
+import getopt
+import os
+import time
+import re
+
+ACCEPTSLICENAME=1
+
+def Usage():
+    print "usage: " + sys.argv[ 0 ] + " [option...] lanname token "
+    print "usage: " + sys.argv[ 0 ] + " [option...] revoke lanname "
+    print "Options:"
+    BaseOptions()
+    pass
+
+debug    = 0
+revoke   = 0
+
+execfile( "test-common.py" )
+
+if len(REQARGS) == 2:
+    if REQARGS[0] == "revoke":
+        lanname = REQARGS[1]
+        revoke  = 1
+    else:
+        lanname = REQARGS[0]
+        token   = REQARGS[1]
+        pass
+else:
+    Usage()
+    sys.exit(1)
+    pass
+
+#
+# Get a credential for myself, that allows me to do things at the SA.
+#
+mycredential = get_self_credential()
+print "Got my SA credential"
+
+#
+# Lookup slice and get credential.
+#
+myslice = resolve_slice( SLICENAME, mycredential )
+
+print "Asking for slice credential for " + SLICENAME
+slicecredential = get_slice_credential( myslice, mycredential )
+print "Got the slice credential"
+
+#
+# Create the image
+#
+params = {}
+params["credentials"] = (slicecredential,)
+params["slice_urn"]   = myslice["urn"]
+params["lanname"]     = lanname
+if revoke == 0:
+    params["token"]   = token
+    print "Sharing the lan ..."
+    rval,response = do_method("cm", "ShareLan", params, version="2.0")
+    if rval:
+        Fatal("Could not share lan")
+        pass
+    pass
+else:
+    print "Unsharing the lan ..."
+    rval,response = do_method("cm", "UnShareLan", params, version="2.0")
+    if rval:
+        Fatal("Could not unshare lan")
+        pass
+    pass
+
+

protogeni/xmlrpc/protogeni-cm.pm.in

@@ -102,6 +102,8 @@ elsif ($GENI_VERSION eq "2.0") {
 	"CreateImage"       => \&GeniCMV2::CreateImage,
 	"DeleteImage"       => \&GeniCMV2::DeleteImage,
 	"ListImages"        => \&GeniCMV2::ListImages,
+	"ShareLan"          => \&GeniCMV2::ShareLan,
+	"UnShareLan"        => \&GeniCMV2::UnShareLan,
 	"ListActiveSlivers" => \&GeniCMV2::ListActiveSlivers,
     };
 }

utils/sharevlan.in

@@ -33,13 +33,14 @@ sub usage()
 {
     print STDERR "Usage: sharevlan [-o] eid lanname token\n";
     print STDERR "       sharevlan -r | -i token\n";
+    print STDERR "       sharevlan -r eid lanname\n";
     print STDERR " -r    Revoke sharing instead\n";
     print STDERR " -i    Show members.\n";
     print STDERR " -o    Sharing is open to everyone.\n";
     print STDERR " -l    List all shared vlans\n";
     exit(-1);
 }
-my $optlist  = "hrolif";
+my $optlist  = "hrRolif";
 my $revoke   = 0;
 my $open     = 0;
 my $list     = 0;
@@ -112,8 +113,9 @@ elsif (defined($options{'l'})) {
 elsif (defined($options{'r'})) {
     $revoke = 1;
 
-    usage()
-	if (@ARGV != 1);
+    if (defined($options{'R'})) {
+	$force = 1;
+    }
 }
 else {
     usage()
@@ -163,7 +165,7 @@ if ($info) {
     my $token = $ARGV[0];
     my $query_result =
 	DBQueryFatal("select lanid from shared_vlans where token='$token'");
-    if (!$query_result) {
+    if (!$query_result->numrows) {
 	fatal("No such shared vlan");
     }
     my ($lanid) = $query_result->fetchrow_array();
@@ -208,24 +210,61 @@ if ($info) {
 }
 
 if ($revoke) {
-    my $token = $ARGV[0];
+    my ($vlan,$lanid);
     my $busy  = 0;
 
+    if (@ARGV == 1) {
+	my $token = $ARGV[0];
+
+	my $query_result =
+	    DBQueryFatal("select lanid from shared_vlans where token='$token'");
+	if (!$query_result->numrows) {
+	    fatal("No such shared vlan");