cloudinfo.in 7.49 KB
Newer Older
1
#!/usr/bin/perl
Mike Hibler's avatar
Mike Hibler committed
2 3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2006, 2007 University of Utah and the Flux Group.
Mike Hibler's avatar
Mike Hibler committed
5 6
# All rights reserved.
#
7 8 9 10 11 12

#
# Hack to extract info from delay nodes about delay pipes.
# Only used with pelab "clouds" right now (hence the name).
#

Kevin Atkinson's avatar
 
Kevin Atkinson committed
13 14
use Getopt::Std;

15 16 17
my $verbose = 1;
my $ispelab = 1;
my $zeroem = 0;
Kevin Atkinson's avatar
 
Kevin Atkinson committed
18
my $dumpfile = 0;
19
my $dofake = 0;
20 21 22 23 24 25 26

use constant IN_SHOW  => 1;
use constant IN_SHOWP => 2;
use constant IN_MAP   => 3;

my $NLIST = "@prefix@/bin/node_list";

Mike Hibler's avatar
Mike Hibler committed
27 28 29
# XXX hack
$NLIST = "/usr/testbed/bin/node_list" if ($NLIST[0] == '@');

30
my $ipfwpat = q(^\d+\s+(\d+)\s+(\d+) pipe (\d+) ip from any to (any|[0-9\.]+) (\S+) (\S+) (\S+));
Mike Hibler's avatar
Mike Hibler committed
31
my $ipfwpat2 = q(^\d+\s+(\d+)\s+(\d+) pipe (\d+) ip from ([0-9\.]+) to any (\S+) (\S+) (\S+));
32
my $pipepat1 = 
Mike Hibler's avatar
Mike Hibler committed
33
q(^(\d+):\s+(unlimited|[\d\.]+ [KM]bit/s)\s+([\d\.]+) ms\s+(\d+) sl\.(plr [\d\.]+)?);
34 35 36 37 38
my $mappat =
q(^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)\s+(\d+));

sub usage()
{
Kevin Atkinson's avatar
 
Kevin Atkinson committed
39
    print STDERR "usage: cloudinfo [-z] [-d] pid eid\n";
40 41 42 43
    exit(1);
}

my %options = ();
44
if (!getopts("zfd", \%options)) {
45 46 47 48 49
    usage();
}
if (defined($options{"z"})) {
    $zeroem = 1;
}
50 51 52
if (defined($options{"f"})) {
    $dofake = 1;
}
Kevin Atkinson's avatar
 
Kevin Atkinson committed
53 54 55
if (defined($options{"d"})) {
    $dumpfile = 1;
}
56 57 58 59 60 61 62 63 64 65 66 67 68
if (@ARGV != 2) {
    usage();
}
my ($pid,$eid) = @ARGV;

my @nodelist = split('\s+', `$NLIST -v -e $pid,$eid`);
chomp(@nodelist);
my $nnodes = grep(/^tbs?delay/, @nodelist);
if ($nnodes == 0) {
    print STDERR "No delay nodes in $pid/$eid?!\n";
    exit(1);
}

Kevin Atkinson's avatar
 
Kevin Atkinson committed
69 70 71 72
if ($dumpfile) {
    print "$pid $eid\n";
}

73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
for my $node (@nodelist) {
    next
	if ($node !~ /^tbs?delay/);

    my $host = "$node.$eid.$pid.emulab.net";
    my $cmd = "ssh -o stricthostkeychecking=no $host ".
	"'(echo === cat mapping; cat /var/emulab/boot/delay_mapping; ".
	"  echo === ipfw show; sudo ipfw show; ".
	"  echo === ipfw pipe show; sudo ipfw pipe show)'";
    if (!open(IN, "$cmd |")) {
	warn("could not execute '$cmd'");
	next;
    }
    my $IN = *IN;
    parseit($IN);
    close(IN);
    printit($node);
    %pipeinfo = ();
}
exit(0);

