ptopgen.in 6.39 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
#!/usr/bin/perl -w
2 3
use English;
use Getopt::Std;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
4

5 6 7 8 9 10 11
sub usage()
{
    print STDOUT "Usage: ptopgen [-s switch]\n";
    exit(-1);
}
my  $optlist = "s:";

12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

# Settings - Change these to your particular network.
#
# Explanation from Mac:
#
# These are for the imaginary "lan nodes". Internally the way we map
# lans is as a bunch of machines connected in a star to a "lan node"
# that has infinite bw basically, and an infinite number of connections
# available to it. So the first big number is BW (100Gbps), and the
# 1000 means it has 1000 connections to the switch. That number is
# plenty high as it is, since our limit on one switch is under 400.
#
# Speed in in Kbs!
#
my $lannode_switch2switch_speed = 100000000;
my $lannode_switch2switch_links = 1000;

#
# Also bogus. The interfaces table does not hold entries for the switch
# side of each link. It will have to at some point, when we have something
# other than 100Mbs ports (say, gbit ports).
#
# Speed in in Kbs!
#
my $default_switchport_speed    = 100000;

38 39
######################################################################

40
my $TBROOT = "@prefix@";
41
use lib '@prefix@/lib';
42
require exitonwarn;
43
use libdb;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44

45
%switches=();
46
%used_switches=();
47 48
my $switchtouse;

49 50 51
my $DEADPID = NODEDEAD_PID();
my $DEADEID = NODEDEAD_EID();

52 53 54 55 56 57 58 59 60 61 62 63 64 65
#
# 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{"s"})) {
    $switchtouse = $options{"s"};
}
66

67
# Read class/type maps
68 69
my $result = DBQueryFatal("select class,type,delay_capacity from node_types");
while (($class,$type,$delaycapacity) = $result->fetchrow_array) {
70
    $classes{$type} = $class;
71
    $nodetypes{$type} = $delaycapacity;
72
}
73
$result->finish;
74 75 76 77

# switches can't delay
$nodetypes{"switch"} = 0;

78
# Print switches
79 80 81 82 83 84 85 86 87 88 89 90 91
if (defined($switchtouse)) {
    print "node $switchtouse switch:1\n";
    $switches{$switchtouse} = 1;
}
else {
    $result =
	DBQueryFatal("select node_id from nodes where role = \"testswitch\"");

    while (($switch) = $result->fetchrow_array) {
	print "node $switch switch:1\n";
	$switches{$switch} = 1;
    }
    $result->finish;
92
}
93

Leigh B. Stoller's avatar
Leigh B. Stoller committed
94
# Find available nodes
95 96 97 98 99 100 101 102 103 104 105 106 107
#
# VIRTNODES HACK: If the node is a virtual node, then in addition to
# to being free, the underlying physnode has to either be free, or
# not in the hwdown group. Either way, the the underlying physnode has
# to be "up", as determined by the autostatus stuff; this will prevent us
# from allocating a dead virtual node to an experiment. 
# This is especially hacky. We need another mechanism for this.
#
$result =
    DBQueryFatal("select a.node_id,a.type 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 ".
		 "left join nodes as n on a.phys_nodeid=n.node_id ".
108 109 110 111
		 "where b.node_id is null and (a.role='testnode' or ".
		 "      (a.role='virtnode' and n.status='up' and ".
		 "       (m.node_id is null or ".
		 "        m.pid!='$DEADPID' or m.eid!='$DEADEID')))");
112

113
while (($node,$type) = $result->fetchrow_array) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
114 115 116 117 118 119 120 121 122
    # Shark hack
    if (($shelf,$number) = ($node =~ /^sh(\d+)-(\d+)/)) {
	if ($number == 1) {
	    $nodes{"sh$shelf"} = "shark-shelf";
	}
    } else {
	$nodes{$node} = $type;
    }
}
123
$result->finish;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
124 125


