Commit b86b739c authored by Jonathon Duerig's avatar Jonathon Duerig
Browse files

Merge branch 'master' of git-public.flux.utah.edu:/flux/git/emulab-devel

parents e28ed510 44cfabfd
......@@ -23,10 +23,11 @@ use strict;
use Getopt::Std;
my %opt;
my $optlist = "ltL:evDnrs";
my $optlist = "ltL:evDnrRsa";
if (!getopts($optlist,\%opt)){
warn "Usage: $0 [-r] [-l] [-e] [-t] [-L limit] [-v] [-D] [-n] [-s]\n";
warn "Usage: $0 [-r] [-R] [-l] [-e] [-t] [-L limit] [-v] [-D] [-n] [-s]\n";
warn " -r Remove any files that fail the check\n";
warn " -R Rename any files that fail the check\n";
warn " -l List files that pass the check to stdout\n";
warn " -e Print parse errors from failed files to stderr\n";
warn " -t When finished, dump information about all types and\n";
......@@ -38,6 +39,7 @@ if (!getopts($optlist,\%opt)){
warn " private information\n";
warn " -s Strict checking - only pass files that would be parsed by\n";
warn " latest version of assign\n";
warn " -a Enable anonymization\n";
exit 1;
}
......@@ -68,6 +70,14 @@ my %top_linkflags = (
#
sub is_feature_okay($) {
my ($feature) = @_;
# If we are not anonymizing, all features are considered okay
if (!$opt{a}) {
return 1;
}
# If anyonymizing, don't let through OS features that expose the project
# name
if ($feature =~ /^OS-/) {
# OSes in the emulab-ops project are okay, as are ones that are just
# specified with a numeric ID
......@@ -160,7 +170,7 @@ sub check_node_type($) {
#
sub normalize_ptop($) {
my ($ptop) = @_;
my ($nodes, $links, $limits) = @$ptop;
my ($nodes, $links, $limits,$policies) = @$ptop;
foreach my $node (@$nodes) {
#print "Normalizing $node->{name}\n";
if (!$node->{types}) {
......@@ -209,12 +219,12 @@ sub normalize_ptop($) {
}
}
# Nothing to do for limits, for now
# Nothing to do for limits or policies, for now
}
sub write_normalized_ptop($$) {
my ($outfile, $ptop) = @_;
my ($nodes, $links, $limits) = @$ptop;
my ($nodes, $links, $limits, $policies) = @$ptop;
open (OF,">$outfile") or die "Unable to open $outfile for writing";
foreach my $node (@$nodes) {
......@@ -260,6 +270,10 @@ sub write_normalized_ptop($$) {
print OF "set-type-limit $type $count\n";
}
foreach my $policy (@$policies) {
print OF "policy " . join(" ",@$policy) . "\n";
}
close(OF);
}
......@@ -410,7 +424,7 @@ sub parse_ptop($) {
my %local_seen_link_types;
my %local_seen_fds;
my (@nodes, @links, @limits);
my (@nodes, @links, @limits, @policies);
my $line_no = 0;
while (my $line = <PT>) {
......@@ -541,6 +555,11 @@ sub parse_ptop($) {
my %limit = (type => $type, limit => $limit);
push @limits, \%limit;
} elsif ($line_type eq "policy") {
# For now, we are just going to pass the rest of the string
# along rather than parsing it carefully, since we don't support
# fancy policies in any ptop version yet
push @policies, [@tokens];
} else {
die "Unknown line type '$line_type' on $ptop line $line_no\n";
}
......@@ -558,7 +577,7 @@ sub parse_ptop($) {
close PT;
return [\@nodes, \@links, \@limits];
return [\@nodes, \@links, \@limits,\@policies];
}
sub parse_top($) {
......@@ -635,7 +654,14 @@ sub parse_top($) {
check_type("string",$link{dstiface});
$link{bw} = shift @tokens;
check_type("int",$link{bw});
#
# The bandwidth should be either the string '*' (which means
# 'native speed') or an int
#
if ($link{bw} ne "*") {
check_type("int",$link{bw});
}
# This is a bit tricky - figure out if there are delay and
# loss present on the line
......@@ -745,22 +771,9 @@ chomp @dirs;
my $processed_files = 0;
my $passed_files = 0;
foreach my $dir (@dirs) {
#my @ptopfiles = `ls -1 $dir/\*.ptop`;
#my @ptopfiles = ();
#my @topfiles = `ls -1 $dir/\*.top`;
my @topfiles;
my @ptopfiles;
opendir DIR, "$dir" or die "Unable to open $dir: $!\n";
while (my $file = readdir DIR) {
if ($file =~ /\.ptop$/) {
push @ptopfiles, "$dir/$file";
}
if ($file =~ /\.top$/) {
push @topfiles, "$dir/$file";
}
}
my @topfiles = `find $dir/ -name \*.vtop`;
my @ptopfiles = `find $dir/ -name \*.ptop`;
chomp @ptopfiles;
chomp @topfiles;
......@@ -770,19 +783,26 @@ foreach my $dir (@dirs) {
}
$processed_files++;
my $ptop_data = eval { parse_ptop($ptop); };
#if (eval { parse_ptop($ptop); }) {
if (!$@) {
$passed_files++;
if ($opt{l}) {
print "$ptop\n";
}
if ($opt{n}) {
# Grab timestamps so that we can preserve them
my ($atime, $mtime) = (stat($ptop))[8,9];
normalize_ptop($ptop_data);
write_normalized_ptop($ptop,$ptop_data);
# Restore timestamp
utime $atime, $mtime, $ptop;
}
} else {
if ($opt{r}) {
system "rm $ptop";
} elsif ($opt{R}) {
system "mv $ptop $ptop.failed";
}
if ($opt{e}) {
print "*** FAILED: $ptop: $@\n";
......@@ -799,22 +819,28 @@ foreach my $dir (@dirs) {
if ($opt{D}) {
print "Checking top file $top\n";
}
#parse_top($top);
$processed_files++;
my $top_data = eval { parse_top($top); };
#if (eval { parse_top($top); }) {
if (!$@) {
$passed_files++;
if ($opt{l}) {
print "$top\n";
}
if ($opt{n}) {
# Grab timestamps so that we can preserve them
my ($atime, $mtime) = (stat($top))[8,9];
normalize_top($top_data);
write_normalized_top($top,$top_data);
# Restore timestamp
utime $atime, $mtime, $top;
}
} else {
if ($opt{r}) {
system "rm $top";
} elsif ($opt{R}) {
system "mv $top $top.failed";
}
if ($opt{e}) {
print "*** FAILED: $top: $@\n";
......
#!/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");
}
}
......
......@@ -30,7 +30,8 @@ LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm \
NodeType.pm Interface.pm User.pm Group.pm Project.pm \
Image.pm OSinfo.pm Archive.pm Logfile.pm Lan.pm emdbi.pm \
emdb.pm emutil.pm Firewall.pm VirtExperiment.pm libGeni.pm \
libEmulab.pm EmulabConstants.pm TraceUse.pm EmulabFeatures.pm
libEmulab.pm EmulabConstants.pm TraceUse.pm EmulabFeatures.pm \
Port.pm
# Stuff installed on plastic.
USERSBINS = genelists.proxy dumperrorlog.proxy backup
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005-2010 University of Utah and the Flux Group.
# Copyright (c) 2005-2011 University of Utah and the Flux Group.
# All rights reserved.
#
package Interface;
......@@ -59,7 +59,7 @@ sub LookupAll($$$)
my $query_result =
DBQueryWarn("select * from interfaces ".
"where node_id='$nodeid'");
"where node_id='$nodeid' and logical=0");
return -1
if (!$query_result);
......
......@@ -17,6 +17,7 @@ use vars qw(@ISA @EXPORT);
use libdb;
use libtestbed;
use Node;
use Port;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
......@@ -2373,7 +2374,7 @@ sub FindMember($$$)
#
# Add a member in snmpit port form (node:card).
#
sub AddPort($$)
sub AddPort_OLD($$)
{
my ($self, $port) = @_;
my ($node_id, $card) = split(":", $port);
......@@ -2389,10 +2390,27 @@ sub AddPort($$)
return $self->GetLan()->AddMember($node_id, $interface->iface());
}
#
# Use Port class
#
sub AddPort($$)
{
my ($self, $port) = @_;
if (!ref($port)) {
return $self->AddPort_OLD($port);
}
my $member = $self->FindMember($port->node_id(), $port->iface());
return $member
if (defined($member));
return $self->GetLan()->AddMember($port->node_id(), $port->iface());
}
#
# Delete a member in snmpit port form (node:card).
#
sub DelPort($$)
sub DelPort_OLD($$)
{
my ($self, $port) = @_;
my ($node_id, $card) = split(":", $port);
......@@ -2408,6 +2426,23 @@ sub DelPort($$)
return $self->DelMember($member);
}
#
# Delete a member, use Port class
#
sub DelPort($$)
{
my ($self, $port) = @_;
if (!ref($port)) {
return $self->DelPort_OLD($port);
}
my $member = $self->FindMember($port->node_id(), $port->iface());
return 0
if (!defined($member));
return $self->DelMember($member);
}
#
# Does member already exists in protolan.
#
......@@ -3115,7 +3150,7 @@ sub IsNodeInAVlan($$)
return $query_result->numrows;
}
sub FindVlanByPort($$$)
sub FindVlanByPort_OLD($$$)
{
my ($class, $experiment, $port) = @_;
my ($node_id, $card) = split(":", $port);
......@@ -3142,6 +3177,36 @@ sub FindVlanByPort($$$)
return VLan->Lookup($lanid);
}
#
# Refactored with Port class
#
sub FindVlanByPort($$$)
{
my ($class, $experiment, $port) = @_;
my $clause = "";
if (!ref($port)) {
return $class->FindVlanByPort_OLD($experiment, $port);
}
my $ifacestr = $port->toIfaceString();
if (defined($experiment)) {
my $exptidx = $experiment->idx();
$clause = "exptidx='$exptidx' and";
}
my $query_result =
DBQueryWarn("select id from vlans ".
"where $clause members like '%${ifacestr}%'");
return undef
if (!$query_result || !$query_result->numrows);
my ($lanid) = $query_result->fetchrow_array();
return VLan->Lookup($lanid);
}
#
# Return a list of stale vlans for an experiment; vlans in the vlans
# table that need to be removed from the switches. This happens when a
......
......@@ -2607,6 +2607,22 @@ sub OSSelect($$$$)
"where node_id='$nodeid'")
or return -1;
return -1
if ($self->ResetNextOpMode($debug) < 0);
return Refresh($self);
}
sub ResetNextOpMode($$)
{
my ($self,$debug) = @_;
my $nodeid = $self->node_id();
my $curmode = $self->op_mode();
# Why? When will this happen?
return 0
if (!$curmode);
#
# Determine what osid the node will now boot. We need to know this so we
# can set the next opmode. This call has to return *something* or we are
......@@ -2633,7 +2649,7 @@ sub OSSelect($$$$)
"where node_id='$nodeid'")
or return -1;
return Refresh($self);
return 0;
}
#
......
This diff is collapsed.
......@@ -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) {
......
......@@ -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($$)
......
......@@ -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++]);
}
}
}
......
#
# 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
#!/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 {