wanlinkinfo.in 5.89 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh Stoller's avatar
Leigh Stoller committed
2 3

#
4
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{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/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
24 25
#

26
use English;
27 28 29 30 31 32 33 34 35 36
use Getopt::Std;

#
# Need to join with nodes/reserved to make sure node is not dead or
# in the hwdown group.
# 

sub usage()
{
    print STDOUT
37
	"Usage: wanlinkinfo [-d] [-m [-c <count>]] [-b] [-l] [-p] [-r]\n".
38
	"       Use -m to output virtual node counts per phys node.\n".
39
        "       Use -b to output bandwidth matrix.\n".
40
        "       Use -p to output plr matrix.\n".
41
        "       Use -r to remove boss from matrix.\n".
42
        "       Use -l to use the latest data instead of aged data.\n";
43 44
    exit(-1);
}
45
my  $optlist = "dmc:blrp";
46 47 48 49 50

#
# Configure variables
#
my $TB = "@prefix@";
51

52 53 54 55
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
56
use libdb;
57 58 59 60 61
use libtestbed;

# Locals
my $debug	= 0;
my $dobw	= 0;
62
my $doplr	= 0;
63
my $dovirt	= 0;
64
my $collocate   = 10000;
65
my $dolatest	= 0;
66
my $noboss	= 0;
67

68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
#
# Turn off line buffering on output
#
$| = 1;

# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"m"})) {
    $dovirt = 1;
93 94 95
    if (defined($options{"c"})) {
	$collocate = $options{"c"};
    }
96 97 98 99
}
if (defined($options{"b"})) {
    $dobw= 1;
}
100 101 102
if (defined($options{"l"})) {
    $dolatest= 1;
}
103 104 105
if (defined($options{"r"})) {
    $noboss = 1;
}
106 107 108
if (defined($options{"p"})) {
    $doplr = 1;
}
109

110 111 112 113 114 115 116 117 118
my %nodename = ();
my %speeds   = ();
my %bws      = ();
my %plrs     = ();
my %freenodes= ();

#
# First get the widearea data.
# 
119
my $result =
120 121
    DBQueryFatal("SELECT node_id1,iface1,node_id2,iface2,time, " .
		 "       bandwidth,lossrate FROM " .
122 123 124
		 ($dolatest ? "widearea_recent " : "widearea_delays ") .
		 ($noboss ? "where node_id1!='boss' and ".
		  "                node_id2!='boss'" : ""));
125

126
while (my ($node_id1, $iface1, $node_id2, $iface2, $time, $bw, $plr) =
127
       $result->fetchrow) {
128

129
    my $msectime = $time * 1000;
130 131
    my $glom1    = $node_id1;
    my $glom2    = $node_id2;
132 133 134 135 136 137

    # print "Got $glom1 to $glom2 in $msectime ms\n";
    $nodename{ $glom1 } = "1";
    $nodename{ $glom2 } = "1";

    $speeds{ $glom1 . "+" . $glom2 } = $msectime;
Chad Barb's avatar
Chad Barb committed
138
    $bws{ $glom1 . "+" . $glom2 } = $bw;
139
    $plrs{ $glom1 . "+" . $glom2 } = $plr;
140 141
}

142 143 144 145 146 147 148 149 150 151 152 153 154
#
# Need to figure out which nodes are free! This query not only looks
# for free nodes, but also for the virtual nodes that are assigned to
# them so that we can provide the multiplex count to the solver.
# It is essentially the same query as ptopgen.
#
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

$result =
    DBQueryFatal("select a.node_id,a.phys_nodeid,count(*) from nodes as a ".
		 "left join reserved as b on a.node_id=b.node_id ".
		 "left join reserved as m on a.phys_nodeid=m.node_id ".
155
		 "left join node_status as ns on a.phys_nodeid=ns.node_id ".
156 157
		 "left join node_types as nt on a.type=nt.type ".
		 "where b.node_id is null and ".
158
		 "      (nt.isremotenode=1 and ns.status='up' and ".
159 160 161 162 163 164 165
		 "       (m.node_id is null or ".
		 "        m.pid!='$DEADPID' or m.eid!='$DEADEID')) ".
		 "group by a.phys_nodeid");

while (my ($node_id, $phys_nodeid, $count) = $result->fetchrow) {
    if ($dovirt) {
	#
166 167
	# In dovirt mode, we care about how many free vnodes per real node,
	# limited by the requested collocate factor. 
168
	#
169 170 171
	$count = $collocate
	    if ($count > $collocate);
	
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
	if ($node_id ne $phys_nodeid) {
	    $freenodes{$phys_nodeid} = $count;
	}
    }
    else {
	#
	# In normal mode, we care about free phys nodes only.
	#
	if ($node_id eq $phys_nodeid) {
	    $freenodes{$phys_nodeid} = 1;
	}
    }
}

# The boss node is fake, and so gets a count of one when its included.
if (!$noboss) {
    my $boss = TBDB_WIDEAREA_LOCALNODE;
    
    $freenodes{$boss} = 1;
}

# Only free nodes are considered.
print scalar( keys %freenodes ) . "\n";
195

196
#
197
# XXX The boss node ends up first strictly by accident. 
198
# 
199
foreach my $i (sort (keys %freenodes)) {
200 201 202
    print "$i\n";
}

203
#
204
# Print the multiplex count.
205 206
# 
if ($dovirt) {
207 208
    foreach my $i (sort (keys %freenodes)) {
	my $vcount = $freenodes{$i};
209 210
	
	print "$vcount\n";
211 212 213
    }
}

214 215
foreach my $i (sort (keys %freenodes)) {
    foreach my $j (sort (keys %freenodes)) {
216 217
	my $s = (($i eq $j) ? 0 : -1);

218 219 220 221 222 223 224
	if (exists $speeds{ $i."+".$j } ) {
	    $s = $speeds{ $i . "+" . $j };
	} 
	print sprintf( "%-5i ", $s );
    }
    print "\n";
}
Chad Barb's avatar
Chad Barb committed
225

226
if ($dobw) {
227 228
    foreach my $i (sort (keys %freenodes)) {
	foreach my $j (sort (keys %freenodes)) {
229 230 231
	    # the following is conceptually
	    # the bandwidth of a machine to itself.
	    # using ttcp, a typical value was found to be 180 MB/sec
232 233
	    my $s = (($i eq $j) ? 180000 : -1);
	    
234 235 236 237 238 239
	    if (exists $bws{ $i."+".$j } ) {
		$s = $bws{ $i . "+" . $j };
	    } 
	    print sprintf( "%-6i ", $s );
	}
	print "\n";
Chad Barb's avatar
Chad Barb committed
240 241
    }
}
242 243

if ($doplr) {
244 245
    foreach my $i (sort (keys %freenodes)) {
	foreach my $j (sort (keys %freenodes)) {
246 247
	    my $s = 0;

248 249 250 251 252 253 254 255
	    if (exists $plrs{ $i."+".$j } ) {
		$s = $plrs{ $i . "+" . $j };
	    } 
	    print sprintf( "%.3f ", $s );
	}
	print "\n";
    }
}