sub printit($)
{
    my ($node) = @_;

Kevin Atkinson's avatar
 
Kevin Atkinson committed
98
    print "\n$node:\n" unless $dumpfile;
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
    my @pipes =
	sort {
	    $pipeinfo{$a}->{"node"} cmp $pipeinfo{$b}->{"node"} ||
	    $pipeinfo{$a}->{"dir"} cmp $pipeinfo{$b}->{"dir"} ||
	    $pipeinfo{$a}->{"ip"} cmp $pipeinfo{$b}->{"ip"} ||
	    $pipeinfo{$a}->{"inout"} cmp $pipeinfo{$b}->{"inout"}
	} keys %pipeinfo;
    
    my @anypipes = ();
    my @badpipes = ();
    my ($lastdir, $lastnode);
    foreach $pipe (@pipes) {
	if ($pipeinfo{$pipe}->{"ignore"}) {
	    if ($pipeinfo{$pipe}->{"pkts"}) {
		push(@badpipes, $pipe);
	    }
	    next;
	}
Mike Hibler's avatar
Mike Hibler committed
117
	if (0) {
118 119 120 121
	if ($pipeinfo{$pipe}->{"ip"} eq "any") {
	    push(@anypipes, $pipe);
	    next;
	}
Mike Hibler's avatar
Mike Hibler committed
122
        }
123 124
	if (defined($lastdir) && $lastdir ne $pipeinfo{$pipe}->{"dir"} ||
	    defined($lastnode) && $lastnode ne $pipeinfo{$pipe}->{"node"}) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
125
	    print "\n" unless $dumpfile;
126 127 128 129 130
	}
	printapipe($pipe);
	$lastnode = $pipeinfo{$pipe}->{"node"};
	$lastdir = $pipeinfo{$pipe}->{"dir"};
    }
Kevin Atkinson's avatar
 
Kevin Atkinson committed
131
    print "\n" unless $dumpfile;
132 133 134
    foreach $pipe (@anypipes) {
	printapipe($pipe);
    }
Kevin Atkinson's avatar
 
Kevin Atkinson committed
135 136
    if ($verbose && @badpipes && !$dumpfile) {
	print STDERR "*** Ignored pipes with traffic:\n";
137 138 139 140 141 142 143 144 145 146
	foreach $pipe (@badpipes) {
	    printapipe($pipe);
	}
    }
}

sub printapipe($)
{
    my ($pipe) = @_;

Kevin Atkinson's avatar
 
Kevin Atkinson committed
147
    my $node;
148
    if ($ispelab) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
149
	$node = $pipeinfo{$pipe}->{"ip"};
150 151
	if ($node =~ /^10\.0\.0\.(\d+)$/) {
	    $node = "elab-$1";
152 153
	} elsif ($dofake && $node =~ /^10\.1\.0\.(\d+)$/) {
	    $node = "plab-$1";
154
	}
Kevin Atkinson's avatar
 
Kevin Atkinson committed
155
	$node = sprintf "%8s", $node unless $dumpfile;
156
    } else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
157 158
        $node = $pipeinfo{$pipe}->{"ip"};
	$node = sprintf "%16s", $node unless $dumpfile;
159 160
    }
    my $bw = $pipeinfo{$pipe}->{"bw"};
Kevin Atkinson's avatar
 
Kevin Atkinson committed
161 162 163 164 165 166 167 168 169 170 171 172

    if (!$dumpfile) {

	printf "%8s %1s ", $pipeinfo{$pipe}->{"node"}, $pipeinfo{$pipe}->{"dir"};
	print "$node: ";
	if ($bw eq "unlimited") {
	    print " unlimited";
	} else {
	    printf "%10d", $bw;
	}
	printf ", %4dms", $pipeinfo{$pipe}->{"delay"};
	printf ", %4.1f%%", $pipeinfo{$pipe}->{"plr"};
Mike Hibler's avatar
Mike Hibler committed
173
	printf ", %2ds", $pipeinfo{$pipe}->{"qlen"};
Kevin Atkinson's avatar
 
Kevin Atkinson committed
174 175 176 177 178 179 180 181 182 183 184 185 186
	printf ", %10d", $pipeinfo{$pipe}->{"pkts"};
	printf ", %10d", $pipeinfo{$pipe}->{"bytes"};
	print "\n";

    } elsif ($node ne $pipeinfo{$pipe}{node}) {

	if ($pipeinfo{$pipe}->{"dir"} eq ">") {
	    print "$pipeinfo{$pipe}{node} $node ";
	} else {
	    print "$node $pipeinfo{$pipe}{node} ";
	}
	$bw /= 1000;
	print "$bw $pipeinfo{$pipe}{delay} $pipeinfo{$pipe}{plr}\n";
187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
    }
}

