ptopgen.in 3.61 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2
#!/usr/bin/perl -w

3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
# Settings - Change these to your particular network.

# Switch interface speed - In Mbps
$switch_speed = 100;

# Switch types - include all node types that are switches
%switch_types = (
		 'cisco', 1,
		 );

# Omit types - Include all types of node that will never be used.
%omit_types = (
	       'APC', 1,
	       );

######################################################################

Leigh B. Stoller's avatar
Leigh B. Stoller committed
20 21 22 23 24 25 26 27
use DBI;
my $TBDB = "@TBDBNAME@";
my $dbh = DBI->connect("DBI:mysql:database=$TBDB;host=localhost");

# Find available nodes
$sth = $dbh->prepare("select a.node_id,a.type from" .
		     " nodes as a left join reserved as b" .
		     " on a.node_id=b.node_id" .
28 29
		     " where b.node_id is null");
$sth->execute;		
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30
while (($node,$type) = $sth->fetchrow_array) {
31 32
    if (defined($omit_types{$type})) {next;}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
33 34 35 36 37 38
    # Shark hack
    if (($shelf,$number) = ($node =~ /^sh(\d+)-(\d+)/)) {
	if ($number == 1) {
	    $nodes{"sh$shelf"} = "shark-shelf";
	}
    } else {
39 40 41
	if (defined($switch_types{$type})) {
	    $type = "switch";
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42 43 44 45 46 47 48
	$nodes{$node} = $type;
	$nodetypes{$type} = 1;
    }
}
$sth->finish;

foreach $type (keys(%nodetypes)) {
49
    $sth = $dbh->prepare("SELECT delay_capacity" .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
50 51
			 " from node_types where type = \"$type\"");
    $sth->execute;
52 53
    ($delaycapacity) = $sth->fetchrow_array;
    $nodetypes{$type} = $delaycapacity;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
54 55
    $sth->finish;
}
56
$nodetypes{"switch"} = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
57

58
$sharklinks = "";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
59 60 61
foreach $node (keys(%nodes)) {
    if ($node =~ /^sh/) {
	print "node $node shark-shelf:1\n";
62
	$sharklinks .= "link link-$node $node:$node/eth0 cisco 100 1\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
63 64
    } else {
	$text = "node $node $nodes{$node}:1";
65
	$delay_capacity = $nodetypes{$nodes{$node}};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
66 67 68 69 70 71 72
	if ($delay_capacity > 0) {
	    $text .= " delay:$delay_capacity";
	}
	print "$text\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 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
# Read interfaces
$sth = $dbh->prepare("SELECT node_id,card,port,iface,interface_type" .
		     " from interfaces");
$sth->execute;
while (($node,$card,$port,$iface,$type) = $sth->fetchrow_array) {
    $interfacemap{"$node:$card:$port"} = $iface;
    if ($type ne "") {
	$interfacetypes{"$node:$card:$port"} = $type;
    }
}
$sth->finish;

# Read interface types
$sth = $dbh->prepare("SELECT type,max_speed from interface_types");
$sth->execute;
while (($type,$speed) = $sth->fetchrow_array) {
    $interfacespeeds{$type} = $speed;
}
$sth->finish;

# Print out links
sub get_iface {
    ($node,$card,$port) = @_;
    if (defined($interfacemap{"$node:$card:$port"})) {
	return $interfacemap{"$node:$card:$port"};
    } else {
	return "(null)";
    }
};
sub get_ifacebw {
    ($node,$card,$port) = @_;
    if (defined($interfacetypes{"$node:$card:$port"})) {
	return $interfacespeeds{$interfacetypes{"$node:$card:$port"}};
    } else {
	return $switch_speed;
    }
};

$sth = $dbh->prepare("SELECT type,node_id1,card1,port1,node_id2,card2,port2" .
 		    " from wires where type=\"Node\"");
$sth->execute;
while (($type,$node1,$card1,$port1,$node2,$card2,$port2) = 
       $sth->fetchrow_array) {
116 117 118 119 120 121 122 123 124 125 126 127 128 129
    if (defined($nodes{$node1}) && defined($nodes{$node2})) {
	$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;
	}
	# !!! - 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";
130 131 132 133 134 135
    }
}
$sth->finish;

print $sharklinks;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
136 137 138 139 140 141 142
# Add a bunch of LANs
for ($i = 0;$i <= 100;$i++) {
    print "node lan$i lan:1\n";
    print "link link-lan$i lan${i}:lan$i cisco 100000 1000\n";
}