ptopgen.in 3.56 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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
# 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) {
    $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"
}
$sth->finish;

print $sharklinks;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
134 135 136 137 138 139 140
# 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";
}