sub parseit($)
{
    my ($INP) = @_;

    my %outif2node;
    my %inif2node;

    while (<$INP>) {
	if (/^=== ipfw show$/) {
	    $state = IN_SHOW;
	} elsif (/^=== ipfw pipe show$/) {
	    $state = IN_SHOWP;
	} elsif (/^=== cat mapping$/) {
	    $state = IN_MAP;
	} elsif ($state == IN_SHOW) {
Mike Hibler's avatar
Mike Hibler committed
205
	    if (/$ipfwpat/ || /$ipfwpat2/) {
206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222
		my $rule = $_;
		chomp($rule);
		my $pkts = $1;
		my $bytes = $2;
		my $pipe = int($3);
		my $ip = $4;
		my $inout = $5;
		my $sndrcv = $6;
		my $iface = $7;
		my ($dir,$node);
		if (exists($outif2node{$iface})) {
		    $dir = ">";
		    $node = $outif2node{$iface};
		} elsif (exists($inif2node{$iface})) {
		    $dir = "<";
		    $node = $inif2node{$iface};
		} else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
223
		    print STDERR "*** unknown interface $iface\n";
224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253
		}

		$pipeinfo{$pipe} = {
		    "pkts" => $pkts,
		    "bytes" => $bytes,
		    "ip" => $ip,
		    "inout" => $inout,
		    "sndrcv" => $sndrcv,
		    "iface" => $iface,
		    "dir" => $dir,
		    "node" => $node,
		    "ignore" => 0
		};

		#
		# For pelab we assume/enforce certain things
		#
		# - nodes are "elab-<#>"
		# - ips are "10.0.0.<#>"
		# - we should only see "<" traffic on rules targeting
		#   a node we are delaying
		# - there may be traffic on in/out "any" rules, but only
		#   from before the per-flow pipes were setup.
		# - there should be no output traffic to ourselves
		#
		if ($ispelab) {
		    my ($ipix,$nodeix);

		    if ($node =~ /^elab-(\d+)$/) {
			$nodeix = $1;
254 255
		    } elsif ($dofake && $node =~ /^plab-(\d+)$/) {
			$nodeix = $1;
256
		    } else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
257
			print STDERR "*** ignoring non-pelab rule: $rule\n";
258 259 260 261
			$pipeinfo{$pipe}->{"ignore"} = 1;
			next;
		    }
		    if ($ip eq "any") {
Mike Hibler's avatar
Mike Hibler committed
262 263 264
			if ($dir eq "<") {
			    $pipeinfo{$pipe}->{"ignore"} = 1;
			}
265 266
			next;
		    }
267
		    if ($ip =~ /^10\.[01]\.0\.(\d+)$/) {
268
			$ipix = $1;
Mike Hibler's avatar
Mike Hibler committed
269
			if (0) {
270 271 272 273 274
			if ($dir eq "<" && $nodeix != $ipix ||
			    $dir eq ">" && $nodeix == $ipix) {
			    $pipeinfo{$pipe}->{"ignore"} = 1;
			    next;
			}
275
		        }
276
		    } else {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
277
			print STDERR "*** ignoring non-pelab rule: $rule\n";
278 279 280 281 282 283 284 285 286 287 288
			$pipeinfo{$pipe}->{"ignore"} = 1;
			next;
		    }
		}

	    }
	} elsif ($state == IN_SHOWP) {
	    if (/$pipepat1/) {
		my $pipe = int($1);
		my $bw = $2;
		my $delay = $3;
Mike Hibler's avatar
Mike Hibler committed
289 290
		my $qlen = $4;
		my $plr = $5;
291 292 293 294 295 296

		if ($bw =~ /(\d+.\d+) Mbit\/s/) {
		    $bw = $1 * 1000 * 1000;
		} elsif ($bw =~ /(\d+.\d+) Kbit\/s/) {
		    $bw = $1 * 1000;
		}
Mike Hibler's avatar
Mike Hibler committed
297
		if (defined($plr) && $plr =~ /plr (\d+\.\d+)/) {
298 299 300 301 302 303
		    $plr = $1 * 100.0;
		} else {
		    $plr = 0;
		}

		if (!exists($pipeinfo{$pipe})) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
304
		    print STDERR "*** unreferenced pipe $pipe\n";
305 306 307
		} else {
		    $pipeinfo{$pipe}->{"bw"} = $bw;
		    $pipeinfo{$pipe}->{"delay"} = $delay;
Mike Hibler's avatar
Mike Hibler committed
308
		    $pipeinfo{$pipe}->{"qlen"} = $qlen;
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330
		    $pipeinfo{$pipe}->{"plr"} = $plr;
		}
	    }
	} elsif ($state == IN_MAP) {
	    if (/$mappat/) {
		my $node = $3;
		if ($node ne $4) {
		    my $onode = $4;
		    $outif2node{$6} = $onode;
		    $inif2node{$5} = $onode;
		}
		$outif2node{$5} = $node;
		$inif2node{$6} = $node;
	    }
	} else {
	    ;
	}
    }
    close($INP);

    foreach $pipe (keys %pipeinfo) {
	if (!exists($pipeinfo{$pipe}->{"bw"})) {
Kevin Atkinson's avatar
 
Kevin Atkinson committed
331
	    print STDERR "*** no info for pipe $pipe\n";
332 333 334
	}
    }
}