cloudinfo.in 8.18 KB
Newer Older
1
#!/usr/bin/perl
Mike Hibler's avatar
Mike Hibler committed
2
#
3
# Copyright (c) 2006, 2007 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Mike Hibler's avatar
Mike Hibler committed
23
#
24 25 26 27 28 29

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

30 31
use Getopt::Std;

32 33 34
my $verbose = 1;
my $ispelab = 1;
my $zeroem = 0;
35
my $dumpfile = 0;
36
my $dofake = 0;
37 38 39 40 41 42 43

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
44 45 46
# XXX hack
$NLIST = "/usr/testbed/bin/node_list" if ($NLIST[0] == '@');

47
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
48
my $ipfwpat2 = q(^\d+\s+(\d+)\s+(\d+) pipe (\d+) ip from ([0-9\.]+) to any (\S+) (\S+) (\S+));
49
my $pipepat1 = 
50
q(^(\d+):\s+(unlimited|[\d\.]+ [KM]bit/s)\s+([\d\.]+) ms\s+(\d+) sl\.(plr [\d\.]+)?);
51 52 53 54 55
my $mappat =
q(^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)\s+(\d+));

sub usage()
{
56
    print STDERR "usage: cloudinfo [-z] [-d] pid eid\n";
57 58 59 60
    exit(1);
}

my %options = ();
61
if (!getopts("zfd", \%options)) {
62 63 64 65 66
    usage();
}
if (defined($options{"z"})) {
    $zeroem = 1;
}
67 68 69
if (defined($options{"f"})) {
    $dofake = 1;
}
70 71 72
if (defined($options{"d"})) {
    $dumpfile = 1;
}
73 74 75 76 77 78 79 80 81 82 83 84 85
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);
}

86 87 88 89
if ($dumpfile) {
    print "$pid $eid\n";
}

90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114
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) = @_;

115
    print "\n$node:\n" unless $dumpfile;
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
    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
134
	if (0) {
135 136 137 138
	if ($pipeinfo{$pipe}->{"ip"} eq "any") {
	    push(@anypipes, $pipe);
	    next;
	}
Mike Hibler's avatar
Mike Hibler committed
139
        }
140 141
	if (defined($lastdir) && $lastdir ne $pipeinfo{$pipe}->{"dir"} ||
	    defined($lastnode) && $lastnode ne $pipeinfo{$pipe}->{"node"}) {
142
	    print "\n" unless $dumpfile;
143 144 145 146 147
	}
	printapipe($pipe);
	$lastnode = $pipeinfo{$pipe}->{"node"};
	$lastdir = $pipeinfo{$pipe}->{"dir"};
    }
148
    print "\n" unless $dumpfile;
149 150 151
    foreach $pipe (@anypipes) {
	printapipe($pipe);
    }
152 153
    if ($verbose && @badpipes && !$dumpfile) {
	print STDERR "*** Ignored pipes with traffic:\n";
154 155 156 157 158 159 160 161 162 163
	foreach $pipe (@badpipes) {
	    printapipe($pipe);
	}
    }
}

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

164
    my $node;
165
    if ($ispelab) {
166
	$node = $pipeinfo{$pipe}->{"ip"};
167 168
	if ($node =~ /^10\.0\.0\.(\d+)$/) {
	    $node = "elab-$1";
169 170
	} elsif ($dofake && $node =~ /^10\.1\.0\.(\d+)$/) {
	    $node = "plab-$1";
171
	}
172
	$node = sprintf "%8s", $node unless $dumpfile;
173
    } else {
174 175
        $node = $pipeinfo{$pipe}->{"ip"};
	$node = sprintf "%16s", $node unless $dumpfile;
176 177
    }
    my $bw = $pipeinfo{$pipe}->{"bw"};
178 179 180 181 182 183 184 185 186 187 188 189

    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"};
190
	printf ", %2ds", $pipeinfo{$pipe}->{"qlen"};
191 192 193 194 195 196 197 198 199 200 201 202 203
	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";
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
    }
}

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
222
	    if (/$ipfwpat/ || /$ipfwpat2/) {
223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
		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 {
240
		    print STDERR "*** unknown interface $iface\n";
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
		}

		$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;
271 272
		    } elsif ($dofake && $node =~ /^plab-(\d+)$/) {
			$nodeix = $1;
273
		    } else {
274
			print STDERR "*** ignoring non-pelab rule: $rule\n";
275 276 277 278
			$pipeinfo{$pipe}->{"ignore"} = 1;
			next;
		    }
		    if ($ip eq "any") {
Mike Hibler's avatar
Mike Hibler committed
279 280 281
			if ($dir eq "<") {
			    $pipeinfo{$pipe}->{"ignore"} = 1;
			}
282 283
			next;
		    }
284
		    if ($ip =~ /^10\.[01]\.0\.(\d+)$/) {
285
			$ipix = $1;
Mike Hibler's avatar
Mike Hibler committed
286
			if (0) {
287 288 289 290 291
			if ($dir eq "<" && $nodeix != $ipix ||
			    $dir eq ">" && $nodeix == $ipix) {
			    $pipeinfo{$pipe}->{"ignore"} = 1;
			    next;
			}
292
		        }
293
		    } else {
294
			print STDERR "*** ignoring non-pelab rule: $rule\n";
295 296 297 298 299 300 301 302 303 304 305
			$pipeinfo{$pipe}->{"ignore"} = 1;
			next;
		    }
		}

	    }
	} elsif ($state == IN_SHOWP) {
	    if (/$pipepat1/) {
		my $pipe = int($1);
		my $bw = $2;
		my $delay = $3;
306 307
		my $qlen = $4;
		my $plr = $5;
308 309 310 311 312 313

		if ($bw =~ /(\d+.\d+) Mbit\/s/) {
		    $bw = $1 * 1000 * 1000;
		} elsif ($bw =~ /(\d+.\d+) Kbit\/s/) {
		    $bw = $1 * 1000;
		}
314
		if (defined($plr) && $plr =~ /plr (\d+\.\d+)/) {
315 316 317 318 319 320
		    $plr = $1 * 100.0;
		} else {
		    $plr = 0;
		}

		if (!exists($pipeinfo{$pipe})) {
321
		    print STDERR "*** unreferenced pipe $pipe\n";
322 323 324
		} else {
		    $pipeinfo{$pipe}->{"bw"} = $bw;
		    $pipeinfo{$pipe}->{"delay"} = $delay;
325
		    $pipeinfo{$pipe}->{"qlen"} = $qlen;
326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
		    $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"})) {
348
	    print STDERR "*** no info for pipe $pipe\n";
349 350 351
	}
    }
}