ptopgen.in 3.8 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
# Settings - Change these to your particular network.

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
10
11
12
13
use DBI;
my $TBDB = "@TBDBNAME@";
my $dbh = DBI->connect("DBI:mysql:database=$TBDB;host=localhost");

14
%switches=();
15
16
%used_switches=();

17
18
19
20
21
# Read class/type maps
$sth = $dbh->prepare("select class,type,delay_capacity from node_types");
$sth->execute;
while (($class,$type,$delaycapacity) = $sth->fetchrow_array) {
    $classes{$type} = $class;
22
    $nodetypes{$type} = $delaycapacity;
23
24
25
26
27
28
}
$sth->finish;

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

29
30
31
32
33
34
35
36
# Print switches
$sth = $dbh->prepare("select node_id from nodes where role = \"testswitch\"");
$sth->execute;
while (($switch) = $sth->fetchrow_array) {
    print "node $switch switch:1\n";
    $switches{$switch} = 1;
}
$sth->finish;
37

Leigh B. Stoller's avatar
Leigh B. Stoller committed
38
39
40
41
# 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" .
42
		     " where b.node_id is null and a.role = \"testnode\"");
43
$sth->execute;		
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
45
46
47
48
49
50
51
52
53
54
55
56
while (($node,$type) = $sth->fetchrow_array) {
    # Shark hack
    if (($shelf,$number) = ($node =~ /^sh(\d+)-(\d+)/)) {
	if ($number == 1) {
	    $nodes{"sh$shelf"} = "shark-shelf";
	}
    } else {
	$nodes{$node} = $type;
    }
}
$sth->finish;


57
$sharklinks = "";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
58
59
60
foreach $node (keys(%nodes)) {
    if ($node =~ /^sh/) {
	print "node $node shark-shelf:1\n";
61
	$sharklinks .= "link link-$node $node:$node/eth0 cisco1 100 1\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
62
    } else {
63
64
65
66
	$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
67
68
69
70
71
	}
	print "$text\n";
    }
}

72
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
# 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;
    }
};

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

print $sharklinks;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
139
# Add a bunch of LANs
140
141
142
143
144
145
foreach $switch (keys(%used_switches)) {
    for ($i = 0;$i <= 20;$i++) {
	print "node lan-$switch-$i lan:1\n";
	print "link link-lan-$switch-$i lan-$switch-${i}:lan-$switch-$i" .
	    " $switch 100000 1000\n";
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
146
}