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";
}