Add support for a <emulab:skipvlans /> rspec directive.

db/VirtExperiment.pm.in

 #!/usr/bin/perl -wT
 #
-# Copyright (c) 2009-2014, 2016 University of Utah and the Flux Group.
+# Copyright (c) 2009-2018 University of Utah and the Flux Group.
 # 
 # {{{EMULAB-LICENSE
 # 
@@ -140,7 +140,8 @@ my $debug	      = 0;
 		      "delay_capacity"		=> 1,
 		      "dpdb"			=> 1,
 		      "nonfsmounts"		=> 1,
-		      "nfsmounts"		=> 1);
+		      "nfsmounts"		=> 1,
+		      "skipvlans"		=> 1);
 
 #
 # Grab the virtual topo for an experiment.

protogeni/lib/GeniAggregate.pm.in

@@ -1311,59 +1311,63 @@ sub ActionStart($$;$)
     # We want to let snmpit run in parallel with os_setup, like the
     # classic path does. 
     #
-    my $snmpit_child = fork();
-    if ($snmpit_child) {
-	#
-	# Parent just continues on, but will wait later, we cannot
-	# return to the caller until snmpit is done. 
-	#
-	print STDERR "Forked off snmpit: process $snmpit_child\n";
-    }
-    else {
-	EventFork();
-	my $msg;
-	
-	DebugTimeStamp("snmpit started");
-	if ($flags & $ACTION_FLAGS_SYNCVLANS) {
-	    if (Lan->CompareVlansWithSwitches2($experiment)) {
-		$msg .= "CompareVlansWithSwitches2 failed!\n";
-		goto badsnmpit;
-	    }
-	    system("$SNMPIT -X $pid $eid");
-	    if ($?) {
-		$msg .= "Failed to synchronize vlans";
-		goto badsnmpit;
-	    }
+    my $snmpit_child;
+
+    if (!$experiment->skipvlans()) {
+	$snmpit_child = fork();
+	if ($snmpit_child) {
+	    #
+	    # Parent just continues on, but will wait later, we cannot
+	    # return to the caller until snmpit is done. 
+	    #
+	    print STDERR "Forked off snmpit: process $snmpit_child\n";
 	}
 	else {
-	    my @diff = ();
-	    my @same = ();
-	    
-	    if (Lan->CompareVlansWithSwitches($experiment, \@diff, \@same)) {
-		print STDERR "CompareVlansWithSwitches failed!\n";
-		goto badsnmpit;
-	    }
-	    if (@diff) {
-		system("$SNMPIT -f ". join(" ", map("-o $_", @diff)));
+	    EventFork();
+	    my $msg;
+	
+	    DebugTimeStamp("snmpit started");
+	    if ($flags & $ACTION_FLAGS_SYNCVLANS) {
+		if (Lan->CompareVlansWithSwitches2($experiment)) {
+		    $msg .= "CompareVlansWithSwitches2 failed!\n";
+		    goto badsnmpit;
+		}
+		system("$SNMPIT -X $pid $eid");
 		if ($?) {
-		    $msg .= "Failed to remove obsolete VLANs.";
+		    $msg .= "Failed to synchronize vlans";
 		    goto badsnmpit;
 		}
 	    }
-	    system("$SNMPIT -t $pid $eid");
-	    if ($?) {
-		$msg .= "Failed to setup vlans";
-		goto badsnmpit;
+	    else {
+		my @diff = ();
+		my @same = ();
+	    
+		if (Lan->CompareVlansWithSwitches($experiment, \@diff,\@same)) {
+		    print STDERR "CompareVlansWithSwitches failed!\n";
+		    goto badsnmpit;
+		}
+		if (@diff) {
+		    system("$SNMPIT -f ". join(" ", map("-o $_", @diff)));
+		    if ($?) {
+			$msg .= "Failed to remove obsolete VLANs.";
+			goto badsnmpit;
+		    }
+		}
+		system("$SNMPIT -t $pid $eid");
+		if ($?) {
+		    $msg .= "Failed to setup vlans";
+		    goto badsnmpit;
+		}
 	    }
+	    DebugTimeStamp("snmpit finished");
+	    # Avoid END block processing
+	    POSIX::_exit(0);
+	    
+	  badsnmpit:
+	    print STDERR "Failed to setup vlans: $msg\n";
+	    # Avoid END block processing
+	    POSIX::_exit(-1);
 	}
-	DebugTimeStamp("snmpit finished");
-	# Avoid END block processing
-	POSIX::_exit(0);
-	
-      badsnmpit:
-	print STDERR "Failed to setup vlans: $msg\n";
-	# Avoid END block processing
-	POSIX::_exit(-1);
     }
     
     my @nodes = keys(%nodes);

protogeni/lib/GeniCM.pm.in

@@ -876,6 +876,13 @@ sub GetTicketAuxAux($)
     #
     my $disablerootkeys = GeniXML::DisableRootKey($rspec);
 
+    #
+    # Allow caller to turn off vlan creation. 
+    #
+    if (GeniXML::SkipVlans($rspec)) {
+	$virtexperiment->skipvlans(1);
+    }
+
     #
     # User can turn off routing.
     #

protogeni/lib/GeniXML.pm.in

@@ -791,6 +791,17 @@ sub DisableRootKey($)
     return 1;
 }
 
+sub SkipVlans($)
+{
+    my ($rspec) = @_;
+    
+    my $tmp = GeniXML::FindNodesNS("n:skipvlans", $rspec, $EMULAB_NS)->pop();
+    return 1
+	if (defined($tmp));
+
+    return 0;
+}
+
 sub GetTarball($)
 {
     my ($node) = @_;

sql/database-fill.sql

@@ -992,6 +992,7 @@ REPLACE INTO table_regex VALUES ('experiments','ipassign_args','text','regex','^
 REPLACE INTO table_regex VALUES ('experiments','expt_name','text','redirect','default:fulltext',1,255,NULL);
 REPLACE INTO table_regex VALUES ('experiments','dpdb','int','redirect','default:tinyint',0,1,NULL);
 REPLACE INTO table_regex VALUES ('experiments','nonfsmounts','int','redirect','default:tinyint',0,1,NULL);
+REPLACE INTO table_regex VALUES ('experiments','skipvlans','int','redirect','default:tinyint',0,1,NULL);
 REPLACE INTO table_regex VALUES ('experiments','nfsmounts','text','regex','^(emulabdefault|genidefault|all|none)$',0,0,NULL);
 REPLACE INTO table_regex VALUES ('experiments','packing_strategy','text','regex','^(pack|balance)$',0,0,NULL);
 

sql/updates/4/629

+use strict;
+use libdb;
+
+sub DoUpdate($$$)
+{
+    my ($dbhandle, $dbname, $version) = @_;
+
+    DBQueryFatal("REPLACE INTO table_regex VALUES ".
+		 "('experiments','skipvlans','int','redirect',".
+		 "'default:boolean',0,1,NULL)");
+    return 0;
+}
+
+# Local Variables:
+# mode:perl
+# End: