Shark support!

See www/tutorial/shark_howto.html.

tbsetup/ir/assign_wrapper.in

@@ -133,8 +133,8 @@ foreach (split("\n",$raw)) {
     }
     $delay =~ s/[mM][sS]$//;
     $bw =~ s/[mM][bB]$//;
-    printdb "lans{$lan} = [$nodes_raw,$bw,$delay,$loss".
-      (defined $links_raw ? ",$links_raw" : "")."]\n";
+    printdb "lans{$lan} = [$nodes_raw,$bw,$delay,$loss,".
+	join(" ",@$links_tmp) ."]\n";
     $lans{$lan} = [$nodes_tmp,$bw,$delay,$loss,$links_tmp];
 }
 
@@ -148,6 +148,108 @@ sub min {
     }
     return $min;
 };
+
+# Shark shelf
+
+# We need to find LANs with sharks in them, check to see all's ok and
+# convert them in to shark shelves, splitting the LAN if necessary.  The 
+# following conditions must be checked:
+# Foreach lan with sharks
+#   1. 10 MB, 0 latency, no loss
+#   2. <= 8 sharks in LAN
+#   3. <= 1 external link.
+# Foreach shark
+#   1. In LAN
+#   2. No other links
+
+# %sharkshelves is indexed by sharkshelf name (ss-<lan>) and contains
+# a list of the sharks in it.
+foreach $lan (keys(%lans)) {
+    ($lnodes,$bw,$delay,$loss,$llinks) = @{$lans{$lan}};
+    @sharks = ();
+    @others = ();
+    foreach $node (@$lnodes) {
+	if ($nodetypes{$node} eq "shark") {
+	    push(@sharks,$node);
+	} else {
+	    push(@others,$node);
+	}
+    }
+    # Skip if nothing more to do
+    if ($#sharks == -1) {next;}
+
+    # Check LAN
+    if (($bw != 10) || ($delay != 0) || ($loss != 0)) {
+	print STDERR "$lan has sharks but is not 10Mb/0 delay/0 loss.\n";
+	exit(1);
+    }
+    if ($#sharks >= 8) {
+	print STDERR "$lan has too many sharks.  Max 8.\n";
+	exit(1);
+    }
+
+    printdb "shark-lan $lan\n";
+    # Check sharks and remove them from consideration if they are OK
+    foreach $shark (@sharks) {
+	if (@{$nodes{$shark}}) {
+	    print STDERR "Shark $shark has links.\n";
+	    exit(1);
+	}
+	delete $nodes{$shark};
+	delete $nodetypes{$shark};
+    }
+    
+    # Final checks
+    @lanlinks = @$llinks;
+    if (@others) {
+	print STDERR "Shark lan $lan has non-sharks.\n";
+	exit(1);
+    }
+    if ($#lanlinks > 0) {
+	print STDERR "Shark lan $lan has more than one outside link.\n";
+	exit(1);
+    }
+
+    # Generate the shark shelf node
+    $ssnode = "ss-$lan";
+    $nodetypes{$ssnode} = "shark-shelf";
+    printdb "  nodetypes{$ssnode} = shark-shelf\n";
+    $sharkshelves{$ssnode} = [];
+    push(@{$sharkshelves{$ssnode}},@sharks);
+    printdb "  sharkshelves{$ssnode} = " . join(" ",@{$sharkshelves{$ssnode}}) . "\n";
+    if ($#lanlinks == 0) {
+	printdb "  Setting up link\n";
+	$extlink = $lanlinks[0];
+	($src,$dst,$bw,$delay,$loss) = @{$links{$extlink}};
+	if ($src eq "$lan") {
+	    $rdst = $dst;
+	} else {
+	    $rdst = $src;
+	}
+	$nodes{$ssnode} = ["$ssnode-$extlink"];
+	printdb "  nodes{$ssnode} = $ssnode-$extlink\n";
+	$links{"$ssnode-$extlink"} = [$ssnode,$rdst,$bw,$delay,$loss];
+	printdb "  links{$ssnode-$extlink} = [$ssnode,$rdst,$bw,$delay,$loss]\n";
+	delete $links{$extlink};
+    } else {
+	$nodes{$ssnode} = [];
+	printdb "  nodes{$ssnode} = []\n";
+    }
+
+    # Remove the original LAN
+    delete $lans{$lan};
+}
+
+# Check all remaining nodes to make sure none are sharks
+foreach $node (keys(%nodes)) {
+    printdb "Checking $node for sharkness ($nodetypes{$node})\n";
+    if ($nodetypes{$node} eq "shark") {
+	print STDERR "$node is s shark but not in a LAN.\n";
+	exit(1);
+    }
+}
+
+
 # LAN conversion
 
 # We now need to turn LANs into links and nodes.  Each lan gets a central
@@ -645,7 +747,13 @@ open(IRFILE,">>$irfile") || do {
 print IRFILE "START virtual\n";
 print IRFILE "START nodes\n";
 foreach $vnode (keys(%v2pmap)) {
-    if (! defined($lans{$vnode})) {
+    if (defined($sharkshelves{$vnode})) {
+	$i = 1;
+	foreach $vshark (@{$sharkshelves{$vnode}}) {
+	    print IRFILE "$vshark $v2pmap{$vnode}-$i\n";
+	    $i++;
+	}
+    } elsif (! defined($lans{$vnode})) {
 	print IRFILE "$vnode $v2pmap{$vnode}\n";
     }
 }

tbsetup/ir/handle_ip.in

@@ -81,6 +81,17 @@ foreach (split("\n",&ir_get("/virtual/nodes"))) {
     $rvnodemap{$physical} = $virtual;
 }
 
+# Read in nodes
+&ir_exists("/topology/nodes") || do {
+    print STDERR "IR does not contain topology/nodes section.\n";
+    exit(1);
+};
+foreach (split("\n",&ir_get("/topology/nodes"))) {
+    @t = split;
+    ($node,$type) = @t;
+    $nodetypes{$node} = $type;
+}
+
 # Read in the links
 &ir_exists("/topology/links") || do {
     print STDERR "IR does not contain topology/links section.\n";
@@ -92,17 +103,6 @@ foreach (split("\n",&ir_get("/topology/links"))) {
     $links{$link} = [$src,$dst];
 }
 
-# Get an idea of what LANs there are
-&ir_exists("/topology/lans") || do {
-    print STDERR "IR does not contain topology/lans section.\n";
-    exit(1);
-};
-foreach (split("\n",&ir_get("/topology/lans"))) {
-    ($lan,$nodesraw) = /^([^ ]+) "([^\"]+)"/;
-    my(@nodes) = split(" ",$nodesraw);
-    $lans{$lan} = [$lan,\@nodes];
-}
-
 # Pull the MAC table from the database.
 # MACTABLE is indexed by virtual node name and contains a reference
 # to a list of MACs.
@@ -122,6 +122,35 @@ while (@row = $sth->fetchrow_array) {
 }
 $sth->finish;
 
+# Get an idea of what LANs there are
+&ir_exists("/topology/lans") || do {
+    print STDERR "IR does not contain topology/lans section.\n";
+    exit(1);
+};
+foreach (split("\n",&ir_get("/topology/lans"))) {
+    ($lan,$nodesraw,$linksraw) = /^([^ ]+) "([^\"]+)" [^ ]+ [^ ]+ [^ ]+ (.+)$/;
+    my(@nodes) = split(" ",$nodesraw);
+    $lans{$lan} = [$lan,\@nodes];
+    # Check for sharkshelf
+    if ($nodetypes{$nodes[0]} == "shark") {
+	# We need to fill in the MACs for the vlan map for this lan
+	# since there is no actual VLAN for it.
+	$vlanmap{$lan} = [];
+	foreach $shark (@nodes) {
+	    push(@{$vlanmap{$lan}},@{$MACTABLE{$shark}});
+	}
+	# Linksraw only has a single link otherwise assign_wrapper would have
+	# generated an error.
+	($src,$dst) = @{$links{$linksraw}};
+	if ($src eq $lan) {
+	    $other = $dst;
+	} else {
+	    $other = $src;
+	}
+	push(@{$vlanmap{$lan}},@{$MACTABLE{$other}});
+    }
+}
+
 # This is a list of error messages
 @ERRORS = ();
 

tbsetup/ir/handle_os.in

@@ -62,13 +62,7 @@ foreach (split("\n",$raw)) {
     $type = $info[1];
     $nodetype{$node} = $type;
     if (! defined($ostype{$type})) {
-	# Special case - shark shelf
-	if ($type eq "shark-shelf") {
-	    $subtype = "shark";
-	} else {
-	    $subtype = $type;
-	}
-	$sth = $dbh->prepare("SELECT image_id from node_types where type = \"$subtype\"");
+	$sth = $dbh->prepare("SELECT image_id from node_types where type = \"$type\"");
 	$rr = $sth->execute;
 	if ($rr == 0) {
 	    push(@ERRORS,"Invalid type $type");
@@ -96,13 +90,7 @@ foreach (split("\n",$raw)) {
 	# assume to be a delay node
 	$os{$physical} = $delayos;
     } else {
-	if ($nodetype{$virtual} ne "shark-shelf") {
-	    $os{$physical} = $ostype{$nodetype{$virtual}};
-	} else {
-	    for ($i=1;$i<=8;$i++) {
-		$os{"$physical-$i"} = $ostype{"shark-shelf"};
-	    }
-	}
+	$os{$physical} = $ostype{$nodetype{$virtual}};
     }
 }
 # Now we parse the tbcmd file
@@ -122,46 +110,6 @@ while (<TBCMD>) {
 	  }
 	  last SWITCH;
       };
-      /^tb-set-dnard-os$/ && do {
-	  if ($#line != 3) {
-	      push(@ERRORS,"Syntax: tb-set-dnard-os shelf n os");
-	  } else {
-	      ($shelf,$n,$label) = @line[1..3];
-	      if (! defined($nodemap{$shelf})) {
-		  push(@ERRORS,"Unknown node $shelf\n");
-		  last SWITCH;
-	      }
-	      if (! (($n =~ /[0-9]-[0-9]/) || ($n =~ /[0-9]/))) {
-		  push(@ERRORS,"n must either be a number or a range start-end\n");
-		  last SWITCH;
-	      }
-	      
-	      # The label should either be in the images table or
-	      # in the DB.
-	      if (! defined($images{$label})) {
-		  # Check DB
-		  $sth = $dbh->prepare("SELECT image_id from disk_images where image_id = \"$label\"");
-		  $rr = $sth->execute;
-		  if ($rr == 0) {
-		      # Bad OS
-		      $sth->finish;
-		      push(@ERRORS,"Unknown OS label $label");
-		      last SWITCH;
-		  }
-		  $sth->finish;
-	      }
-	      $prefix = $nodemap{$shelf};
-	      if ($n =~ /[0-9]-[0-9]/) {
-		  ($start,$end) = split("-",$n);
-		  foreach ($start..$end) {
-		      $os{"$prefix-$_"}=$label;
-		  }
-	      } else {
-		  $os{"$prefix-$n"}=$label;
-	      }
-	  }
-	  last SWITCH;
-      };
       /^tb-set-node-os$/ && do {
 	  if ($#line != 2) {
 	      push(@ERRORS,"Syntax: tb-set-node-os nodespec os");
@@ -190,10 +138,7 @@ while (<TBCMD>) {
 	      }
 	      foreach (keys(%nodemap)) {
 		  if (eval("/^$nodespec" . '$' . "/")) {
-		      # Special case, make sure we aren't talking about sharks
-		      if ($nodetype{$_} eq "shark-shelf") {
-			  push(@ERRORS,"Use set-dnard-os for setting os of shark shelf $_\n");
-		      } elsif (($valid_type ne "") &&
+		      if (($valid_type ne "") &&
 			  ($nodetype{$_} ne $valid_type)) {
 			  push(@ERRORS,"$_ is of type $nodetype($_), OS $label is of type $valid_type");
 			  $os{$nodemap{$_}} = "INVALID";
@@ -206,10 +151,6 @@ while (<TBCMD>) {
 	      
 	  last SWITCH;
       };
-      /^tb-set-dnard-deltas$/ && do {
-	  # PLACE HOLDER
-	  last SWITCH;
-      };
       /^tb-set-node-deltas$/ && do {
 	  # PLACE HOLDER
 	  last SWITCH;

tbsetup/ns2ir/tb_compat.tcl.in

@@ -78,16 +78,10 @@ proc tb-set-lan-loss {lan rate} {
     global TBCMD nodeid_map prefix
     puts $TBCMD "tb-set-lan-loss $prefix-$nodeid_map($lan) $rate"
 }
-proc tb-set-dnard-os {shelf number os} {
-    global TBCMD nodeid_map
-    puts $TBCMD "tb-set-dnard-os $nodeid_map($shelf) $number $os"
-}
 
 # The following commands are not clearly defined and probably will be
 # changed or removed
-proc tb-set-dnard-ip {shelf number ip} {}
 proc tb-set-node-deltas {node deltas} {}
-proc tb-set-dnard-deltas {shelf number deltas} {}
 
 # Show that we have loaded
 set TB_COMPACT 1