Merge remote branch 'central/master'

backend/editexp.in

 #!/usr/bin/perl -wT
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2007 University of Utah and the Flux Group.
+# Copyright (c) 2000-2011 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use English;
@@ -381,15 +381,23 @@ if (exists($editexp_args{"noidleswap_reason"})) {
 #
 # AutoSwap
 #
+if (exists($editexp_args{"autoswap"})) {
+    if ($editexp_args{"autoswap"} ne "1") {
+	if (!$this_user->IsAdmin()) {
+	    UserError("Max Duration: ".
+		      "you must ask testbed operations to disable this");
+	}
+	$editexp_args{"autoswap"} = 0;
+    }
+}
 if (exists($editexp_args{"autoswap_timeout"})) {
     if ($editexp_args{"autoswap_timeout"} <= 0) {
 	UserError("Max Duration: Invalid time provided");
     }
-}
-if (exists($editexp_args{"autoswap"})) {
-    if ($editexp_args{"autoswap"} ne "1") {
-	$editexp_args{"autoswap"} = 0;
-	#XXX $editexp_args{"autoswap_timeout"} = 0;
+    if ($editexp_args{"autoswap_timeout"} > (24 * 5) &&
+	!$this_user->IsAdmin()) {
+	UserError("Max Duration: 5 days maximum - ".
+		  "you must ask testbed operations for more");
     }
 }
 

db/elabinelab_bossinit.in

@@ -102,8 +102,8 @@ my @PIDONLYTABLES = ("os_info");
 my $q = DBQueryFatal("select pid_idx from projects ".
 		     "where pid='$TBOPSPID'");
 my ($npid) = $q->fetchrow_array();
-my $q = DBQueryFatal("select gid_idx from groups ".
-		     "where pid='$TBOPSPID' and gid=pid");
+$q = DBQueryFatal("select gid_idx from groups ".
+		  "where pid='$TBOPSPID' and gid=pid");
 my ($ngid) = $q->fetchrow_array();
 
 foreach my $table (@PIDGIDTABLES) {

db/emdbi.pm.in

@@ -192,6 +192,11 @@ sub fetchhash($)
     my $ref    = $self->fetchrow_hashref();
     return ($ref ? %$ref : ());
 }
+sub as_string($)
+{
+    my ($self) = @_;
+    $self->dump_results();
+}
 
 # Not supported so generate an error.
 sub dataseek($$)

db/if2port.in

@@ -2,7 +2,7 @@
 
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2002, 2005 University of Utah and the Flux Group.
+# Copyright (c) 2000-2011 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use Getopt::Std;
@@ -61,6 +61,12 @@ while (my $arg = shift @ARGV) {
 	&debug("Node is $node");
 	&debug("Card is $card") if (defined $card);
 
+	printf("\n%9s %5s%s%s %9s %5s %5s %5s %3s %7s %7s\n",
+	       "nodeid1", "card1",
+	       $opt{I} ? "              IP" : "",
+	       $opt{m} ? "          MAC" : "",
+	       "nodeid2", "card2", "port2", "cable", "len", "wtype", "ntype");
+
 	my $query;
 	if ($opt{m} || $opt{I}) {
 	    $query = "SELECT w.node_id1,w.card1,";
@@ -96,7 +102,17 @@ while (my $arg = shift @ARGV) {
 				"$row[5] (length $row[6], color $wireinfo)\n";
 		}
 	} else {
-		print $result->as_string;
+	    while (my @row = $result->fetchrow) {
+		my $i = 0;
+		printf("%9s %5d", $row[$i++], $row[$i++]);
+		printf("%16s", $row[$i++])
+		    if ($opt{I});
+		printf(" %12s", $row[$i++])
+		    if ($opt{m});
+		printf(" %9s %5d %5d %5d %3d %7s %7s\n",
+		       $row[$i++], $row[$i++], $row[$i++], $row[$i++],
+		       $row[$i++],$row[$i++],$row[$i++]);
+	    }
 	}
 }
 

defs-utahclient

+#
+# For building the client-side at Utah.
+# Make sure we do not use ELVIN_COMPAT, we should never build images that
+# way any more.
+#
+. defs-default
+
+ELVIN_COMPAT=0

event/linktest/linktest.pl

 #!/usr/bin/perl -w -T
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2010 University of Utah and the Flux Group.
+# Copyright (c) 2000-2011 University of Utah and the Flux Group.
 # All rights reserved.
 #
 
@@ -150,7 +150,8 @@ struct ( edge => {
     mac => '$',
     mpxstyle => '$',
     dstyle => '$',
-    symlanignore => '$'});
+    symlanignore => '$',
+    isunshaped => '$'});
 
 struct ( host => {
     name => '$',
@@ -218,6 +219,7 @@ my $total_error_count = 0;
 
 my $warn_partial_test = 0;
 my $warn_unshaped_links = 0;
+my $warn_totallyunshaped_links = 0;
 
 my $listener_iperf;
 my $listener_crude;
@@ -503,6 +505,10 @@ if (&dotest(TEST_BW)) {
 if (&dotest(TEST_LOSS)) {
     if ($printsched) {
 	&schedlog("start crude listener");
+    } elsif ($platform eq LINUX && $hostmap{$hostname}->isvnode) {
+	# XXX Linux vnodes (openvz) cannot change their priority
+	$listener_crude = &start_listener($PATH_CRUDE,"-l",CRUDE_DAT);
+	$listeners++;
     } else {
 	$listener_crude = &start_listener($PATH_CRUDE,"-l",CRUDE_DAT,
 					  "-P",CRUDE_PRI);
@@ -542,8 +548,16 @@ if ($warn_partial_test) {
     &post_event(EVENT_REPORT, $msg);
     &debug("\n$msg\n\n");
 }
+if ($warn_totallyunshaped_links && &dotest(TEST_LATENCY)) {
+    my $msg = "*** WARNING: no shaping on one or more".
+	      " zero-latency, zero-loss vnode-to-vnode links;".
+	      " checking only connectivity and not latency for those links.";
+    &sim_event(EVENT_LOG, $msg);
+    &post_event(EVENT_REPORT, $msg);
+    &debug("\n$msg\n\n");
+}
 if ($warn_unshaped_links && &dotest(TEST_BW)) {
-    my $msg = "*** WARNING: tb-set-noshaping used on one or more links,".
+    my $msg = "*** WARNING: no BW shaping on one or more links;".
 	      " skipping BW tests for those links.";
     &sim_event(EVENT_LOG, $msg);
     &post_event(EVENT_REPORT, $msg);
@@ -979,9 +993,14 @@ sub loss_test {
     # So, we add the extra rude option if conditions are met.
     #
     if ($numvnodes && $hostmap{$hostname}->isvnode) {
-	my $hz = `/sbin/sysctl kern.clockrate 2>/dev/null`;
-	if ($hz =~ /\shz = (\d+),/) {
-	    $rude_arg = "-C $1";
+	if ($platform eq BSD) {
+	    my $hz = `/sbin/sysctl kern.clockrate 2>/dev/null`;
+	    if ($hz =~ /\shz = (\d+),/) {
+		$rude_arg = "-C $1";
+	    }
+	} else {
+	    # assume linux runs at 1K HZ
+	    $rude_arg = "-C 1000";
 	}
     }
 
@@ -997,6 +1016,9 @@ sub loss_test {
 				  &get_loss_sample_size($edge) .
 				  ", time=" .
 				  LOSS_TEST_DURATION . "s, psize=20)");
+		    } elsif ($platform eq LINUX &&
+			     $hostmap{$hostname}->isvnode) {
+			&my_system($PATH_RUDE,"-s", RUDE_CFG, $rude_arg);
 		    } else {
 			&my_system($PATH_RUDE,"-s", RUDE_CFG, "-P", RUDE_PRI,
 				   $rude_arg);
@@ -1021,6 +1043,9 @@ sub loss_test {
 				  &get_loss_sample_size($edge) .
 				  ", time=" .
 				  LOSS_TEST_DURATION . "s, psize=20)");
+		    } elsif ($platform eq LINUX &&
+			     $hostmap{$hostname}->isvnode) {
+			&my_system($PATH_RUDE,"-s", RUDE_CFG, $rude_arg);
 		    } else {
 			&my_system($PATH_RUDE,"-s", RUDE_CFG, "-P", RUDE_PRI,
 				   $rude_arg);
@@ -1415,9 +1440,23 @@ sub latency_test {
     while(&has_elems(\@edge_copy)) {
 	my ($edge,$other_edge) = &get_twoway_assign(\@edge_copy, 0);
 	if(defined($edge) && defined($other_edge)) {
-	    if($hostname eq $edge->src ) {
-		# todo: consider ignoring latency if no delay node.
+	    if($hostname eq $edge->src) {
 		if(&valid_latency($edge) && &valid_latency($other_edge)) {
+		    my $unshaped = 0;
+
+		    #
+		    # If both ends of the link are vnodes and there is no
+		    # shaping on the link, then latency could be anything
+		    # depending on the virtual interface implementation.
+		    # In this case we still ping just to ensure connectivity.
+		    #
+		    if ($hostmap{$edge->src}->isvnode &&
+			$edge->isunshaped &&
+			$hostmap{$other_edge->src}->isvnode &&
+			$other_edge->isunshaped) {
+			&debug("Testing connectivity only for " . &print_link($edge) . " to " . &print_link($other_edge) . "\n");
+			$unshaped = 1;
+		    }
 
 		    #
 		    # Tell ping to wait at least one round-trip time.
@@ -1449,7 +1488,7 @@ sub latency_test {
 				  &print_edge($edge) . 
 				  ": count/avg/stddev = ".
 				  "$result_cnt/$sample_avg/$sample_dev ".
-				  "(expected $u)\n");
+				  ($unshaped?"":"(expected $u)\n"));
 			    exit(EXIT_OK);
 			}
 
@@ -1459,7 +1498,7 @@ sub latency_test {
 			    my $errmsg = "No packets received (n=$n)\n";
 			    &error(NAME_LATENCY, $edge, $errmsg);
 			    exit(EXIT_NOT_OK);
-			} else {
+			} elsif (!$unshaped) {
 			    my $u = &link_rtt($edge, $other_edge);
 			    
 			    my $x_bar = $sample_avg;
@@ -2214,6 +2253,7 @@ sub get_topo {
 			$edge->mac($row[4]);
 			$edge->mpxstyle($row[5]);
 			$edge->dstyle($row[6]);
+			$edge->isunshaped(0);
 
 			#
 			# If the link is not doing BW shaping
@@ -2226,6 +2266,19 @@ sub get_topo {
 			if ($edge->dstyle =~ /(\w+)-nobw$/) {
 			    $edge->bw(LIMIT_BW_HI+1);
 			    $edge->dstyle($1);
+			    #
+			    # If there is also no delay or loss specified,
+			    # then there is no shaping being done at all
+			    # and we make a note of this as it can cause
+			    # extremely low latency to be seen.
+			    #
+			    if ($edge->delay == 0 && $edge->loss == 0) {
+				$edge->isunshaped(1);
+				if ($hostmap{$edge->src}->isvnode &&
+				    $hostmap{$edge->dst}->isvnode) {
+				    $warn_totallyunshaped_links++;
+				}
+			    }
 			    $warn_unshaped_links++;
 			}
 

tbsetup/GNUmakefile.in

@@ -90,7 +90,9 @@ LIB_STUFF       = libtbsetup.pm exitonwarn.pm libtestbed.pm snmpit_intel.pm \
 		  power_mail.pm power_whol.pm Template.pm power_rmcp.pm \
 		  power_ilo.pm libvtop.pm libptop.pm libossetup.pm \
 		  power_ipmi.pm libosload_new.pm libosload_switch.pm \
-		  libossetup_switch.pm power_icebox.pm
+		  libossetup_switch.pm power_icebox.pm \
+		  libvtop_stable.pm libvtop_test.pm
+
 
 # These scripts installed setuid, with sudo. 
 SETUID_BIN_SCRIPTS   = node_reboot eventsys_control tarfiles_setup savelogs \

tbsetup/mapper.in

 #!/usr/bin/perl -w
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2010 University of Utah and the Flux Group.
+# Copyright (c) 2000-2011 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use strict;
@@ -226,6 +226,8 @@ my $newassign =
     EmulabFeatures->FeatureEnabled("NewAssign",
 				   $this_user,
 				   $experiment->GetGroup(), $experiment);
+
+libvtop::Init($this_user, $experiment->GetGroup(), $experiment);
     
 #
 # These are the flags to the vtop creation code. 

tbsetup/vtopgen.in

 #!/usr/bin/perl -w
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2009-2010 University of Utah and the Flux Group.
+# Copyright (c) 2009-2011 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use English;
@@ -43,6 +43,7 @@ use libtestbed;
 use User;
 use libtblog;
 use libvtop;
+use Experiment;
 
 # Protos
 sub fatal($);
@@ -95,6 +96,8 @@ if (! defined($this_user)) {
     tbdie("You ($UID) do not exist!");
 }
 
+libvtop::Init($this_user, $experiment->GetGroup(), $experiment);
+
 my $flags = 0;
 $flags |= $libvtop::VTOP_FLAGS_VERBOSE
     if ($verbose);

tmcd/linux/liblocsetup.pm

@@ -639,6 +639,10 @@ sub os_ifconfig_line($$$$$$$$;$$$)
 	    elsif ($speed == 10) {
 		$media = $IFC_10MBS;
 	    }
+	    elsif ($speed == 0) {
+		warn("*** Speed was 0 in ifconfig, defaulting to auto negotiation (and Gb media)\n");
+		$media = $IFC_1000MBS;
+	    }
 	    else {
 		warn("*** Bad Speed $speed in ifconfig, default to 100Mbps\n");
 		$speed = 100;
@@ -672,9 +676,21 @@ sub os_ifconfig_line($$$$$$$$;$$$)
 	if (defined($ethtool)) {
 	    # this seems to work for returning an error on eepro100
 	    $uplines =
-		"if $ethtool $iface >/dev/null 2>&1; then\n    " .
-		"  $ethtool -s $iface autoneg off speed $speed duplex $duplex\n    " .
-		"  sleep 2 # needed due to likely bug in e100 driver on pc850s\n".
+		"if $ethtool $iface >/dev/null 2>&1; then\n    ";
+	    if ($speed eq '0') {
+		$uplines .= "  $ethtool -s $iface autoneg on\n";
+	    }
+	    else {
+		# If we're gigabit, we *must* turn on autoneg -- it's part
+		# of the GbE protocol.
+		if ($speed eq '1000') {
+		    $uplines .= "  $ethtool -s $iface autoneg on\n";
+		}
+		$uplines .=
+		    "  $ethtool -s $iface autoneg off speed $speed duplex $duplex\n    " .
+		    "  sleep 2 # needed due to likely bug in e100 driver on pc850s\n";
+	    }
+	    $uplines .= 
 		"else\n    " .
 		"  /sbin/mii-tool --force=$media $iface\n    " .
 		"fi\n    ";

tmcd/tmcd.c

@@ -2069,10 +2069,9 @@ COMMAND_PROTOTYPE(doifconfig)
 			 "left join virt_lan_lans as vll on "
 			 "  vll.idx=v.virtlanidx and vll.exptidx=v.exptidx "
 			 "left join lans as l on "
-			 "  l.exptidx=vll.exptidx and l.vname=vll.vname and "
-			 "  l.link is null "
+			 "  l.exptidx=vll.exptidx and l.vname=vll.vname "
 			 "left join vlans on "
-			 "  vlans.id=l.lanid "
+			 "  vlans.id=v.vlanid "
 			 "left join lan_attributes as la2 on "
 			 "  la2.lanid=v.vlanid and la2.attrkey='stack' "
 			 "where v.exptidx='%d' and v.node_id='%s' and "

utils/node_traffic.in

 #!/usr/bin/perl -wT
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2008, 2010 University of Utah and the Flux Group.
+# Copyright (c) 2008-2011 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use strict;
@@ -13,20 +13,22 @@ use Getopt::Std;
 #
 sub usage()
 {
-    print STDOUT "Usage: node_traffic [-C] [node...]\n";
-    print STDOUT "-h         This message\n";
-    print STDOUT "-a         Show all nodes regardless of node state\n";
-    print STDOUT "-r	     Show only traffic received by each node\n";
-    print STDOUT "-s	     Show only traffic sent by each node\n";
-    print STDOUT "-i seconds Show stats over a <seconds>-period interval\n";
-    print STDOUT "-E	     Aggregate by experiment\n";
-#    print STDOUT "-C	     Show control net traffic\n";
+    print STDERR "Usage: node_traffic [-aArsE] [-i seconds] [node...]\n";
+    print STDERR "Reports traffic from nodes on the control network.\n";
+    print STDERR "-h         This message\n";
+    print STDERR "-a         Show all nodes regardless of node state\n";
+    print STDERR "-A         Really all; includes free nodes as well\n";
+    print STDERR "-r	     Show only traffic received by each node\n";
+    print STDERR "-s	     Show only traffic sent by each node\n";
+    print STDERR "-i seconds Show stats over a <seconds>-period interval\n";
+    print STDERR "-E	     Aggregate by experiment\n";
+#    print STDERR "-C	     Show control net traffic\n";
     exit(-1);
 }
 
 sub gather($$);
 
-my $optlist  = "CEi:ars";
+my $optlist  = "CEi:aArs";
 my $debug = 0;
 my $interval = 0;
 my $doall = 0;
@@ -83,6 +85,9 @@ if (defined($options{"h"})) {
 if (defined($options{"a"})) {
     $doall = 1;
 }
+if (defined($options{"A"})) {
+    $doall = 2;
+}
 if (defined($options{"r"})) {
     $recv = 1;
     $send = 0;
@@ -103,9 +108,8 @@ if (defined($options{"E"})) {
 if (defined($options{"C"})) {
     $controlnet = 1;
 }
-else {
-    @nodes = @ARGV;
-}
+
+@nodes = @ARGV;
 
 #
 # No nodes specified, get stats for all nodes that are in an experiment.
@@ -115,21 +119,42 @@ if (@nodes > 0) {
 	$nclause = "and n.node_id in (" . join(",", map("'$_'", @nodes)) . ")";
 }
 
-my $query_result =
-    DBQueryWarn("select r.pid,r.eid,node_id1,eventstate,card1,node_id2".
-		" from wires as w,nodes as n,reserved as r".
-		" where w.node_id1=n.node_id and w.node_id1=r.node_id".
-		"  and node_id2 like 'cisco%' and w.type='Control'".
-		"  and n.role='testnode' $nclause".
-		" order by node_id2,card2,port2");
+my $query_result;
+
+if ($doall == 2) {
+    $query_result =
+	DBQueryWarn("select r.pid,r.eid,node_id1,eventstate,card1,node_id2".
+		    " from wires as w,nodes as n".
+		    " left join reserved as r on n.node_id=r.node_id".
+		    " where w.node_id1=n.node_id".
+		    "  and (node_id2 like 'cisco%' or node_id2 like 'procurve%')".
+		    "  and w.type='Control'".
+		    "  and n.role='testnode' $nclause".
+		    " order by node_id2,card2,port2");
+} else {
+    $query_result =
+	DBQueryWarn("select r.pid,r.eid,node_id1,eventstate,card1,node_id2".
+		    " from wires as w,nodes as n,reserved as r".
+		    " where w.node_id1=n.node_id and w.node_id1=r.node_id".
+		    "  and (node_id2 like 'cisco%' or node_id2 like 'procurve%')".
+		    "  and w.type='Control'".
+		    "  and n.role='testnode' $nclause".
+		    " order by node_id2,card2,port2");
+}
 if (! $query_result || $query_result->numrows == 0) {
+    print STDERR "Node(s) not found.\n";
     exit(0);
 }
 while (my %row = $query_result->fetchhash()) {
     my $switch = $row{'node_id2'};
     my $pc = $row{'node_id1'};
     my $pceth = $row{'card1'};
-    my $exp = $row{'pid'} . "/" . $row{'eid'};
+    my $exp;
+    if (defined($row{'pid'})) {
+	$exp = $row{'pid'} . "/" . $row{'eid'};
+    } else {
+	$exp = "<NONE>";
+    }
     my $cnet = "$pc:$pceth";
 
     push(@{$switches{$switch}}, $cnet);
@@ -167,6 +192,10 @@ foreach my $node (keys %pcs) {
     }
     my $total = $after{$node}{'totals'}->[3] - $before{$node}{'totals'}->[3];
     if ($total <= 0) {
+	print STDERR "*** $node: negative packet count (",
+	             $before{$node}{'totals'}->[3], " to ",
+		     $after{$node}{'totals'}->[3], " ($total)\n"
+			 if ($total < 0);
 	next;
     }
     $pcs{$node}{'total'} = $total;
@@ -247,7 +276,10 @@ sub gather($$)
 		print STDERR "*** $node: invalid portstats!?\n"; 
 		next;
 	    }
-	    next if (!exists($pcref->{$node}));
+	    if (!exists($pcref->{$node})) {
+		print STDERR "*** $node: no stats returned!?\n"; 
+		next;
+	    }
 	    $resref->{$node}{'counts'} = @counts;
 	    my $oct = 0;
 	    my $upkts = 0;

www/beginexp_xml.php3

 <?php
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2010 University of Utah and the Flux Group.
+# Copyright (c) 2000-2011 University of Utah and the Flux Group.
 # All rights reserved.
 #
 include("defs.php3");
@@ -259,6 +259,10 @@ if (!isset($formfields["exp_idleswap_timeout"]) ||
 
 if (!isset($formfields["exp_autoswap"]) ||
     strcmp($formfields["exp_autoswap"], "1")) {
+    if (!ISADMIN()) {
+	$errors["Max. Duration"] =
+	    "You must ask testbed operations to disable this";
+    }
     $formfields["exp_autoswap"] = 0;
 }
 else {
@@ -269,6 +273,11 @@ else {
 	($formfields["exp_autoswap_timeout"] + 0) <= 0) {
 	$errors["Max. Duration"] = "No or invalid time provided";
     }
+    # The user can override autoswap timeout, but limit unless an admin.
+    if ($formfields["exp_idleswap_timeout"] > 24 * 5 && !ISADMIN()) {
+	$errors["Max. Duration"] = "5 days maximum - ".
+	    "you must ask testbed operations for more";
+    }
 }
 
 #