126
$sharklinks = "";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
127 128 129 130
foreach $node (keys(%nodes)) {
    if ($node =~ /^sh/) {
	print "node $node shark-shelf:1\n";
    } else {
131 132 133 134
	$text = "node $node $nodes{$node}:1 $classes{$nodes{$node}}:1";
	$delay_capacity = $nodetypes{$nodes{$node}};
	if ($delay_capacity > 0) {
	    $text .= " delay:$delay_capacity";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
135 136 137 138 139
	}
	print "$text\n";
    }
}

140
# Read interfaces
141
$result = DBQueryFatal("SELECT node_id,card,port,iface,interface_type" .
142
		     " from interfaces");
143
while (($node,$card,$port,$iface,$type) = $result->fetchrow_array) {
144 145 146 147 148
    $interfacemap{"$node:$card:$port"} = $iface;
    if ($type ne "") {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
}
149
$result->finish;
150 151

# Read interface types
152 153
$result = DBQueryFatal("SELECT type,max_speed from interface_types");
while (($type,$speed) = $result->fetchrow_array) {
154 155
    $interfacespeeds{$type} = $speed;
}
156
$result->finish;
157

158
$result = DBQueryFatal("SELECT node_id1,card1,port1,node_id2,card2,port2" .
159
 		    " from wires where type=\"Node\" or type=\"Trunk\"");
160
while (($node1,$card1,$port1,$node2,$card2,$port2) = 
161
       $result->fetchrow_array) {
162
    if ((defined($nodes{$node1}) || defined($switches{$node1})) && 
163
	(defined($nodes{$node2}) || defined($switches{$node2}))) {
164 165 166 167 168 169 170 171 172
	$iface1 = get_iface($node1,$card1,$port1);
	$iface2 = get_iface($node2,$card2,$port2);
	$iface1bw = get_ifacebw($node1,$card1,$port1);
	$iface2bw = get_ifacebw($node2,$card2,$port2);
	if ($iface1bw < $iface2bw) {
	    $bw = $iface1bw;
	} else {
	    $bw = $iface2bw;
	}
173
	if (defined($switches{$node2})) {
174 175
	    $used_switches{$node2} = 1;
	}
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
	if (defined($switches{$node1})) {
	    $used_switches{$node1} = 1;
	}
	if (defined($switches{$node1}) && defined($switches{$node2})) {
	    # interswitch link
	    if (defined($interconnects{"$node1:$node2"})) {
		$interconnects{"$node1:$node2"} += $bw;
	    } else {
		$interconnects{"$node1:$node2"} = $bw;
	    }
	} else {
	    # !!! - Here we use our knowledge that in the wires table links
	    # to the switch always come as node2.
	    print "link link-$node1:$iface1-$node2:$iface2 $node1:$node1/$iface1" .
		" $node2:$iface2 $bw 1\n";
	}
    } 
193
}
194
$result->finish;
195 196 197 198
foreach $interconnect (keys(%interconnects)) {
    ($src,$dst) = split(":",$interconnect);
    print "link link-$interconnect $src $dst $interconnects{$interconnect} 1\n";
}
199 200 201

print $sharklinks;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
202
# Add a bunch of LANs
203 204 205
foreach $switch (keys(%used_switches)) {
    for ($i = 0;$i <= 20;$i++) {
	print "node lan-$switch-$i lan:1\n";
206 207 208
	print "link link-lan-$switch-$i lan-$switch-${i}:lan-$switch-$i " .
	    "$switch ".
	    "$lannode_switch2switch_speed $lannode_switch2switch_links\n";
209
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
210
}
211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233


# Print out links
sub get_iface {
    ($node,$card,$port) = @_;
    if (defined($interfacemap{"$node:$card:$port"})) {
	return $interfacemap{"$node:$card:$port"};
    } else {
	# shark hack
	if ($node =~ /^sh/) {
	    return "eth0";
	} else {
	    return "(null)";
	}
	# end shark hack 
    }
};

# Find the bandwidth for an interface
sub get_ifacebw {
    ($node,$card,$port) = @_;
    if (defined($interfacetypes{"$node:$card:$port"})) {
	return $interfacespeeds{$interfacetypes{"$node:$card:$port"}};
234 235 236
    }
    else {
	return $default_switchport_speed;
237 238
    }
}