line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
########################################################################## |
2
|
|
|
|
|
|
|
# Copyright (c) 2010-2021 Alexander Bluhm |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Permission to use, copy, modify, and distribute this software for any |
5
|
|
|
|
|
|
|
# purpose with or without fee is hereby granted, provided that the above |
6
|
|
|
|
|
|
|
# copyright notice and this permission notice appear in all copies. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES |
9
|
|
|
|
|
|
|
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF |
10
|
|
|
|
|
|
|
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR |
11
|
|
|
|
|
|
|
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES |
12
|
|
|
|
|
|
|
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN |
13
|
|
|
|
|
|
|
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF |
14
|
|
|
|
|
|
|
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. |
15
|
|
|
|
|
|
|
########################################################################## |
16
|
|
|
|
|
|
|
|
17
|
13
|
|
|
13
|
|
3188
|
use strict; |
|
13
|
|
|
|
|
27
|
|
|
13
|
|
|
|
|
348
|
|
18
|
13
|
|
|
13
|
|
57
|
use warnings; |
|
13
|
|
|
|
|
22
|
|
|
13
|
|
|
|
|
570
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=pod |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
OSPF::LSDB::View - display OSPF database as graphviz dot |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 SYNOPSIS |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
use OSPF::LSDB; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use OSPF::LSDB::View; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $ospf = OSPF::LSDB-Enew(); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $view = OSPF::LSDB::View-Enew($ospf); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $dot = view-Egraph(); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 DESCRIPTION |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
The OSPF::LSDB::View module converts the content of a L |
41
|
|
|
|
|
|
|
instance into a graphviz dot string. |
42
|
|
|
|
|
|
|
Routers and Networks become nodes, the links between them are |
43
|
|
|
|
|
|
|
directed edges. |
44
|
|
|
|
|
|
|
The different OSPF vertices are displayed with drawing styles that |
45
|
|
|
|
|
|
|
are documented in the legend. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
During conversion the link state database is checked. |
48
|
|
|
|
|
|
|
Each inconsistency is reported as L error and the color |
49
|
|
|
|
|
|
|
of the object changes. |
50
|
|
|
|
|
|
|
The colors are prioritized by severity. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=over 8 |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=item gray |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
All areas and ASE have unique gray levels. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=item black |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Vertex is in multiple areas. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=item purple |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
An area is not in the list of all areas. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=item tan |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Asymmetric designated router. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item brown |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Asymmetric links. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item cyan |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Conflicting AS external network. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item green |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Conflicting stub network. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item blue |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Conflicting network. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=item orange |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Conflicting area. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=item yellow |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Multiple links. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item magenta |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Conflicting link. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=item red |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Missing node. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=back |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
Normally the L copy constructor creates the object. |
105
|
|
|
|
|
|
|
The public methods are: |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
package OSPF::LSDB::View; |
110
|
13
|
|
|
13
|
|
57
|
use base 'OSPF::LSDB'; |
|
13
|
|
|
|
|
25
|
|
|
13
|
|
|
|
|
3812
|
|
111
|
13
|
|
|
13
|
|
6510
|
use List::MoreUtils qw(uniq); |
|
13
|
|
|
|
|
145601
|
|
|
13
|
|
|
|
|
78
|
|
112
|
13
|
|
|
|
|
130
|
use fields qw ( |
113
|
|
|
|
|
|
|
routehash |
114
|
|
|
|
|
|
|
pointtopointhash transithash transitnets stubhash stubs stubareas |
115
|
|
|
|
|
|
|
virtualhash ifaddrs |
116
|
|
|
|
|
|
|
nethash nets netareas |
117
|
|
|
|
|
|
|
sumhash sums sumaggr |
118
|
|
|
|
|
|
|
boundhash boundaggr |
119
|
|
|
|
|
|
|
externhash externaggr |
120
|
|
|
|
|
|
|
netcluster transitcluster |
121
|
|
|
|
|
|
|
areagrays |
122
|
|
|
|
|
|
|
todo |
123
|
13
|
|
|
13
|
|
11026
|
); |
|
13
|
|
|
|
|
24
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub new { |
126
|
113
|
|
|
113
|
1
|
93102
|
my OSPF::LSDB::View $self = OSPF::LSDB::new(@_); |
127
|
113
|
100
|
|
|
|
307
|
die "$_[0] does not support IPv6" if $self->ipv6(); |
128
|
112
|
|
|
|
|
240
|
return $self; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# convert decimal dotted IPv4 address to packed format |
132
|
2582
|
|
|
2582
|
|
10136
|
sub _ip2pack($) { pack("CCCC", split(/\./, $_[0])) } |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# convert packed IPv4 address to decimal dotted format |
135
|
966
|
|
|
966
|
|
3352
|
sub _pack2ip($) { join('.', unpack("CCCC", $_[0])) } |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# mask decimal dotted IPv4 network with decimal dotted IPv4 netmask |
138
|
966
|
|
|
966
|
|
1398
|
sub _maskip($$) { _pack2ip(_ip2pack($_[0]) & _ip2pack($_[1])) } |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# compare function for sorting decimal dotted IPv4 address |
141
|
143
|
|
|
143
|
|
267
|
sub _cmp_ip { unpack("N",_ip2pack($a)) <=> unpack("N",_ip2pack($b)) } |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# compare function for sorting IPv4 address / netmask |
144
|
|
|
|
|
|
|
sub _cmp_ip_net { |
145
|
182
|
|
|
182
|
|
331
|
my @a = split(/\//, $a); |
146
|
182
|
|
|
|
|
248
|
my @b = split(/\//, $b); |
147
|
182
|
|
33
|
|
|
225
|
return unpack("N",_ip2pack($a[0])) <=> unpack("N",_ip2pack($b[0])) || |
148
|
|
|
|
|
|
|
unpack("N",_ip2pack($a[1])) <=> unpack("N",_ip2pack($b[1])); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# take list of all areas |
152
|
|
|
|
|
|
|
# create hash mapping from area to gray color |
153
|
|
|
|
|
|
|
sub create_area_grays { |
154
|
183
|
|
|
183
|
0
|
229
|
my OSPF::LSDB::View $self = shift; |
155
|
183
|
50
|
|
|
|
386
|
my $ospf = $self->{ospf} or die "Uninitialized member"; |
156
|
183
|
|
|
|
|
236
|
my @areas = sort _cmp_ip @{$ospf->{self}{areas}}; |
|
183
|
|
|
|
|
735
|
|
157
|
183
|
|
|
|
|
439
|
my @colors = map { "gray". int(50 + ($_* 50 / @areas)) } (0..$#areas); |
|
283
|
|
|
|
|
977
|
|
158
|
183
|
|
|
|
|
321
|
my %areagrays; |
159
|
183
|
|
|
|
|
473
|
@areagrays{@areas} = @colors; |
160
|
183
|
|
|
|
|
298
|
$areagrays{ase} = "gray35"; |
161
|
183
|
|
|
|
|
390
|
$self->{areagrays} = \%areagrays; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# each color gets a weight indicating the severity of its message |
165
|
|
|
|
|
|
|
my %COLORWEIGHT; |
166
|
|
|
|
|
|
|
@COLORWEIGHT{qw(black purple tan brown cyan green blue orange yellow magenta |
167
|
|
|
|
|
|
|
red)} = 1..100; |
168
|
|
|
|
|
|
|
@COLORWEIGHT{map { "gray$_" } 1..99} = -99..-1; |
169
|
|
|
|
|
|
|
$COLORWEIGHT{gray} = -100; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# take hash with color names and messages |
172
|
|
|
|
|
|
|
# return color name |
173
|
|
|
|
|
|
|
sub colors2string { |
174
|
1990
|
|
|
1990
|
0
|
2183
|
my OSPF::LSDB::View $self = shift; |
175
|
1990
|
|
|
|
|
2477
|
my($colors) = @_; |
176
|
1990
|
100
|
|
|
|
3148
|
if (my $area = $colors->{gray}) { |
177
|
1875
|
50
|
|
|
|
2972
|
my $areagrays = $self->{areagrays} or die "Uninitialized member"; |
178
|
1875
|
|
|
|
|
2187
|
my $gray = $areagrays->{$area}; |
179
|
1875
|
|
|
|
|
1929
|
delete $colors->{purple}; |
180
|
1875
|
50
|
|
|
|
2466
|
if (! $gray) { |
181
|
0
|
|
|
|
|
0
|
$self->error($colors->{purple} = "Unexpected area $area."); |
182
|
|
|
|
|
|
|
} else { |
183
|
1875
|
100
|
|
|
|
3909
|
$colors->{$gray} = $area eq "ase" ? "AS external" : "Area: $area"; |
184
|
1875
|
|
|
|
|
2669
|
delete $colors->{gray}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
1990
|
100
|
|
|
|
2015
|
if (my @areas = uniq @{$colors->{black} || []}) { |
|
1990
|
100
|
|
|
|
7372
|
|
188
|
115
|
|
|
|
|
347
|
$colors->{black} = "Areas: @areas"; |
189
|
|
|
|
|
|
|
} |
190
|
1990
|
|
|
|
|
5809
|
return (sort { $COLORWEIGHT{$a} <=> $COLORWEIGHT{$b} } keys %$colors)[-1]; |
|
308
|
|
|
|
|
792
|
|
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
######################################################################## |
194
|
|
|
|
|
|
|
# RFC 2328 |
195
|
|
|
|
|
|
|
# LS LSA LSA description |
196
|
|
|
|
|
|
|
# type name |
197
|
|
|
|
|
|
|
# ________________________________________________________ |
198
|
|
|
|
|
|
|
# 1 Router-LSAs Originated by all routers. |
199
|
|
|
|
|
|
|
# This LSA describes |
200
|
|
|
|
|
|
|
# the collected states of the |
201
|
|
|
|
|
|
|
# router's interfaces to an |
202
|
|
|
|
|
|
|
# area. Flooded throughout a |
203
|
|
|
|
|
|
|
# single area only. |
204
|
|
|
|
|
|
|
######################################################################## |
205
|
|
|
|
|
|
|
# routers => [ { |
206
|
|
|
|
|
|
|
# area => 'ipv4', |
207
|
|
|
|
|
|
|
# bits => { |
208
|
|
|
|
|
|
|
# B => 'int', # bit B |
209
|
|
|
|
|
|
|
# E => 'int', # bit E |
210
|
|
|
|
|
|
|
# V => 'int', # bit V |
211
|
|
|
|
|
|
|
# }, |
212
|
|
|
|
|
|
|
# pointtopoints => [], # Point-to-point connection to another router |
213
|
|
|
|
|
|
|
# transits => [], # Connection to a transit network |
214
|
|
|
|
|
|
|
# stubs => [], # Connection to a stub network |
215
|
|
|
|
|
|
|
# virtuals => [], # Virtual link |
216
|
|
|
|
|
|
|
# router => 'ipv4', # Link State ID |
217
|
|
|
|
|
|
|
# routerid => 'ipv4', # Advertising Router |
218
|
|
|
|
|
|
|
# ], |
219
|
|
|
|
|
|
|
######################################################################## |
220
|
|
|
|
|
|
|
# $routehash{$router} = { |
221
|
|
|
|
|
|
|
# graph => { N => router10, color => red, style => solid, } |
222
|
|
|
|
|
|
|
# hashes => [ { router hash } ] |
223
|
|
|
|
|
|
|
# areas => { $area => 1 } |
224
|
|
|
|
|
|
|
# missing => 1 (optional) |
225
|
|
|
|
|
|
|
# } |
226
|
|
|
|
|
|
|
# check wether interface addresses are used more than once |
227
|
|
|
|
|
|
|
# $ifaddrs{$interface}{$router}++ |
228
|
|
|
|
|
|
|
######################################################################## |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# take router hash |
231
|
|
|
|
|
|
|
# detect inconsistencies and set colors |
232
|
|
|
|
|
|
|
sub check_router { |
233
|
112
|
|
|
112
|
0
|
146
|
my OSPF::LSDB::View $self = shift; |
234
|
112
|
50
|
|
|
|
212
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
235
|
112
|
|
|
|
|
342
|
while (my($rid,$rv) = each %$routehash) { |
236
|
252
|
|
|
|
|
289
|
my %colors; |
237
|
252
|
|
|
|
|
250
|
my @areas = sort keys %{$rv->{areas}}; |
|
252
|
|
|
|
|
624
|
|
238
|
252
|
100
|
|
|
|
446
|
if (@areas > 1) { |
239
|
49
|
|
|
|
|
107
|
$colors{black} = \@areas; |
240
|
49
|
100
|
|
|
|
104
|
if (my @badareas = map { $_->{area} || () } |
|
4
|
100
|
|
|
|
29
|
|
241
|
100
|
|
|
|
|
238
|
grep { ! $_->{bits}{B} } @{$rv->{hashes}}) { |
|
49
|
|
|
|
|
86
|
|
242
|
|
|
|
|
|
|
$self->error($colors{orange} = |
243
|
1
|
|
|
|
|
9
|
"Router $rid in multiple areas is not border router ". |
244
|
|
|
|
|
|
|
"in areas @badareas."); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} else { |
247
|
203
|
|
|
|
|
375
|
$colors{gray} = $areas[0]; |
248
|
|
|
|
|
|
|
} |
249
|
252
|
100
|
|
|
|
340
|
if (my @badareas = grep { $rv->{areas}{$_} > 1 } @areas) { |
|
306
|
|
|
|
|
735
|
|
250
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
251
|
1
|
|
|
|
|
7
|
"Router $rid has multiple entries in areas @badareas."); |
252
|
|
|
|
|
|
|
} |
253
|
252
|
100
|
|
|
|
406
|
if ($rv->{missing}) { |
|
|
100
|
|
|
|
|
|
254
|
13
|
|
|
|
|
63
|
$self->error($colors{red} = "Router $rid missing."); |
255
|
291
|
|
|
|
|
587
|
} elsif (my @badids = grep { $_ ne $rid } map { $_->{routerid} } |
|
291
|
|
|
|
|
477
|
|
256
|
239
|
|
|
|
|
358
|
@{$rv->{hashes}}) { |
257
|
|
|
|
|
|
|
$self->error($colors{magenta} = |
258
|
1
|
|
|
|
|
8
|
"Router $rid advertized by @badids."); |
259
|
|
|
|
|
|
|
} |
260
|
252
|
|
|
|
|
825
|
$rv->{colors} = \%colors; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# take router structure, router id |
265
|
|
|
|
|
|
|
# create routehash |
266
|
|
|
|
|
|
|
# create pointtopointhash transithash transitnets stubhash stubs stubareas |
267
|
|
|
|
|
|
|
# virtualhash |
268
|
|
|
|
|
|
|
sub create_router { |
269
|
183
|
|
|
183
|
0
|
215
|
my OSPF::LSDB::View $self = shift; |
270
|
183
|
|
|
|
|
252
|
my($index) = @_; |
271
|
183
|
|
|
|
|
311
|
my $routerid = $self->{ospf}{self}{routerid}; |
272
|
183
|
|
|
|
|
930
|
my %routehash; |
273
|
|
|
|
|
|
|
my %pointtopointhash; |
274
|
183
|
|
|
|
|
0
|
my %transithash; |
275
|
183
|
|
|
|
|
0
|
my %transitnets; |
276
|
183
|
|
|
|
|
0
|
my %stubhash; |
277
|
183
|
|
|
|
|
0
|
my %stubs; |
278
|
183
|
|
|
|
|
0
|
my %stubareas; |
279
|
183
|
|
|
|
|
0
|
my %virtualhash; |
280
|
183
|
|
|
|
|
281
|
my($transitindex, $stubindex) = (0, 0); |
281
|
183
|
|
|
|
|
198
|
foreach my $r (@{$self->{ospf}{database}{routers}}) { |
|
183
|
|
|
|
|
353
|
|
282
|
453
|
100
|
|
|
|
839
|
my $rid = $self->ipv6 ? $r->{routerid} : $r->{router}; |
283
|
453
|
|
|
|
|
586
|
my $area = $r->{area}; |
284
|
453
|
|
|
|
|
520
|
my $bits = $r->{bits}; |
285
|
453
|
|
|
|
|
561
|
my $elem = $routehash{$rid}; |
286
|
453
|
100
|
|
|
|
768
|
if (! $elem) { |
287
|
373
|
|
|
|
|
672
|
$routehash{$rid} = $elem = {}; |
288
|
|
|
|
|
|
|
$elem->{graph} = { |
289
|
|
|
|
|
|
|
N => "router$$index", |
290
|
|
|
|
|
|
|
label => $rid, |
291
|
|
|
|
|
|
|
shape => "box", |
292
|
373
|
100
|
|
|
|
1505
|
style => $bits->{B} ? "bold" : "solid", |
293
|
|
|
|
|
|
|
}; |
294
|
373
|
|
|
|
|
690
|
$elem->{index} = $$index++; |
295
|
373
|
100
|
|
|
|
714
|
if ($rid eq $routerid) { |
296
|
172
|
|
|
|
|
264
|
$elem->{graph}{peripheries} = 2; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
} |
299
|
453
|
|
|
|
|
471
|
push @{$elem->{hashes}}, $r; |
|
453
|
|
|
|
|
736
|
|
300
|
453
|
100
|
|
|
|
859
|
if ($self->ipv6) { |
301
|
162
|
|
|
|
|
189
|
my $lsid = $r->{router}; |
302
|
162
|
|
|
|
|
328
|
$elem->{areas}{$area}{$lsid}++; |
303
|
|
|
|
|
|
|
} else { |
304
|
291
|
|
|
|
|
493
|
$elem->{areas}{$area}++; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
453
|
|
|
|
|
510
|
foreach my $l (@{$r->{pointtopoints}}) { |
|
453
|
|
|
|
|
714
|
|
308
|
40
|
|
|
|
|
97
|
$self->add_router_value(\%pointtopointhash, $rid, $area, $l); |
309
|
40
|
|
|
|
|
139
|
$self->{ifaddrs}{$l->{interface}}{$rid}++; |
310
|
|
|
|
|
|
|
} |
311
|
453
|
|
|
|
|
491
|
foreach my $l (@{$r->{transits}}) { |
|
453
|
|
|
|
|
609
|
|
312
|
301
|
|
|
|
|
794
|
$self->add_transit_value(\%transithash, \%transitnets, |
313
|
|
|
|
|
|
|
\$transitindex, $rid, $area, $l); |
314
|
301
|
|
|
|
|
770
|
$self->{ifaddrs}{$l->{interface}}{$rid}++; |
315
|
|
|
|
|
|
|
} |
316
|
453
|
|
|
|
|
554
|
foreach my $l (@{$r->{stubs}}) { |
|
453
|
|
|
|
|
723
|
|
317
|
36
|
|
|
|
|
101
|
$self->add_stub_value(\%stubhash, \%stubs, \%stubareas, |
318
|
|
|
|
|
|
|
\$stubindex, $rid, $area, $l); |
319
|
|
|
|
|
|
|
} |
320
|
453
|
|
|
|
|
551
|
foreach my $l (@{$r->{virtuals}}) { |
|
453
|
|
|
|
|
752
|
|
321
|
40
|
|
|
|
|
79
|
$self->add_router_value(\%virtualhash, $rid, $area, $l); |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
} |
324
|
183
|
|
|
|
|
290
|
$self->{routehash} = \%routehash; |
325
|
183
|
|
|
|
|
278
|
$self->{pointtopointhash} = \%pointtopointhash; |
326
|
183
|
|
|
|
|
255
|
$self->{transithash} = \%transithash; |
327
|
183
|
|
|
|
|
233
|
$self->{transitnets} = \%transitnets; |
328
|
183
|
100
|
|
|
|
336
|
$self->{stubhash} = \%stubhash unless $self->ipv6; |
329
|
183
|
100
|
|
|
|
359
|
$self->{stubs} = \%stubs unless $self->ipv6; |
330
|
183
|
100
|
|
|
|
329
|
$self->{stubareas} = \%stubareas unless $self->ipv6; |
331
|
183
|
|
|
|
|
487
|
$self->{virtualhash} = \%virtualhash; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# take router hash, routerid, |
335
|
|
|
|
|
|
|
# network hash, summary hash, boundary hash, external hash |
336
|
|
|
|
|
|
|
# add missing routers to router hash |
337
|
|
|
|
|
|
|
sub add_missing_router { |
338
|
112
|
|
|
112
|
0
|
159
|
my OSPF::LSDB::View $self = shift; |
339
|
112
|
|
|
|
|
164
|
my($index) = @_; |
340
|
112
|
|
|
|
|
161
|
my %rid2areas; |
341
|
112
|
50
|
|
|
|
228
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
342
|
92
|
|
|
|
|
117
|
my @hashes = map { @{$_->{hashes}} } map { values %$_ } |
|
92
|
|
|
|
|
179
|
|
|
91
|
|
|
|
|
156
|
|
343
|
112
|
|
|
|
|
269
|
map { values %$_ } map { values %$_ } values %$nethash; |
|
89
|
|
|
|
|
134
|
|
|
88
|
|
|
|
|
149
|
|
344
|
112
|
|
|
|
|
176
|
foreach my $n (@hashes) { |
345
|
94
|
|
|
|
|
135
|
my $area = $n->{area}; |
346
|
94
|
|
|
|
|
183
|
$rid2areas{$n->{routerid}}{$area} = 1; |
347
|
94
|
|
|
|
|
106
|
foreach (@{$n->{attachments}}) { |
|
94
|
|
|
|
|
155
|
|
348
|
196
|
|
|
|
|
341
|
$rid2areas{$_->{routerid}}{$area} = 1; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
112
|
|
|
|
|
261
|
$self->add_missing_router_common($index, %rid2areas); |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub add_missing_router_common { |
355
|
183
|
|
|
183
|
0
|
259
|
my OSPF::LSDB::View $self = shift; |
356
|
183
|
|
|
|
|
517
|
my($index, %rid2areas) = @_; |
357
|
183
|
|
|
|
|
273
|
my $boundhash = $self->{boundhash}; |
358
|
183
|
|
|
|
|
243
|
my $externhash = $self->{externhash}; |
359
|
99
|
|
|
|
|
113
|
my @rids = map { keys %{$_->{routers}} } |
|
99
|
|
|
|
|
224
|
|
360
|
183
|
|
|
|
|
366
|
map { values %$_ } values %$externhash; |
|
99
|
|
|
|
|
184
|
|
361
|
183
|
|
|
|
|
327
|
foreach my $rid (@rids) { |
362
|
|
|
|
|
|
|
# if ase is conneted to boundary router, router is not missing |
363
|
153
|
100
|
|
|
|
247
|
next if $boundhash->{$rid}; |
364
|
43
|
|
|
|
|
95
|
$rid2areas{$rid}{ase} = 1; |
365
|
|
|
|
|
|
|
} |
366
|
183
|
|
|
|
|
232
|
my $sumhash = $self->{sumhash}; |
367
|
165
|
|
|
|
|
246
|
my @arearids = map { $_->{arearids} } |
368
|
183
|
|
|
|
|
401
|
(values %$boundhash, map { values %$_ } values %$sumhash); |
|
64
|
|
|
|
|
130
|
|
369
|
183
|
|
|
|
|
288
|
foreach my $ar (@arearids) { |
370
|
165
|
|
|
|
|
466
|
while (my($area,$av) = each %$ar) { |
371
|
226
|
|
|
|
|
479
|
while (my($rid,$num) = each %$av) { |
372
|
376
|
|
|
|
|
1007
|
$rid2areas{$rid}{$area} = 1; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
183
|
|
|
|
|
252
|
foreach my $type (qw(pointtopoint virtual)) { |
377
|
366
|
50
|
|
|
|
884
|
my $linkhash = $self->{$type."hash"} or die "Uninitialized member"; |
378
|
366
|
|
|
|
|
920
|
while (my($dstrid,$dv) = each %$linkhash) { |
379
|
74
|
|
|
|
|
185
|
while (my($area,$av) = each %$dv) { |
380
|
74
|
|
|
|
|
295
|
$rid2areas{$dstrid}{$area} = 1; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
} |
384
|
183
|
|
|
|
|
359
|
my $routerid = $self->{ospf}{self}{routerid}; |
385
|
183
|
50
|
|
|
|
390
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
386
|
183
|
|
|
|
|
532
|
foreach my $rid (sort keys %rid2areas) { |
387
|
346
|
|
|
|
|
420
|
my $rv = $rid2areas{$rid}; |
388
|
346
|
|
|
|
|
384
|
my $elem = $routehash->{$rid}; |
389
|
346
|
100
|
|
|
|
941
|
if (! $elem) { |
390
|
25
|
|
|
|
|
43
|
$routehash->{$rid} = $elem = {}; |
391
|
|
|
|
|
|
|
$elem->{graph} = { |
392
|
25
|
|
|
|
|
104
|
N => "router$$index", |
393
|
|
|
|
|
|
|
label => $rid, |
394
|
|
|
|
|
|
|
shape => "box", |
395
|
|
|
|
|
|
|
style => "dotted", |
396
|
|
|
|
|
|
|
}; |
397
|
25
|
|
|
|
|
59
|
$elem->{index} = $$index++; |
398
|
25
|
100
|
|
|
|
58
|
if ($rid eq $routerid) { |
399
|
11
|
|
|
|
|
21
|
$elem->{graph}{peripheries} = 2; |
400
|
|
|
|
|
|
|
} |
401
|
25
|
|
|
|
|
31
|
push @{$elem->{hashes}}, {}; |
|
25
|
|
|
|
|
48
|
|
402
|
25
|
|
|
|
|
37
|
$elem->{areas} = $rv; |
403
|
25
|
|
|
|
|
79
|
$elem->{missing}++; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
# take router hash, boundary hash |
409
|
|
|
|
|
|
|
# remove duplicate routers from boundary hash |
410
|
|
|
|
|
|
|
sub remove_duplicate_router { |
411
|
183
|
|
|
183
|
0
|
249
|
my OSPF::LSDB::View $self = shift; |
412
|
183
|
50
|
|
|
|
338
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
413
|
183
|
|
|
|
|
225
|
my $boundhash = $self->{boundhash}; |
414
|
|
|
|
|
|
|
# if AS boundary router is also regular router, only use the regular |
415
|
183
|
|
|
|
|
410
|
while (my($asbr,$bv) = each %$boundhash) { |
416
|
101
|
100
|
|
|
|
236
|
if ($routehash->{$asbr}) { |
417
|
34
|
|
|
|
|
97
|
delete $bv->{graph}; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# take hash containing router nodes |
423
|
|
|
|
|
|
|
# return list of nodes |
424
|
|
|
|
|
|
|
sub router2nodes { |
425
|
183
|
|
|
183
|
0
|
215
|
my OSPF::LSDB::View $self = shift; |
426
|
183
|
50
|
|
|
|
329
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
427
|
183
|
|
|
|
|
409
|
return $self->elements2graphs(values %$routehash); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
######################################################################## |
431
|
|
|
|
|
|
|
# RFC 2328 |
432
|
|
|
|
|
|
|
# Type Description |
433
|
|
|
|
|
|
|
# __________________________________________________ |
434
|
|
|
|
|
|
|
# 1 Point-to-point connection to another router |
435
|
|
|
|
|
|
|
######################################################################## |
436
|
|
|
|
|
|
|
# pointtopoints => [ { |
437
|
|
|
|
|
|
|
# interface => 'ipv4', # Link Data |
438
|
|
|
|
|
|
|
# # interface's ifIndex value |
439
|
|
|
|
|
|
|
# metric => 'int', # metric |
440
|
|
|
|
|
|
|
# routerid => 'ipv4', # Link ID |
441
|
|
|
|
|
|
|
# # Neighboring router's Router ID |
442
|
|
|
|
|
|
|
# ], |
443
|
|
|
|
|
|
|
######################################################################## |
444
|
|
|
|
|
|
|
# $pointtopointhash{$pointtopointrouterid}{$area}{$routerid} = { |
445
|
|
|
|
|
|
|
# hashes => [ { link hash } ] |
446
|
|
|
|
|
|
|
# } |
447
|
|
|
|
|
|
|
######################################################################## |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
######################################################################## |
450
|
|
|
|
|
|
|
# RFC 2328 |
451
|
|
|
|
|
|
|
# Type Description |
452
|
|
|
|
|
|
|
# __________________________________________________ |
453
|
|
|
|
|
|
|
# 4 Virtual link |
454
|
|
|
|
|
|
|
######################################################################## |
455
|
|
|
|
|
|
|
# virtuals => [ { |
456
|
|
|
|
|
|
|
# interface => 'ipv4', # Link Data |
457
|
|
|
|
|
|
|
# # router interface's IP address |
458
|
|
|
|
|
|
|
# metric => 'int', # metric |
459
|
|
|
|
|
|
|
# routerid => 'ipv4', # Link ID |
460
|
|
|
|
|
|
|
# # Neighboring router's Router ID |
461
|
|
|
|
|
|
|
# ], |
462
|
|
|
|
|
|
|
######################################################################## |
463
|
|
|
|
|
|
|
# $virtualhash{$virtualrouterid}{$area}{$routerid} = { |
464
|
|
|
|
|
|
|
# hashes => [ { link hash } ] |
465
|
|
|
|
|
|
|
# } |
466
|
|
|
|
|
|
|
######################################################################## |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# take pointtopoint or virtual hash, type, router id, area, link structure |
469
|
|
|
|
|
|
|
# add new element to pointtopoint or virtual hash |
470
|
|
|
|
|
|
|
sub add_router_value { |
471
|
80
|
|
|
80
|
0
|
99
|
my OSPF::LSDB::View $self = shift; |
472
|
80
|
|
|
|
|
136
|
my($linkhash, $rid, $area, $link) = @_; |
473
|
80
|
|
|
|
|
103
|
my $dstrid = $link->{routerid}; |
474
|
80
|
|
|
|
|
146
|
my $elem = $linkhash->{$dstrid}{$area}{$rid}; |
475
|
80
|
100
|
|
|
|
173
|
if (! $elem) { |
476
|
74
|
|
|
|
|
142
|
$linkhash->{$dstrid}{$area}{$rid} = $elem = {}; |
477
|
|
|
|
|
|
|
} |
478
|
80
|
|
|
|
|
101
|
push @{$elem->{hashes}}, $link; |
|
80
|
|
|
|
|
193
|
|
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# take link hash, type (pointtopoint or virtual), router hash |
482
|
|
|
|
|
|
|
# return list of edges from src router to dst router |
483
|
|
|
|
|
|
|
sub router2edges { |
484
|
224
|
|
|
224
|
0
|
297
|
my OSPF::LSDB::View $self = shift; |
485
|
224
|
|
|
|
|
325
|
my($type) = @_; |
486
|
224
|
100
|
|
|
|
382
|
my $name = $type eq "pointtopoint" ? "Point-to-point" : "Virtual"; |
487
|
224
|
100
|
|
|
|
346
|
my $style = $type eq "pointtopoint" ? "solid" : "dotted"; |
488
|
224
|
50
|
|
|
|
391
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
489
|
224
|
50
|
|
|
|
494
|
my $linkhash = $self->{$type."hash"} or die "Uninitialized member"; |
490
|
224
|
|
|
|
|
271
|
my $ifaddrs = $self->{ifaddrs}; |
491
|
224
|
|
|
|
|
1569
|
my @elements; |
492
|
224
|
|
|
|
|
283
|
my $index = 0; |
493
|
224
|
|
|
|
|
412
|
foreach my $dstrid (sort keys %$linkhash) { |
494
|
52
|
|
|
|
|
80
|
my $dv = $linkhash->{$dstrid}; |
495
|
52
|
|
|
|
|
154
|
foreach my $area (sort keys %$dv) { |
496
|
52
|
|
|
|
|
68
|
my $ev = $dv->{$area}; |
497
|
52
|
|
|
|
|
109
|
foreach my $rid (sort keys %$ev) { |
498
|
52
|
|
|
|
|
97
|
my $rv = $ev->{$rid}; |
499
|
52
|
|
|
|
|
103
|
my %colors = (gray => $area); |
500
|
52
|
|
|
|
|
85
|
my $src = $routehash->{$rid}{graph}{N}; |
501
|
52
|
|
|
|
|
143
|
my $dst = $routehash->{$dstrid}{graph}{N}; |
502
|
52
|
|
|
|
|
58
|
my @hashes = @{$rv->{hashes}}; |
|
52
|
|
|
|
|
89
|
|
503
|
52
|
100
|
100
|
|
|
184
|
if ($type ne "pointtopoint" && @hashes > 1) { |
504
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
505
|
2
|
|
|
|
|
17
|
"$name link at router $rid to router $dstrid ". |
506
|
|
|
|
|
|
|
"has multiple entries in area $area."); |
507
|
|
|
|
|
|
|
} |
508
|
52
|
100
|
100
|
|
|
305
|
if (! $routehash->{$dstrid}{areas}{$area}) { |
|
|
100
|
|
|
|
|
|
509
|
|
|
|
|
|
|
$self->error($colors{orange} = |
510
|
4
|
|
|
|
|
24
|
"$name link at router $rid to router $dstrid ". |
511
|
|
|
|
|
|
|
"not in same area $area."); |
512
|
|
|
|
|
|
|
} elsif (! ($linkhash->{$rid} && $linkhash->{$rid}{$area} && |
513
|
|
|
|
|
|
|
$linkhash->{$rid}{$area}{$dstrid}) && |
514
|
|
|
|
|
|
|
! $routehash->{$dstrid}{missing}) { |
515
|
|
|
|
|
|
|
$self->error($colors{brown} = |
516
|
2
|
|
|
|
|
17
|
"$name link at router $rid to router $dstrid ". |
517
|
|
|
|
|
|
|
"not symmetric in area $area."); |
518
|
|
|
|
|
|
|
} |
519
|
52
|
|
|
|
|
100
|
foreach my $link (@hashes) { |
520
|
55
|
|
|
|
|
73
|
my $intf = $link->{interface}; |
521
|
55
|
|
|
|
|
62
|
delete $colors{green}; |
522
|
55
|
100
|
66
|
|
|
172
|
if ($type eq "pointtopoint" and $ifaddrs->{$intf} && |
|
|
|
100
|
|
|
|
|
523
|
|
|
|
|
|
|
$ifaddrs->{$intf}{$rid} > 1) { |
524
|
|
|
|
|
|
|
$self->error($colors{green} = |
525
|
1
|
|
|
|
|
11
|
"$name link at router $rid to router $dstrid ". |
526
|
|
|
|
|
|
|
"interface address $intf not unique."); |
527
|
|
|
|
|
|
|
} |
528
|
55
|
|
|
|
|
67
|
delete $colors{blue}; |
529
|
55
|
100
|
100
|
|
|
123
|
if ($type eq "pointtopoint" and my @badrids = sort |
530
|
28
|
|
|
|
|
118
|
grep { $_ ne $rid } keys %{$ifaddrs->{$intf}}) { |
|
27
|
|
|
|
|
65
|
|
531
|
|
|
|
|
|
|
$self->error($colors{blue} = |
532
|
1
|
|
|
|
|
11
|
"$name link at router $rid to router $dstrid ". |
533
|
|
|
|
|
|
|
"interface address $intf also at router @badrids."); |
534
|
|
|
|
|
|
|
} |
535
|
55
|
|
|
|
|
81
|
my $metric = $link->{metric}; |
536
|
55
|
|
|
|
|
413
|
push @elements, { |
537
|
|
|
|
|
|
|
graph => { |
538
|
|
|
|
|
|
|
S => $src, |
539
|
|
|
|
|
|
|
D => $dst, |
540
|
|
|
|
|
|
|
label => $intf, |
541
|
|
|
|
|
|
|
style => $style, |
542
|
|
|
|
|
|
|
taillabel => $metric, |
543
|
|
|
|
|
|
|
}, |
544
|
|
|
|
|
|
|
colors => { %colors }, |
545
|
|
|
|
|
|
|
index => $index++, |
546
|
|
|
|
|
|
|
}; |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
} |
551
|
224
|
|
|
|
|
359
|
return $self->elements2graphs(@elements); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
######################################################################## |
555
|
|
|
|
|
|
|
# RFC 2328 |
556
|
|
|
|
|
|
|
# Type Description |
557
|
|
|
|
|
|
|
# __________________________________________________ |
558
|
|
|
|
|
|
|
# 2 Connection to a transit network |
559
|
|
|
|
|
|
|
######################################################################## |
560
|
|
|
|
|
|
|
# transits => [ { |
561
|
|
|
|
|
|
|
# address => 'ipv4', # Link ID |
562
|
|
|
|
|
|
|
# # IP address of Designated Router |
563
|
|
|
|
|
|
|
# interface => 'ipv4', # Link Data |
564
|
|
|
|
|
|
|
# # router interface's IP address |
565
|
|
|
|
|
|
|
# metric => 'int', # metric |
566
|
|
|
|
|
|
|
# ], |
567
|
|
|
|
|
|
|
######################################################################## |
568
|
|
|
|
|
|
|
# $transithash{$transitaddress}{$area}{$routerid} = { |
569
|
|
|
|
|
|
|
# graph => { N => transit2, color => red, style => solid, } (optional) |
570
|
|
|
|
|
|
|
# hashes => [ { link hash } ] |
571
|
|
|
|
|
|
|
# } |
572
|
|
|
|
|
|
|
# $transitnets->{$interface}{$routerid}{$area}{$address}++; |
573
|
|
|
|
|
|
|
######################################################################## |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# take transit hash, transit cluster hash, net hash |
576
|
|
|
|
|
|
|
# detect inconsistencies and set colors |
577
|
|
|
|
|
|
|
sub check_transit { |
578
|
112
|
|
|
112
|
0
|
139
|
my OSPF::LSDB::View $self = shift; |
579
|
112
|
|
|
|
|
148
|
my($transitcluster) = @_; |
580
|
112
|
50
|
|
|
|
208
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
581
|
112
|
50
|
|
|
|
209
|
my $transithash = $self->{transithash} or die "Uninitialized member"; |
582
|
112
|
|
|
|
|
298
|
foreach my $addr (sort keys %$transithash) { |
583
|
95
|
|
|
|
|
129
|
my $av = $transithash->{$addr}; |
584
|
95
|
|
|
|
|
111
|
my %colors; |
585
|
95
|
100
|
100
|
|
|
214
|
if (! $nethash->{$addr} && keys %$av > 1) { |
586
|
|
|
|
|
|
|
$self->error($colors{orange} = |
587
|
3
|
|
|
|
|
16
|
"Transit network $addr missing in multiple areas."); |
588
|
|
|
|
|
|
|
} |
589
|
95
|
|
|
|
|
178
|
foreach my $area (sort keys %$av) { |
590
|
101
|
|
|
|
|
147
|
my $ev = $av->{$area}; |
591
|
101
|
|
|
|
|
145
|
$colors{gray} = $area; |
592
|
101
|
|
|
|
|
125
|
delete $colors{blue}; |
593
|
101
|
100
|
100
|
|
|
204
|
if (! $nethash->{$addr} && keys %$ev > 1) { |
594
|
|
|
|
|
|
|
$self->error($colors{blue} = |
595
|
3
|
|
|
|
|
18
|
"Transit network $addr missing in area $area ". |
596
|
|
|
|
|
|
|
"at multiple routers."); |
597
|
|
|
|
|
|
|
} |
598
|
101
|
|
|
|
|
225
|
foreach my $rid (sort keys %$ev) { |
599
|
193
|
|
|
|
|
234
|
my $rv = $ev->{$rid}; |
600
|
193
|
100
|
|
|
|
463
|
next unless $rv->{graph}; |
601
|
15
|
|
|
|
|
26
|
delete @colors{qw(yellow red)}; |
602
|
15
|
100
|
100
|
|
|
60
|
if ($nethash->{$addr}) { |
|
|
100
|
|
|
|
|
|
603
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
604
|
1
|
|
|
|
|
16
|
"Transit network $addr in area $area ". |
605
|
|
|
|
|
|
|
"at router $rid and network not in same area."); |
606
|
|
|
|
|
|
|
} elsif (! $colors{orange} && ! $colors{blue}) { |
607
|
|
|
|
|
|
|
$self->error($colors{red} = |
608
|
3
|
|
|
|
|
16
|
"Transit network $addr network missing."); |
609
|
|
|
|
|
|
|
} |
610
|
15
|
|
|
|
|
24
|
%{$rv->{colors}} = %colors; |
|
15
|
|
|
|
|
35
|
|
611
|
15
|
|
|
|
|
22
|
push @{$transitcluster->{$addr}}, $rv->{graph}; |
|
15
|
|
|
|
|
40
|
|
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
# take transit hash, router id, area, link structure, network hash |
618
|
|
|
|
|
|
|
# add new element to transit hash |
619
|
|
|
|
|
|
|
sub add_transit_value { |
620
|
195
|
|
|
195
|
0
|
222
|
my OSPF::LSDB::View $self = shift; |
621
|
195
|
|
|
|
|
307
|
my($transithash, $transitnets, $index, $rid, $area, $link) = @_; |
622
|
195
|
50
|
|
|
|
332
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
623
|
195
|
|
|
|
|
246
|
my $addr = $link->{address}; |
624
|
195
|
|
|
|
|
273
|
my $intf = $link->{interface}; |
625
|
195
|
|
|
|
|
546
|
$transitnets->{$intf}{$rid}{$area}{$addr}++; |
626
|
195
|
|
|
|
|
321
|
my $elem = $transithash->{$addr}{$area}{$rid}; |
627
|
195
|
100
|
|
|
|
288
|
if (! $elem) { |
628
|
193
|
|
|
|
|
303
|
$transithash->{$addr}{$area}{$rid} = $elem = {}; |
629
|
|
|
|
|
|
|
# check if address is in nethash and in matching nethash area |
630
|
193
|
100
|
100
|
|
|
383
|
if (! $nethash->{$addr} || ! map { $_->{$area} ? 1 : () } |
|
187
|
100
|
|
|
|
566
|
|
631
|
181
|
|
|
|
|
378
|
map { values %$_ } values %{$nethash->{$addr}}) { |
|
179
|
|
|
|
|
394
|
|
632
|
|
|
|
|
|
|
$elem->{graph} = { |
633
|
15
|
|
|
|
|
56
|
N => "transitnet$$index", |
634
|
|
|
|
|
|
|
label => $addr, |
635
|
|
|
|
|
|
|
shape => "ellipse", |
636
|
|
|
|
|
|
|
style => "dotted", |
637
|
|
|
|
|
|
|
}; |
638
|
15
|
|
|
|
|
25
|
$elem->{index} = $$index++; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
195
|
|
|
|
|
253
|
push @{$elem->{hashes}}, $link; |
|
195
|
|
|
|
|
472
|
|
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# take hash containing transit network nodes |
645
|
|
|
|
|
|
|
# return list of nodes |
646
|
|
|
|
|
|
|
sub transit2nodes { |
647
|
112
|
|
|
112
|
0
|
143
|
my OSPF::LSDB::View $self = shift; |
648
|
112
|
50
|
|
|
|
247
|
my $transithash = $self->{transithash} or die "Uninitialized member"; |
649
|
112
|
|
|
|
|
197
|
return $self->elements2graphs(map { values %$_ } map { values %$_ } |
|
101
|
|
|
|
|
196
|
|
|
95
|
|
|
|
|
163
|
|
650
|
|
|
|
|
|
|
values %$transithash); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
# take link hash, router hash, network hash |
654
|
|
|
|
|
|
|
# return list of edges from router to transit network |
655
|
|
|
|
|
|
|
sub transit2edges { |
656
|
112
|
|
|
112
|
0
|
219
|
my OSPF::LSDB::View $self = shift; |
657
|
112
|
50
|
|
|
|
224
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
658
|
112
|
50
|
|
|
|
180
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
659
|
112
|
50
|
|
|
|
200
|
my $transithash = $self->{transithash} or die "Uninitialized member"; |
660
|
112
|
|
|
|
|
139
|
my $ifaddrs = $self->{ifaddrs}; |
661
|
112
|
|
|
|
|
123
|
my @elements; |
662
|
112
|
|
|
|
|
117
|
my $index = 0; |
663
|
112
|
|
|
|
|
207
|
foreach my $addr (sort keys %$transithash) { |
664
|
95
|
|
|
|
|
164
|
my $av = $transithash->{$addr}; |
665
|
95
|
|
|
|
|
153
|
foreach my $area (sort keys %$av) { |
666
|
101
|
|
|
|
|
123
|
my $ev = $av->{$area}; |
667
|
101
|
|
|
|
|
183
|
foreach my $rid (sort keys %$ev) { |
668
|
193
|
|
|
|
|
247
|
my $rv = $ev->{$rid}; |
669
|
193
|
|
|
|
|
333
|
my %colors = (gray => $area); |
670
|
193
|
|
|
|
|
303
|
my $src = $routehash->{$rid}{graph}{N}; |
671
|
193
|
100
|
|
|
|
193
|
if (@{$rv->{hashes}} > 1) { |
|
193
|
|
|
|
|
411
|
|
672
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
673
|
2
|
|
|
|
|
10
|
"Transit network $addr at router $rid ". |
674
|
|
|
|
|
|
|
"has multiple entries in area $area."); |
675
|
|
|
|
|
|
|
} |
676
|
193
|
|
|
|
|
220
|
foreach my $link (@{$rv->{hashes}}) { |
|
193
|
|
|
|
|
329
|
|
677
|
195
|
|
|
|
|
259
|
my $intf = $link->{interface}; |
678
|
195
|
|
|
|
|
210
|
delete $colors{green}; |
679
|
195
|
100
|
66
|
|
|
647
|
if ($ifaddrs->{$intf} && $ifaddrs->{$intf}{$rid} > 1) { |
680
|
|
|
|
|
|
|
$self->error($colors{green} = |
681
|
3
|
|
|
|
|
17
|
"Transit link at router $rid to network $addr ". |
682
|
|
|
|
|
|
|
"interface address $intf not unique."); |
683
|
|
|
|
|
|
|
} |
684
|
195
|
|
|
|
|
249
|
delete $colors{blue}; |
685
|
195
|
100
|
|
|
|
214
|
if (my @badrids = sort grep { $_ ne $rid } |
|
198
|
|
|
|
|
550
|
|
686
|
195
|
|
|
|
|
438
|
keys %{$ifaddrs->{$intf}}) { |
687
|
|
|
|
|
|
|
$self->error($colors{blue} = |
688
|
3
|
|
|
|
|
19
|
"Transit link at router $rid to network $addr ". |
689
|
|
|
|
|
|
|
"interface address $intf also at router @badrids."); |
690
|
|
|
|
|
|
|
} |
691
|
195
|
|
|
|
|
296
|
my $metric = $link->{metric}; |
692
|
|
|
|
|
|
|
# link from designated router to attached net |
693
|
195
|
100
|
|
|
|
306
|
my $style = $addr eq $intf ? "bold" : "solid"; |
694
|
195
|
|
|
|
|
210
|
delete $colors{magenta}; |
695
|
195
|
|
|
|
|
190
|
delete $colors{brown}; |
696
|
195
|
|
|
|
|
208
|
delete $colors{tan}; |
697
|
195
|
100
|
|
|
|
299
|
if ($rv->{graph}) { |
698
|
16
|
|
|
|
|
23
|
my $dst = $rv->{graph}{N}; |
699
|
16
|
|
|
|
|
89
|
push @elements, { |
700
|
|
|
|
|
|
|
graph => { |
701
|
|
|
|
|
|
|
S => $src, |
702
|
|
|
|
|
|
|
D => $dst, |
703
|
|
|
|
|
|
|
headlabel => $intf, |
704
|
|
|
|
|
|
|
style => $style, |
705
|
|
|
|
|
|
|
taillabel => $metric, |
706
|
|
|
|
|
|
|
}, |
707
|
|
|
|
|
|
|
colors => { %colors }, |
708
|
|
|
|
|
|
|
index => $index++, |
709
|
|
|
|
|
|
|
}; |
710
|
16
|
|
|
|
|
44
|
next; |
711
|
|
|
|
|
|
|
} |
712
|
179
|
|
|
|
|
221
|
my $av = $nethash->{$addr}; |
713
|
179
|
|
|
|
|
304
|
foreach my $mask (sort keys %$av) { |
714
|
181
|
|
|
|
|
207
|
my $mv = $av->{$mask}; |
715
|
181
|
|
|
|
|
291
|
my $nid = "$addr/$mask"; |
716
|
181
|
|
|
|
|
196
|
my $intfip = $intf; |
717
|
181
|
|
|
|
|
389
|
foreach (split(/\./, $mask)) { |
718
|
724
|
100
|
|
|
|
1090
|
last if $_ ne 255; |
719
|
543
|
|
|
|
|
1312
|
$intfip =~ s/^\.?\d+//; |
720
|
|
|
|
|
|
|
} |
721
|
181
|
|
|
|
|
232
|
delete $colors{magenta}; |
722
|
181
|
100
|
|
|
|
273
|
if (_maskip($addr, $mask) ne _maskip($intf, $mask)) { |
723
|
|
|
|
|
|
|
$self->error($colors{magenta} = |
724
|
1
|
|
|
|
|
10
|
"Transit network $addr in area $area ". |
725
|
|
|
|
|
|
|
"at router $rid interface $intf ". |
726
|
|
|
|
|
|
|
"not in network $nid."); |
727
|
1
|
|
|
|
|
2
|
$intfip = $intf; |
728
|
|
|
|
|
|
|
} |
729
|
181
|
|
|
|
|
411
|
foreach my $netrid (sort keys %$mv) { |
730
|
187
|
|
|
|
|
242
|
my $nv = $mv->{$netrid}; |
731
|
187
|
100
|
|
|
|
342
|
my $ev = $nv->{$area} |
732
|
|
|
|
|
|
|
or next; |
733
|
183
|
|
|
|
|
223
|
delete $colors{brown}; |
734
|
183
|
|
|
|
|
203
|
delete $colors{tan}; |
735
|
183
|
100
|
100
|
|
|
591
|
if (! $ev->{attachrouters}{$rid}) { |
|
|
100
|
|
|
|
|
|
736
|
|
|
|
|
|
|
$self->error($colors{brown} = |
737
|
2
|
|
|
|
|
14
|
"Transit link at router $rid not attached ". |
738
|
|
|
|
|
|
|
"by network $nid in area $area."); |
739
|
|
|
|
|
|
|
} elsif ($addr eq $intf && $netrid ne $rid) { |
740
|
|
|
|
|
|
|
$self->error($colors{tan} = |
741
|
2
|
|
|
|
|
12
|
"Transit link at router $rid in area $area ". |
742
|
|
|
|
|
|
|
"is designated but network $nid is not."); |
743
|
|
|
|
|
|
|
} |
744
|
183
|
|
|
|
|
255
|
my $dst = $ev->{graph}{N}; |
745
|
183
|
|
|
|
|
1254
|
push @elements, { |
746
|
|
|
|
|
|
|
graph => { |
747
|
|
|
|
|
|
|
S => $src, |
748
|
|
|
|
|
|
|
D => $dst, |
749
|
|
|
|
|
|
|
headlabel => $intfip, |
750
|
|
|
|
|
|
|
style => $style, |
751
|
|
|
|
|
|
|
taillabel => $metric, |
752
|
|
|
|
|
|
|
}, |
753
|
|
|
|
|
|
|
colors => { %colors }, |
754
|
|
|
|
|
|
|
index => $index++, |
755
|
|
|
|
|
|
|
}; |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
} |
762
|
112
|
|
|
|
|
211
|
return $self->elements2graphs(@elements); |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
######################################################################## |
766
|
|
|
|
|
|
|
# RFC 2328 |
767
|
|
|
|
|
|
|
# Type Description |
768
|
|
|
|
|
|
|
# __________________________________________________ |
769
|
|
|
|
|
|
|
# 3 Connection to a stub network |
770
|
|
|
|
|
|
|
######################################################################## |
771
|
|
|
|
|
|
|
# stubs => [ { |
772
|
|
|
|
|
|
|
# metric => 'int', # metric |
773
|
|
|
|
|
|
|
# netmask => 'ipv4', # Link Data |
774
|
|
|
|
|
|
|
# # network's IP address mask |
775
|
|
|
|
|
|
|
# network => 'ipv4', # Link ID |
776
|
|
|
|
|
|
|
# # IP network/subnet number |
777
|
|
|
|
|
|
|
# ], |
778
|
|
|
|
|
|
|
######################################################################## |
779
|
|
|
|
|
|
|
# $network = $network & $netmask |
780
|
|
|
|
|
|
|
# $stubhash{$network}{$netmask}{$area}{$routerid} = { |
781
|
|
|
|
|
|
|
# graph => { N => stub3, color => red, style => solid, } |
782
|
|
|
|
|
|
|
# hashes => [ { link hash } ] |
783
|
|
|
|
|
|
|
# } |
784
|
|
|
|
|
|
|
######################################################################## |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# take transit hash, net cluster hash, network hash |
787
|
|
|
|
|
|
|
# detect inconsistencies and set colors |
788
|
|
|
|
|
|
|
sub check_stub { |
789
|
112
|
|
|
112
|
0
|
133
|
my OSPF::LSDB::View $self = shift; |
790
|
112
|
|
|
|
|
156
|
my($netcluster) = @_; |
791
|
112
|
50
|
|
|
|
224
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
792
|
112
|
|
|
|
|
116
|
my %netsmv; |
793
|
112
|
|
|
|
|
199
|
foreach my $addr (sort keys %$nethash) { |
794
|
88
|
|
|
|
|
137
|
my $av = $nethash->{$addr}; |
795
|
88
|
|
|
|
|
143
|
foreach my $mask (sort keys %$av) { |
796
|
89
|
|
|
|
|
116
|
my $mv = $av->{$mask}; |
797
|
89
|
|
|
|
|
124
|
my $net = _maskip($addr, $mask); |
798
|
89
|
|
|
|
|
134
|
push @{$netsmv{$net}{$mask}}, $mv; |
|
89
|
|
|
|
|
291
|
|
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
|
802
|
112
|
50
|
|
|
|
240
|
my $stubhash = $self->{stubhash} or die "Uninitialized member"; |
803
|
112
|
|
|
|
|
362
|
foreach my $net (sort keys %$stubhash) { |
804
|
31
|
|
|
|
|
52
|
my $nv = $stubhash->{$net}; |
805
|
31
|
|
|
|
|
70
|
foreach my $mask (sort keys %$nv) { |
806
|
31
|
|
|
|
|
43
|
my $mv = $nv->{$mask}; |
807
|
31
|
|
|
|
|
40
|
my %colors; |
808
|
31
|
|
|
|
|
64
|
my $nid = "$net/$mask"; |
809
|
31
|
100
|
|
|
|
87
|
if ($netsmv{$net}{$mask}) { |
810
|
|
|
|
|
|
|
$self->error($colors{blue} = |
811
|
5
|
|
|
|
|
21
|
"Stub network $nid is also network."); |
812
|
|
|
|
|
|
|
} |
813
|
31
|
|
|
|
|
44
|
delete $colors{orange}; |
814
|
31
|
100
|
|
|
|
80
|
if (keys %$mv > 1) { |
815
|
|
|
|
|
|
|
$self->error($colors{orange} = |
816
|
1
|
|
|
|
|
4
|
"Stub network $nid in multiple areas."); |
817
|
|
|
|
|
|
|
} |
818
|
31
|
|
|
|
|
67
|
foreach my $area (sort keys %$mv) { |
819
|
32
|
|
|
|
|
41
|
my $ev = $mv->{$area}; |
820
|
32
|
|
|
|
|
53
|
$colors{gray} = $area; |
821
|
32
|
|
|
|
|
37
|
delete $colors{green}; |
822
|
32
|
100
|
|
|
|
83
|
if (keys %$ev > 1) { |
823
|
|
|
|
|
|
|
$self->error($colors{green} = |
824
|
1
|
|
|
|
|
6
|
"Stub network $nid in area $area at multiple routers."); |
825
|
|
|
|
|
|
|
} |
826
|
32
|
|
|
|
|
50
|
delete $colors{magenta}; |
827
|
32
|
100
|
100
|
|
|
111
|
if ($netsmv{$net}{$mask} and my @otherareas = sort |
828
|
7
|
|
|
|
|
29
|
grep { $_ ne $area } map { keys %$_ } map { values %$_ } |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
16
|
|
829
|
5
|
|
|
|
|
11
|
@{$netsmv{$net}{$mask}}) { |
830
|
|
|
|
|
|
|
$self->error($colors{magenta} = |
831
|
1
|
|
|
|
|
7
|
"Stub network $nid in area $area ". |
832
|
|
|
|
|
|
|
"is also network in areas @otherareas."); |
833
|
|
|
|
|
|
|
} |
834
|
32
|
|
|
|
|
108
|
foreach my $rid (sort keys %$ev) { |
835
|
33
|
|
|
|
|
53
|
my $rv = $ev->{$rid}; |
836
|
33
|
|
|
|
|
43
|
delete $colors{yellow}; |
837
|
33
|
100
|
100
|
|
|
86
|
if ($netsmv{$net}{$mask} and grep { $_->{$rid} } |
|
7
|
|
|
|
|
18
|
|
838
|
5
|
|
|
|
|
13
|
@{$netsmv{$net}{$mask}}) { |
839
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
840
|
1
|
|
|
|
|
5
|
"Stub network $nid is also network at router $rid."); |
841
|
|
|
|
|
|
|
} |
842
|
33
|
|
|
|
|
60
|
%{$rv->{colors}} = %colors; |
|
33
|
|
|
|
|
86
|
|
843
|
33
|
|
|
|
|
42
|
push @{$netcluster->{"$net/$mask"}}, $rv->{graph}; |
|
33
|
|
|
|
|
187
|
|
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
# take stub hash, router id, area, link structure |
851
|
|
|
|
|
|
|
# add new element to stub hash |
852
|
|
|
|
|
|
|
sub add_stub_value { |
853
|
36
|
|
|
36
|
0
|
61
|
my OSPF::LSDB::View $self = shift; |
854
|
36
|
|
|
|
|
77
|
my($stubhash, $stubs, $stubareas, $index, $rid, $area, $link) = @_; |
855
|
36
|
|
|
|
|
53
|
my $addr = $link->{network}; |
856
|
36
|
|
|
|
|
55
|
my $mask = $link->{netmask}; |
857
|
36
|
|
|
|
|
81
|
my $net = _maskip($addr, $mask); |
858
|
36
|
|
|
|
|
115
|
$stubs->{$net}{$mask}++; |
859
|
36
|
|
|
|
|
84
|
$stubareas->{$net}{$mask}{$area}++; |
860
|
36
|
|
|
|
|
115
|
my $elem = $stubhash->{$net}{$mask}{$area}{$rid}; |
861
|
36
|
100
|
|
|
|
85
|
if (! $elem) { |
862
|
33
|
|
|
|
|
100
|
$stubhash->{$net}{$mask}{$area}{$rid} = $elem = {}; |
863
|
|
|
|
|
|
|
$elem->{graph} = { |
864
|
33
|
|
|
|
|
163
|
N => "stubnet$$index", |
865
|
|
|
|
|
|
|
label => "$net\\n$mask", |
866
|
|
|
|
|
|
|
shape => "ellipse", |
867
|
|
|
|
|
|
|
style => "solid", |
868
|
|
|
|
|
|
|
}; |
869
|
33
|
|
|
|
|
132
|
$elem->{index} = $$index++; |
870
|
|
|
|
|
|
|
} |
871
|
36
|
|
|
|
|
97
|
push @{$elem->{hashes}}, $link; |
|
36
|
|
|
|
|
112
|
|
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
# take hash containing stub network nodes |
875
|
|
|
|
|
|
|
# return list of nodes |
876
|
|
|
|
|
|
|
sub stub2nodes { |
877
|
112
|
|
|
112
|
0
|
153
|
my OSPF::LSDB::View $self = shift; |
878
|
112
|
50
|
|
|
|
220
|
my $stubhash = $self->{stubhash} or die "Uninitialized member"; |
879
|
32
|
|
|
|
|
58
|
return $self->elements2graphs(map { values %$_ } map { values %$_ } |
|
31
|
|
|
|
|
52
|
|
880
|
112
|
|
|
|
|
200
|
map { values %$_ } values %$stubhash); |
|
31
|
|
|
|
|
63
|
|
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
# take link hash, router hash |
884
|
|
|
|
|
|
|
# return list of edges from router to stub network |
885
|
|
|
|
|
|
|
sub stub2edges { |
886
|
112
|
|
|
112
|
0
|
149
|
my OSPF::LSDB::View $self = shift; |
887
|
112
|
50
|
|
|
|
229
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
888
|
112
|
50
|
|
|
|
261
|
my $stubhash = $self->{stubhash} or die "Uninitialized member"; |
889
|
112
|
|
|
|
|
130
|
my @elements; |
890
|
112
|
|
|
|
|
423
|
my $index = 0; |
891
|
112
|
|
|
|
|
254
|
foreach my $net (sort keys %$stubhash) { |
892
|
31
|
|
|
|
|
49
|
my $nv = $stubhash->{$net}; |
893
|
31
|
|
|
|
|
70
|
foreach my $mask (sort keys %$nv) { |
894
|
31
|
|
|
|
|
34
|
my $mv = $nv->{$mask}; |
895
|
31
|
|
|
|
|
61
|
foreach my $area (sort keys %$mv) { |
896
|
32
|
|
|
|
|
44
|
my $ev = $mv->{$area}; |
897
|
32
|
|
|
|
|
58
|
foreach my $rid (sort keys %$ev) { |
898
|
33
|
|
|
|
|
41
|
my $rv = $ev->{$rid}; |
899
|
33
|
|
|
|
|
67
|
my %colors = (gray => $area); |
900
|
33
|
|
|
|
|
65
|
my $src = $routehash->{$rid}{graph}{N}; |
901
|
33
|
|
|
|
|
71
|
my $nid = "$net/$mask"; |
902
|
33
|
100
|
|
|
|
45
|
if (@{$rv->{hashes}} > 1) { |
|
33
|
|
|
|
|
86
|
|
903
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
904
|
2
|
|
|
|
|
9
|
"Stub network $nid at router $rid ". |
905
|
|
|
|
|
|
|
"has multiple entries in area $area."); |
906
|
|
|
|
|
|
|
} |
907
|
33
|
|
|
|
|
41
|
foreach my $link (@{$rv->{hashes}}) { |
|
33
|
|
|
|
|
69
|
|
908
|
36
|
|
|
|
|
54
|
my $dst = $rv->{graph}{N}; |
909
|
36
|
|
|
|
|
47
|
my $addr = $link->{network}; |
910
|
36
|
|
|
|
|
41
|
my @headlabel; |
911
|
36
|
|
|
|
|
360
|
delete $colors{magenta}; |
912
|
36
|
100
|
|
|
|
94
|
if ($net ne $addr) { |
913
|
|
|
|
|
|
|
$self->error($colors{magenta} = |
914
|
3
|
|
|
|
|
14
|
"Stub network $nid address $addr ". |
915
|
|
|
|
|
|
|
"is not network."); |
916
|
3
|
|
|
|
|
5
|
my $intfip = $addr; |
917
|
3
|
|
|
|
|
10
|
foreach (split(/\./, $mask)) { |
918
|
12
|
100
|
|
|
|
21
|
last if $_ ne 255; |
919
|
9
|
|
|
|
|
25
|
$intfip =~ s/^\.?\d+//; |
920
|
|
|
|
|
|
|
} |
921
|
3
|
|
|
|
|
8
|
@headlabel = (headlabel => $intfip); |
922
|
|
|
|
|
|
|
} |
923
|
36
|
|
|
|
|
59
|
my $metric = $link->{metric}; |
924
|
36
|
|
|
|
|
249
|
push @elements, { |
925
|
|
|
|
|
|
|
graph => { |
926
|
|
|
|
|
|
|
S => $src, |
927
|
|
|
|
|
|
|
D => $dst, |
928
|
|
|
|
|
|
|
@headlabel, |
929
|
|
|
|
|
|
|
style => "solid", |
930
|
|
|
|
|
|
|
taillabel => $metric, |
931
|
|
|
|
|
|
|
}, |
932
|
|
|
|
|
|
|
colors => { %colors }, |
933
|
|
|
|
|
|
|
index => $index++, |
934
|
|
|
|
|
|
|
}; |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
} |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
} |
940
|
112
|
|
|
|
|
183
|
return $self->elements2graphs(@elements); |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
######################################################################## |
944
|
|
|
|
|
|
|
# RFC 2328 |
945
|
|
|
|
|
|
|
# LS LSA LSA description |
946
|
|
|
|
|
|
|
# type name |
947
|
|
|
|
|
|
|
# ________________________________________________________ |
948
|
|
|
|
|
|
|
# 2 Network-LSAs Originated for broadcast |
949
|
|
|
|
|
|
|
# and NBMA networks by |
950
|
|
|
|
|
|
|
# the Designated Router. This |
951
|
|
|
|
|
|
|
# LSA contains the |
952
|
|
|
|
|
|
|
# list of routers connected |
953
|
|
|
|
|
|
|
# to the network. Flooded |
954
|
|
|
|
|
|
|
# throughout a single area only. |
955
|
|
|
|
|
|
|
######################################################################## |
956
|
|
|
|
|
|
|
# networks => [ |
957
|
|
|
|
|
|
|
# address => 'ipv4', # Link State ID |
958
|
|
|
|
|
|
|
# area => 'ipv4', |
959
|
|
|
|
|
|
|
# attachments => [ |
960
|
|
|
|
|
|
|
# routerid => 'ipv4', # Attached Router |
961
|
|
|
|
|
|
|
# ], |
962
|
|
|
|
|
|
|
# netmask => 'ipv4', # Network Mask |
963
|
|
|
|
|
|
|
# routerid => 'ipv4', # Advertising Router |
964
|
|
|
|
|
|
|
# ], |
965
|
|
|
|
|
|
|
######################################################################## |
966
|
|
|
|
|
|
|
# $network = $address & $netmask |
967
|
|
|
|
|
|
|
# $nethash{$address}{$netmask}{$routerid}{$area} = { |
968
|
|
|
|
|
|
|
# graph => { N => network1, color => red, style => bold, } |
969
|
|
|
|
|
|
|
# hashes => [ { network hash } ] |
970
|
|
|
|
|
|
|
# attachrouters => { $attrid => 1 } |
971
|
|
|
|
|
|
|
# } |
972
|
|
|
|
|
|
|
# $nets{$network}{$netmask}++ |
973
|
|
|
|
|
|
|
# $netareas{$network}{$netmask}{$area}++ |
974
|
|
|
|
|
|
|
######################################################################## |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
# take network hash, net cluster hash, net hash |
977
|
|
|
|
|
|
|
# detect inconsistencies and set colors |
978
|
|
|
|
|
|
|
sub check_network { |
979
|
112
|
|
|
112
|
0
|
132
|
my OSPF::LSDB::View $self = shift; |
980
|
112
|
|
|
|
|
146
|
my($netcluster) = @_; |
981
|
112
|
50
|
|
|
|
219
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
982
|
112
|
50
|
|
|
|
203
|
my $nets = $self->{nets} or die "Uninitialized member"; |
983
|
112
|
|
|
|
|
145
|
my %colors; |
984
|
112
|
|
|
|
|
231
|
foreach my $addr (sort keys %$nethash) { |
985
|
88
|
|
|
|
|
320
|
my $av = $nethash->{$addr}; |
986
|
88
|
|
|
|
|
128
|
delete $colors{magenta}; |
987
|
88
|
100
|
|
|
|
159
|
if (keys %$av > 1) { |
988
|
|
|
|
|
|
|
$self->error($colors{magenta} = |
989
|
1
|
|
|
|
|
4
|
"Network $addr with multiple netmasks."); |
990
|
|
|
|
|
|
|
} |
991
|
88
|
|
|
|
|
151
|
foreach my $mask (sort keys %$av) { |
992
|
89
|
|
|
|
|
146
|
my $mv = $av->{$mask}; |
993
|
89
|
|
|
|
|
149
|
my $nid = "$addr/$mask"; |
994
|
89
|
|
|
|
|
139
|
my $net = _maskip($addr, $mask); |
995
|
89
|
|
|
|
|
141
|
delete $colors{green}; |
996
|
89
|
100
|
|
|
|
187
|
if ($nets->{$net}{$mask} > 1) { |
997
|
|
|
|
|
|
|
$self->error($colors{green} = |
998
|
11
|
|
|
|
|
56
|
"Network $nid not unique in network $net."); |
999
|
|
|
|
|
|
|
} |
1000
|
89
|
|
|
|
|
107
|
delete $colors{blue}; |
1001
|
89
|
100
|
|
|
|
175
|
if (keys %$mv > 1) { |
1002
|
|
|
|
|
|
|
$self->error($colors{blue} = |
1003
|
2
|
|
|
|
|
8
|
"Network $nid at multiple routers."); |
1004
|
|
|
|
|
|
|
} |
1005
|
89
|
|
|
|
|
191
|
foreach my $rid (sort keys %$mv) { |
1006
|
91
|
|
|
|
|
126
|
my $rv = $mv->{$rid}; |
1007
|
91
|
|
|
|
|
125
|
delete $colors{orange}; |
1008
|
91
|
100
|
|
|
|
151
|
if (keys %$rv > 1) { |
1009
|
|
|
|
|
|
|
$self->error($colors{orange} = |
1010
|
1
|
|
|
|
|
6
|
"Network $nid at router $rid in multiple areas."); |
1011
|
|
|
|
|
|
|
} |
1012
|
91
|
|
|
|
|
146
|
foreach my $area (sort keys %$rv) { |
1013
|
92
|
|
|
|
|
114
|
my $ev = $rv->{$area}; |
1014
|
92
|
|
|
|
|
124
|
$colors{gray} = $area; |
1015
|
92
|
|
|
|
|
109
|
delete $colors{yellow}; |
1016
|
92
|
100
|
|
|
|
251
|
if (@{$ev->{hashes}} > 1) { |
|
92
|
|
|
|
|
187
|
|
1017
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
1018
|
2
|
|
|
|
|
11
|
"Network $nid at router $rid ". |
1019
|
|
|
|
|
|
|
"has multiple entries in area $area."); |
1020
|
|
|
|
|
|
|
} |
1021
|
92
|
|
|
|
|
101
|
delete $colors{brown}; |
1022
|
92
|
|
|
|
|
104
|
my @attrids = keys %{$ev->{attachrouters}}; |
|
92
|
|
|
|
|
240
|
|
1023
|
92
|
100
|
|
|
|
212
|
if (@attrids == 0) { |
1024
|
|
|
|
|
|
|
$self->error($colors{red} = |
1025
|
1
|
|
|
|
|
8
|
"Network $nid at router $rid not attached ". |
1026
|
|
|
|
|
|
|
"to any router in area $area."); |
1027
|
|
|
|
|
|
|
} |
1028
|
92
|
100
|
|
|
|
181
|
if (@attrids == 1) { |
1029
|
|
|
|
|
|
|
$self->error($colors{brown} = |
1030
|
1
|
|
|
|
|
34
|
"Network $nid at router $rid attached only ". |
1031
|
|
|
|
|
|
|
"to router @attrids in area $area."); |
1032
|
|
|
|
|
|
|
} |
1033
|
92
|
|
|
|
|
142
|
%{$ev->{colors}} = %colors; |
|
92
|
|
|
|
|
197
|
|
1034
|
92
|
|
|
|
|
119
|
push @{$netcluster->{"$net/$mask"}}, $ev->{graph}; |
|
92
|
|
|
|
|
394
|
|
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
} |
1037
|
|
|
|
|
|
|
} |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
# take network structure, net cluster hash |
1042
|
|
|
|
|
|
|
# return network hash |
1043
|
|
|
|
|
|
|
sub create_network { |
1044
|
112
|
|
|
112
|
0
|
136
|
my OSPF::LSDB::View $self = shift; |
1045
|
112
|
|
|
|
|
159
|
my($index) = @_; |
1046
|
112
|
|
|
|
|
191
|
my %nethash; |
1047
|
|
|
|
|
|
|
my %nets; |
1048
|
112
|
|
|
|
|
0
|
my %netareas; |
1049
|
112
|
|
|
|
|
121
|
foreach my $n (@{$self->{ospf}{database}{networks}}) { |
|
112
|
|
|
|
|
292
|
|
1050
|
94
|
|
|
|
|
131
|
my $addr = $n->{address}; |
1051
|
94
|
|
|
|
|
105
|
my $mask = $n->{netmask}; |
1052
|
94
|
|
|
|
|
163
|
my $nid = "$addr/$mask"; |
1053
|
94
|
|
|
|
|
161
|
my $net = _maskip($addr, $mask); |
1054
|
94
|
|
|
|
|
248
|
$nets{$net}{$mask}++; |
1055
|
94
|
|
|
|
|
136
|
my $rid = $n->{routerid}; |
1056
|
94
|
|
|
|
|
109
|
my $area = $n->{area}; |
1057
|
94
|
|
|
|
|
181
|
$netareas{$net}{$mask}{$area}++; |
1058
|
94
|
|
|
|
|
245
|
my $elem = $nethash{$addr}{$mask}{$rid}{$area}; |
1059
|
94
|
100
|
|
|
|
211
|
if (! $elem) { |
1060
|
92
|
|
|
|
|
201
|
$nethash{$addr}{$mask}{$rid}{$area} = $elem = {}; |
1061
|
|
|
|
|
|
|
$elem->{graph} = { |
1062
|
92
|
|
|
|
|
391
|
N => "network$$index", |
1063
|
|
|
|
|
|
|
label => "$net\\n$mask", |
1064
|
|
|
|
|
|
|
shape => "ellipse", |
1065
|
|
|
|
|
|
|
style => "bold", |
1066
|
|
|
|
|
|
|
}; |
1067
|
92
|
|
|
|
|
201
|
$elem->{index} = $$index++; |
1068
|
|
|
|
|
|
|
} |
1069
|
94
|
|
|
|
|
121
|
push @{$elem->{hashes}}, $n; |
|
94
|
|
|
|
|
211
|
|
1070
|
94
|
|
|
|
|
109
|
foreach my $att (@{$n->{attachments}}) { |
|
94
|
|
|
|
|
145
|
|
1071
|
196
|
|
|
|
|
461
|
$elem->{attachrouters}{$att->{routerid}} = 1; |
1072
|
|
|
|
|
|
|
} |
1073
|
|
|
|
|
|
|
} |
1074
|
112
|
|
|
|
|
196
|
$self->{nethash} = \%nethash; |
1075
|
112
|
|
|
|
|
155
|
$self->{nets} = \%nets; |
1076
|
112
|
|
|
|
|
193
|
$self->{netareas} = \%netareas; |
1077
|
|
|
|
|
|
|
} |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
# only necessary for ipv6 |
1080
|
|
|
|
|
|
|
sub add_missing_network { |
1081
|
112
|
|
|
112
|
0
|
136
|
my OSPF::LSDB::View $self = shift; |
1082
|
112
|
|
|
|
|
197
|
my($index) = @_; |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
# take hash containing network nodes |
1086
|
|
|
|
|
|
|
# return list of nodes |
1087
|
|
|
|
|
|
|
sub network2nodes { |
1088
|
112
|
|
|
112
|
0
|
131
|
my OSPF::LSDB::View $self = shift; |
1089
|
112
|
50
|
|
|
|
210
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
1090
|
91
|
|
|
|
|
160
|
return $self->elements2graphs(map { values %$_ } map { values %$_ } |
|
89
|
|
|
|
|
136
|
|
1091
|
112
|
|
|
|
|
256
|
map { values %$_ } values %$nethash); |
|
88
|
|
|
|
|
180
|
|
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
# take network hash, router hash |
1095
|
|
|
|
|
|
|
# return list of edges from transit network to router |
1096
|
|
|
|
|
|
|
sub network2edges { |
1097
|
112
|
|
|
112
|
0
|
123
|
my OSPF::LSDB::View $self = shift; |
1098
|
112
|
50
|
|
|
|
235
|
my $nethash = $self->{nethash} or die "Uninitialized member"; |
1099
|
112
|
50
|
|
|
|
178
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
1100
|
112
|
50
|
|
|
|
172
|
my $transithash = $self->{transithash} or die "Uninitialized member"; |
1101
|
112
|
|
|
|
|
135
|
my @elements; |
1102
|
112
|
|
|
|
|
121
|
my $index = 0; |
1103
|
112
|
|
|
|
|
221
|
foreach my $addr (sort keys %$nethash) { |
1104
|
88
|
|
|
|
|
126
|
my $av = $nethash->{$addr}; |
1105
|
88
|
|
|
|
|
148
|
foreach my $mask (sort keys %$av) { |
1106
|
89
|
|
|
|
|
104
|
my $mv = $av->{$mask}; |
1107
|
89
|
|
|
|
|
150
|
my $nid = "$addr/$mask"; |
1108
|
89
|
|
|
|
|
117
|
my $intfip = $addr; |
1109
|
89
|
|
|
|
|
208
|
foreach (split(/\./, $mask)) { |
1110
|
356
|
100
|
|
|
|
565
|
last if $_ ne 255; |
1111
|
267
|
|
|
|
|
688
|
$intfip =~ s/^\.?\d+//; |
1112
|
|
|
|
|
|
|
} |
1113
|
89
|
|
|
|
|
192
|
foreach my $rid (sort keys %$mv) { |
1114
|
91
|
|
|
|
|
114
|
my $rv = $mv->{$rid}; |
1115
|
91
|
|
|
|
|
157
|
foreach my $area (sort keys %$rv) { |
1116
|
92
|
|
|
|
|
108
|
my $ev = $rv->{$area}; |
1117
|
92
|
|
|
|
|
130
|
my $src = $ev->{graph}{N}; |
1118
|
92
|
|
|
|
|
152
|
foreach my $net (@{$ev->{hashes}}) { |
|
92
|
|
|
|
|
153
|
|
1119
|
94
|
|
|
|
|
107
|
my %attcolors; |
1120
|
94
|
|
|
|
|
102
|
foreach (@{$net->{attachments}}) { |
|
94
|
|
|
|
|
158
|
|
1121
|
196
|
|
|
|
|
284
|
my $arid = $_->{routerid}; |
1122
|
196
|
100
|
|
|
|
326
|
if ($attcolors{$arid}) { |
1123
|
|
|
|
|
|
|
$self->error($attcolors{$arid}{yellow} = |
1124
|
2
|
|
|
|
|
12
|
"Network $nid in area $area at router $rid ". |
1125
|
|
|
|
|
|
|
"attached to router $arid multiple times."); |
1126
|
2
|
|
|
|
|
4
|
next; |
1127
|
|
|
|
|
|
|
} |
1128
|
194
|
|
|
|
|
355
|
$attcolors{$arid}{gray} = $area; |
1129
|
194
|
100
|
66
|
|
|
604
|
if ($routehash->{$arid}{areas} && |
1130
|
|
|
|
|
|
|
! $routehash->{$arid}{areas}{$area}) { |
1131
|
|
|
|
|
|
|
$self->error($attcolors{$arid}{orange} = |
1132
|
4
|
|
|
|
|
25
|
"Network $nid and router $arid ". |
1133
|
|
|
|
|
|
|
"not in same area $area."); |
1134
|
4
|
|
|
|
|
7
|
next; |
1135
|
|
|
|
|
|
|
} |
1136
|
190
|
|
|
|
|
259
|
my $tv = $transithash->{$addr}{$area}{$arid}; |
1137
|
190
|
100
|
100
|
|
|
294
|
if (! $tv && ! $routehash->{$arid}{missing}) { |
1138
|
|
|
|
|
|
|
$self->error($attcolors{$arid}{brown} = |
1139
|
1
|
|
|
|
|
10
|
"Network $nid not transit net ". |
1140
|
|
|
|
|
|
|
"of attached router $arid in area $area."); |
1141
|
1
|
|
|
|
|
3
|
next; |
1142
|
|
|
|
|
|
|
} |
1143
|
189
|
100
|
100
|
|
|
472
|
if ($arid eq $rid && $tv && ! grep { $addr eq |
|
|
|
100
|
|
|
|
|
1144
|
86
|
|
|
|
|
297
|
$_->{interface} } @{$tv->{hashes}}) { |
|
85
|
|
|
|
|
133
|
|
1145
|
|
|
|
|
|
|
$self->error($attcolors{$arid}{tan} = |
1146
|
11
|
|
|
|
|
52
|
"Network $nid at router $arid in area $area ". |
1147
|
|
|
|
|
|
|
"is designated but transit link is not."); |
1148
|
11
|
|
|
|
|
18
|
next; |
1149
|
|
|
|
|
|
|
} |
1150
|
|
|
|
|
|
|
} |
1151
|
94
|
|
|
|
|
218
|
foreach (@{$net->{attachments}}) { |
|
94
|
|
|
|
|
156
|
|
1152
|
196
|
|
|
|
|
282
|
my $arid = $_->{routerid}; |
1153
|
|
|
|
|
|
|
my $dst = $routehash->{$arid}{graph}{N} |
1154
|
196
|
50
|
|
|
|
323
|
or die "No router graph $arid"; |
1155
|
196
|
|
|
|
|
218
|
my $style = "solid"; |
1156
|
196
|
|
|
|
|
219
|
my @taillabel; |
1157
|
196
|
100
|
|
|
|
289
|
if ($arid eq $rid) { |
1158
|
|
|
|
|
|
|
# router is designated router |
1159
|
93
|
|
|
|
|
107
|
$style = "bold"; |
1160
|
93
|
|
|
|
|
167
|
@taillabel = (taillabel => $intfip); |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
push @elements, { |
1163
|
|
|
|
|
|
|
graph => { |
1164
|
|
|
|
|
|
|
S => $src, |
1165
|
|
|
|
|
|
|
D => $dst, |
1166
|
|
|
|
|
|
|
style => $style, |
1167
|
|
|
|
|
|
|
@taillabel, |
1168
|
|
|
|
|
|
|
}, |
1169
|
196
|
|
|
|
|
471
|
colors => { %{$attcolors{$arid}} }, |
|
196
|
|
|
|
|
711
|
|
1170
|
|
|
|
|
|
|
index => $index++, |
1171
|
|
|
|
|
|
|
}; |
1172
|
|
|
|
|
|
|
} |
1173
|
94
|
100
|
|
|
|
377
|
if (! $attcolors{$rid}) { |
1174
|
|
|
|
|
|
|
my $dst = $routehash->{$rid}{graph}{N} |
1175
|
3
|
50
|
|
|
|
10
|
or die "No router graph $rid"; |
1176
|
3
|
|
|
|
|
6
|
$attcolors{$rid}{gray} = $area; |
1177
|
|
|
|
|
|
|
$self->error($attcolors{$rid}{red} = |
1178
|
3
|
|
|
|
|
21
|
"Network $nid not attached ". |
1179
|
|
|
|
|
|
|
"to designated router $rid in area $area."); |
1180
|
|
|
|
|
|
|
push @elements, { |
1181
|
|
|
|
|
|
|
graph => { |
1182
|
|
|
|
|
|
|
S => $src, |
1183
|
|
|
|
|
|
|
D => $dst, |
1184
|
|
|
|
|
|
|
style => "bold", |
1185
|
|
|
|
|
|
|
taillabel => $intfip, |
1186
|
|
|
|
|
|
|
}, |
1187
|
3
|
|
|
|
|
11
|
colors => { %{$attcolors{$rid}} }, |
|
3
|
|
|
|
|
30
|
|
1188
|
|
|
|
|
|
|
index => $index++, |
1189
|
|
|
|
|
|
|
}; |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
} |
1193
|
|
|
|
|
|
|
} |
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
} |
1196
|
112
|
|
|
|
|
198
|
return $self->elements2graphs(@elements); |
1197
|
|
|
|
|
|
|
} |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
######################################################################## |
1200
|
|
|
|
|
|
|
# RFC 2328 |
1201
|
|
|
|
|
|
|
# LS LSA LSA description |
1202
|
|
|
|
|
|
|
# type name |
1203
|
|
|
|
|
|
|
# ________________________________________________________ |
1204
|
|
|
|
|
|
|
# 3 Summary-LSAs Originated by area border |
1205
|
|
|
|
|
|
|
# routers, and flooded through- |
1206
|
|
|
|
|
|
|
# out the LSA's associated |
1207
|
|
|
|
|
|
|
# area. Each summary-LSA |
1208
|
|
|
|
|
|
|
# describes a route to a |
1209
|
|
|
|
|
|
|
# destination outside the area, |
1210
|
|
|
|
|
|
|
# yet still inside the AS |
1211
|
|
|
|
|
|
|
# (i.e., an inter-area route). |
1212
|
|
|
|
|
|
|
# Type 3 summary-LSAs describe |
1213
|
|
|
|
|
|
|
# routes to networks. Type 4 |
1214
|
|
|
|
|
|
|
# summary-LSAs describe |
1215
|
|
|
|
|
|
|
# routes to AS boundary routers. |
1216
|
|
|
|
|
|
|
######################################################################## |
1217
|
|
|
|
|
|
|
# summarys => [ |
1218
|
|
|
|
|
|
|
# address => 'ipv4', # Link State ID |
1219
|
|
|
|
|
|
|
# area => 'ipv4', |
1220
|
|
|
|
|
|
|
# metric => 'int', # metric |
1221
|
|
|
|
|
|
|
# netmask => 'ipv4', # Network Mask |
1222
|
|
|
|
|
|
|
# routerid => 'ipv4', # Advertising Router |
1223
|
|
|
|
|
|
|
# ], |
1224
|
|
|
|
|
|
|
######################################################################## |
1225
|
|
|
|
|
|
|
# $network = $address & $netmask |
1226
|
|
|
|
|
|
|
# $sumhash{$network}{$netmask} = { |
1227
|
|
|
|
|
|
|
# graph => { N => summary4, color => red, style => solid, } |
1228
|
|
|
|
|
|
|
# hashes => [ { summary hash } ] |
1229
|
|
|
|
|
|
|
# arearids => { $area => { $routerid => 1 } } |
1230
|
|
|
|
|
|
|
# } |
1231
|
|
|
|
|
|
|
# $sums{$network}{$netmask}++; |
1232
|
|
|
|
|
|
|
######################################################################## |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
# take summary hash, net cluster hash, network hash, stub hash |
1235
|
|
|
|
|
|
|
# detect inconsistencies and set colors |
1236
|
|
|
|
|
|
|
sub check_summary { |
1237
|
92
|
|
|
92
|
0
|
109
|
my OSPF::LSDB::View $self = shift; |
1238
|
92
|
|
|
|
|
162
|
my($netcluster) = @_; |
1239
|
92
|
50
|
|
|
|
168
|
my $netareas = $self->{netareas} or die "Uninitialized member"; |
1240
|
92
|
50
|
|
|
|
197
|
my $stubareas = $self->{stubareas} or die "Uninitialized member"; |
1241
|
92
|
50
|
|
|
|
176
|
my $sumhash = $self->{sumhash} or die "Uninitialized member"; |
1242
|
92
|
|
|
|
|
196
|
foreach my $net (sort keys %$sumhash) { |
1243
|
55
|
|
|
|
|
70
|
my $nv = $sumhash->{$net}; |
1244
|
55
|
|
|
|
|
94
|
foreach my $mask (sort keys %$nv) { |
1245
|
55
|
|
|
|
|
64
|
my $mv = $nv->{$mask}; |
1246
|
55
|
|
|
|
|
67
|
my %colors; |
1247
|
55
|
|
|
|
|
83
|
my $nid = "$net/$mask"; |
1248
|
55
|
|
|
|
|
120
|
my @areas = sort keys %{$mv->{arearids}}; |
|
55
|
|
|
|
|
6171
|
|
1249
|
55
|
100
|
|
|
|
157
|
if (@areas > 1) { |
1250
|
25
|
|
|
|
|
39
|
$colors{black} = \@areas; |
1251
|
|
|
|
|
|
|
} else { |
1252
|
30
|
|
|
|
|
61
|
$colors{gray} = $areas[0]; |
1253
|
|
|
|
|
|
|
} |
1254
|
55
|
100
|
|
|
|
81
|
if (my @badareas = grep { $netareas->{$net}{$mask}{$_} } @areas) { |
|
80
|
|
|
|
|
189
|
|
1255
|
|
|
|
|
|
|
$self->error($colors{blue} = |
1256
|
2
|
|
|
|
|
16
|
"Summary network $nid is also network in areas @badareas."); |
1257
|
|
|
|
|
|
|
} |
1258
|
55
|
100
|
66
|
|
|
140
|
if ($stubareas and |
1259
|
80
|
|
|
|
|
212
|
my @badareas = grep { $stubareas->{$net}{$mask}{$_} } @areas) { |
1260
|
|
|
|
|
|
|
$self->error($colors{green} = |
1261
|
3
|
|
|
|
|
25
|
"Summary network $nid is also stub network ". |
1262
|
|
|
|
|
|
|
"in areas @badareas."); |
1263
|
|
|
|
|
|
|
} |
1264
|
55
|
|
|
|
|
93
|
$mv->{colors} = \%colors; |
1265
|
55
|
|
|
|
|
66
|
push @{$netcluster->{"$net/$mask"}}, $mv->{graph}; |
|
55
|
|
|
|
|
177
|
|
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
# take summary structure, net cluster hash, network hash, link hash |
1271
|
|
|
|
|
|
|
# return summary hash |
1272
|
|
|
|
|
|
|
sub create_summary { |
1273
|
92
|
|
|
92
|
0
|
119
|
my OSPF::LSDB::View $self = shift; |
1274
|
92
|
|
|
|
|
103
|
my $index = 0; |
1275
|
92
|
|
|
|
|
127
|
my %sumhash; |
1276
|
|
|
|
|
|
|
my %sums; |
1277
|
92
|
|
|
|
|
101
|
foreach my $s (@{$self->{ospf}{database}{summarys}}) { |
|
92
|
|
|
|
|
162
|
|
1278
|
158
|
|
|
|
|
212
|
my $addr = $s->{address}; |
1279
|
158
|
|
|
|
|
213
|
my $mask = $s->{netmask}; |
1280
|
158
|
|
|
|
|
238
|
my $nid = "$addr/$mask"; |
1281
|
158
|
|
|
|
|
225
|
my $net = _maskip($addr, $mask); |
1282
|
158
|
|
|
|
|
299
|
$sums{$net}{$mask}++; |
1283
|
158
|
|
|
|
|
202
|
my $rid = $s->{routerid}; |
1284
|
158
|
|
|
|
|
191
|
my $area = $s->{area}; |
1285
|
158
|
|
|
|
|
195
|
my $elem = $sumhash{$net}{$mask}; |
1286
|
158
|
100
|
|
|
|
243
|
if (! $elem) { |
1287
|
55
|
|
|
|
|
114
|
$sumhash{$net}{$mask} = $elem = {}; |
1288
|
|
|
|
|
|
|
$elem->{graph} = { |
1289
|
55
|
|
|
|
|
222
|
N => "summary$index", |
1290
|
|
|
|
|
|
|
label => "$net\\n$mask", |
1291
|
|
|
|
|
|
|
shape => "ellipse", |
1292
|
|
|
|
|
|
|
style => "dashed", |
1293
|
|
|
|
|
|
|
}; |
1294
|
55
|
|
|
|
|
105
|
$elem->{index} = $index++; |
1295
|
|
|
|
|
|
|
} |
1296
|
158
|
|
|
|
|
207
|
push @{$elem->{hashes}}, $s; |
|
158
|
|
|
|
|
257
|
|
1297
|
158
|
|
|
|
|
341
|
$elem->{arearids}{$area}{$rid}++; |
1298
|
|
|
|
|
|
|
} |
1299
|
92
|
|
|
|
|
144
|
$self->{sumhash} = \%sumhash; |
1300
|
92
|
|
|
|
|
148
|
$self->{sums} = \%sums; |
1301
|
|
|
|
|
|
|
} |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
# take hash containing summary nodes |
1304
|
|
|
|
|
|
|
# return list of nodes |
1305
|
|
|
|
|
|
|
sub summary2nodes { |
1306
|
144
|
|
|
144
|
0
|
188
|
my OSPF::LSDB::View $self = shift; |
1307
|
144
|
50
|
|
|
|
289
|
my $sumhash = $self->{sumhash} or die "Uninitialized member"; |
1308
|
144
|
|
|
|
|
273
|
return $self->elements2graphs(map { values %$_ } values %$sumhash); |
|
64
|
|
|
|
|
122
|
|
1309
|
|
|
|
|
|
|
} |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
# take summary hash, router hash |
1312
|
|
|
|
|
|
|
# return list of edges from summary network to router |
1313
|
|
|
|
|
|
|
sub summary2edges { |
1314
|
92
|
|
|
92
|
0
|
123
|
my OSPF::LSDB::View $self = shift; |
1315
|
92
|
50
|
|
|
|
172
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
1316
|
92
|
50
|
|
|
|
164
|
my $sumhash = $self->{sumhash} or die "Uninitialized member"; |
1317
|
92
|
|
|
|
|
105
|
my @elements; |
1318
|
92
|
|
|
|
|
97
|
my $index = 0; |
1319
|
92
|
|
|
|
|
180
|
foreach my $net (sort keys %$sumhash) { |
1320
|
55
|
|
|
|
|
100
|
my $nv = $sumhash->{$net}; |
1321
|
55
|
|
|
|
|
106
|
foreach my $mask (sort keys %$nv) { |
1322
|
55
|
|
|
|
|
63
|
my $mv = $nv->{$mask}; |
1323
|
55
|
|
|
|
|
91
|
my $nid = "$net/$mask"; |
1324
|
55
|
|
66
|
|
|
135
|
my $src = $mv->{graph} && $mv->{graph}{N}; |
1325
|
55
|
|
|
|
|
72
|
foreach my $s (@{$mv->{hashes}}) { |
|
55
|
|
|
|
|
88
|
|
1326
|
158
|
|
|
|
|
260
|
my $rid = $s->{routerid}; |
1327
|
|
|
|
|
|
|
my $dst = $routehash->{$rid}{graph}{N} |
1328
|
158
|
50
|
|
|
|
273
|
or die "No router graph $rid"; |
1329
|
158
|
|
|
|
|
184
|
my $addr = $s->{address}; |
1330
|
158
|
|
|
|
|
183
|
my $addrip = $addr; |
1331
|
158
|
|
|
|
|
341
|
foreach (split(/\./, $mask)) { |
1332
|
632
|
100
|
|
|
|
975
|
last if $_ ne 255; |
1333
|
474
|
|
|
|
|
1091
|
$addrip =~ s/^\.?\d+//; |
1334
|
|
|
|
|
|
|
} |
1335
|
158
|
|
|
|
|
244
|
my $area = $s->{area}; |
1336
|
158
|
|
|
|
|
281
|
my %colors = (gray => $area); |
1337
|
158
|
100
|
|
|
|
277
|
if (! $routehash->{$rid}{areas}{$area}) { |
1338
|
|
|
|
|
|
|
$self->error($colors{orange} = |
1339
|
1
|
|
|
|
|
7
|
"Summary network $nid and router $rid ". |
1340
|
|
|
|
|
|
|
"not in same area $area."); |
1341
|
|
|
|
|
|
|
} |
1342
|
158
|
100
|
|
|
|
279
|
if ($mv->{arearids}{$area}{$rid} > 1) { |
1343
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
1344
|
4
|
|
|
|
|
25
|
"Summary network $nid at router $rid ". |
1345
|
|
|
|
|
|
|
"has multiple entries in area $area."); |
1346
|
|
|
|
|
|
|
} |
1347
|
158
|
|
|
|
|
181
|
my $metric = $s->{metric}; |
1348
|
|
|
|
|
|
|
$s->{graph} = { |
1349
|
158
|
|
|
|
|
585
|
S => $src, |
1350
|
|
|
|
|
|
|
D => $dst, |
1351
|
|
|
|
|
|
|
headlabel => $metric, |
1352
|
|
|
|
|
|
|
style => "dashed", |
1353
|
|
|
|
|
|
|
taillabel => $addrip, |
1354
|
|
|
|
|
|
|
}; |
1355
|
158
|
|
|
|
|
237
|
$s->{colors} = \%colors; |
1356
|
158
|
|
|
|
|
245
|
$s->{index} = $index++; |
1357
|
|
|
|
|
|
|
# in case of aggregation src is undef |
1358
|
158
|
100
|
|
|
|
353
|
push @elements, $s if $src; |
1359
|
|
|
|
|
|
|
} |
1360
|
|
|
|
|
|
|
} |
1361
|
|
|
|
|
|
|
} |
1362
|
92
|
|
|
|
|
150
|
return $self->elements2graphs(@elements); |
1363
|
|
|
|
|
|
|
} |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
######################################################################## |
1366
|
|
|
|
|
|
|
# $sumaggr{$areaaggr}{$netaggr} = { |
1367
|
|
|
|
|
|
|
# graph => { N => summary5, color => black, style => dashed, } |
1368
|
|
|
|
|
|
|
# routers => { $routerid => { $area => { $metric => [ { sum hash } ] } } } |
1369
|
|
|
|
|
|
|
# } |
1370
|
|
|
|
|
|
|
######################################################################## |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
# take summary hash |
1373
|
|
|
|
|
|
|
# return summary aggregate |
1374
|
|
|
|
|
|
|
sub create_sumaggr { |
1375
|
25
|
|
|
25
|
0
|
36
|
my OSPF::LSDB::View $self = shift; |
1376
|
|
|
|
|
|
|
# $ridnets{$rid}{$network} = { |
1377
|
|
|
|
|
|
|
# color => orange, |
1378
|
|
|
|
|
|
|
# areas => { $area => { $metric => [ { sum hash } ] } } |
1379
|
|
|
|
|
|
|
# } |
1380
|
25
|
50
|
|
|
|
62
|
my $sumhash = $self->{sumhash} or die "Uninitialized member"; |
1381
|
25
|
|
|
|
|
73
|
my %ridareanets; |
1382
|
25
|
|
|
|
|
92
|
my $index = 0; |
1383
|
25
|
|
|
|
|
77
|
foreach my $net (sort keys %$sumhash) { |
1384
|
46
|
|
|
|
|
67
|
my $nv = $sumhash->{$net}; |
1385
|
46
|
|
|
|
|
72
|
foreach my $mask (sort keys %$nv) { |
1386
|
46
|
|
|
|
|
56
|
my $mv = $nv->{$mask}; |
1387
|
46
|
|
|
|
|
77
|
my $nid = "$net/$mask"; |
1388
|
|
|
|
|
|
|
# no not aggregate clustered graphs |
1389
|
46
|
100
|
|
|
|
107
|
next if $mv->{graph}{C}; |
1390
|
25
|
|
|
|
|
31
|
my $colors = $mv->{colors}; |
1391
|
|
|
|
|
|
|
# no not aggregate graphs with errors |
1392
|
25
|
100
|
|
|
|
50
|
next if grep { ! /^(gray|black)$/ } keys %$colors; |
|
26
|
|
|
|
|
156
|
|
1393
|
24
|
|
|
|
|
41
|
my $areaaggr = join('\n', sort _cmp_ip keys %{$mv->{arearids}}); |
|
24
|
|
|
|
|
85
|
|
1394
|
24
|
|
|
|
|
40
|
foreach my $s (@{$mv->{hashes}}) { |
|
24
|
|
|
|
|
45
|
|
1395
|
31
|
|
|
|
|
41
|
my $rid = $s->{routerid}; |
1396
|
31
|
|
|
|
|
50
|
my $area = $s->{area}; |
1397
|
31
|
|
|
|
|
38
|
my $metric = $s->{metric}; |
1398
|
31
|
|
|
|
|
49
|
my $elem = $ridareanets{$rid}{$areaaggr}{$nid}; |
1399
|
31
|
100
|
66
|
|
|
95
|
if (! $elem) { |
|
|
100
|
66
|
|
|
|
|
1400
|
27
|
|
|
|
|
92
|
$ridareanets{$rid}{$areaaggr}{$nid} = $elem = { |
1401
|
|
|
|
|
|
|
colors => { %$colors }, |
1402
|
|
|
|
|
|
|
index => $index++, |
1403
|
|
|
|
|
|
|
}; |
1404
|
|
|
|
|
|
|
} elsif (! $elem->{colors}{gray} || ! $colors->{gray} || |
1405
|
|
|
|
|
|
|
$elem->{colors}{gray} ne $colors->{gray}) { |
1406
|
3
|
|
|
|
|
35
|
push @{$elem->{colors}{black}}, |
1407
|
|
|
|
|
|
|
(delete($elem->{colors}{gray}) || ()), |
1408
|
3
|
50
|
33
|
|
|
7
|
($colors->{gray} || ()), @{$colors->{black} || []}; |
|
3
|
|
33
|
|
|
14
|
|
1409
|
|
|
|
|
|
|
} |
1410
|
31
|
|
|
|
|
41
|
push @{$elem->{areas}{$area}{$metric}}, $s; |
|
31
|
|
|
|
|
113
|
|
1411
|
|
|
|
|
|
|
} |
1412
|
24
|
|
|
|
|
57
|
delete $mv->{graph}; |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
} |
1415
|
25
|
|
|
|
|
40
|
my %sumaggr; |
1416
|
25
|
|
|
|
|
31
|
$index = 0; |
1417
|
25
|
|
|
|
|
90
|
foreach my $rid (sort keys %ridareanets) { |
1418
|
17
|
|
|
|
|
32
|
my $rv = $ridareanets{$rid}; |
1419
|
17
|
|
|
|
|
36
|
foreach my $area (sort keys %$rv) { |
1420
|
18
|
|
|
|
|
23
|
my $av = $rv->{$area}; |
1421
|
18
|
|
|
|
|
79
|
my $netaggr = join('\n', sort _cmp_ip_net keys %$av); |
1422
|
18
|
|
|
|
|
63
|
my $elem = $sumaggr{$netaggr}; |
1423
|
18
|
100
|
|
|
|
34
|
if (! $elem) { |
1424
|
17
|
|
|
|
|
46
|
$sumaggr{$netaggr} = $elem = {}; |
1425
|
|
|
|
|
|
|
$elem->{graph} = { |
1426
|
17
|
|
|
|
|
69
|
N => "summaryaggregate$index", |
1427
|
|
|
|
|
|
|
label => $netaggr, |
1428
|
|
|
|
|
|
|
shape => "ellipse", |
1429
|
|
|
|
|
|
|
style => "dashed", |
1430
|
|
|
|
|
|
|
}; |
1431
|
17
|
|
|
|
|
37
|
$elem->{index} = $index++; |
1432
|
|
|
|
|
|
|
} |
1433
|
18
|
|
|
|
|
44
|
foreach my $nid (sort keys %$av) { |
1434
|
27
|
|
|
|
|
40
|
my $nv = $av->{$nid}; |
1435
|
27
|
|
|
|
|
42
|
my $colors = $nv->{colors}; |
1436
|
27
|
100
|
66
|
|
|
103
|
if (! $elem->{colors}) { |
|
|
100
|
66
|
|
|
|
|
1437
|
17
|
|
|
|
|
36
|
%{$elem->{colors}} = %$colors; |
|
17
|
|
|
|
|
56
|
|
1438
|
|
|
|
|
|
|
} elsif (! $elem->{colors}{gray} || ! $colors->{gray} || |
1439
|
|
|
|
|
|
|
$elem->{colors}{gray} ne $colors->{gray}) { |
1440
|
1
|
|
|
|
|
8
|
push @{$elem->{colors}{black}}, |
1441
|
|
|
|
|
|
|
(delete($elem->{colors}{gray}) || ()), |
1442
|
1
|
50
|
33
|
|
|
4
|
($colors->{gray} || ()), @{$colors->{black} || []}; |
|
1
|
|
33
|
|
|
5
|
|
1443
|
|
|
|
|
|
|
} |
1444
|
27
|
|
|
|
|
37
|
foreach my $area (sort keys %{$nv->{areas}}) { |
|
27
|
|
|
|
|
72
|
|
1445
|
30
|
|
|
|
|
48
|
my $ev = $nv->{areas}{$area}; |
1446
|
30
|
|
|
|
|
52
|
foreach my $metric (sort keys %$ev) { |
1447
|
30
|
|
|
|
|
44
|
my $ss = $ev->{$metric}; |
1448
|
30
|
|
|
|
|
33
|
push @{$elem->{routers}{$rid}{$area}{$metric}}, @$ss; |
|
30
|
|
|
|
|
109
|
|
1449
|
|
|
|
|
|
|
} |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
} |
1453
|
|
|
|
|
|
|
} |
1454
|
25
|
|
|
|
|
105
|
$self->{sumaggr} = \%sumaggr; |
1455
|
|
|
|
|
|
|
} |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
# take hash containing summary aggregated nodes |
1458
|
|
|
|
|
|
|
# return list of nodes |
1459
|
|
|
|
|
|
|
sub sumaggr2nodes { |
1460
|
25
|
|
|
25
|
0
|
36
|
my OSPF::LSDB::View $self = shift; |
1461
|
25
|
50
|
|
|
|
58
|
my $sumaggr = $self->{sumaggr} or die "Uninitialized member"; |
1462
|
25
|
|
|
|
|
69
|
return $self->elements2graphs(values %$sumaggr); |
1463
|
|
|
|
|
|
|
} |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
# take summary aggregate |
1466
|
|
|
|
|
|
|
# return list of edges from summary aggregate networks to router |
1467
|
|
|
|
|
|
|
sub sumaggr2edges { |
1468
|
25
|
|
|
25
|
0
|
48
|
my OSPF::LSDB::View $self = shift; |
1469
|
25
|
50
|
|
|
|
55
|
my $sumaggr = $self->{sumaggr} or die "Uninitialized member"; |
1470
|
25
|
|
|
|
|
41
|
my @elements; |
1471
|
25
|
|
|
|
|
61
|
foreach my $netaggr (sort keys %$sumaggr) { |
1472
|
17
|
|
|
|
|
22
|
my $nv = $sumaggr->{$netaggr}; |
1473
|
17
|
|
|
|
|
30
|
my $src = $nv->{graph}{N}; |
1474
|
17
|
|
|
|
|
51
|
foreach my $rid (sort keys %{$nv->{routers}}) { |
|
17
|
|
|
|
|
56
|
|
1475
|
18
|
|
|
|
|
29
|
my $rv = $nv->{routers}{$rid}; |
1476
|
18
|
|
|
|
|
34
|
foreach my $area (sort keys %$rv) { |
1477
|
20
|
|
|
|
|
31
|
my $av = $rv->{$area}; |
1478
|
20
|
|
|
|
|
41
|
foreach my $metric (sort keys %$av) { |
1479
|
22
|
|
|
|
|
24
|
my $ss = $av->{$metric}; |
1480
|
22
|
|
|
|
|
26
|
my $aggrs; |
1481
|
22
|
|
|
|
|
50
|
foreach my $s (@$ss) { |
1482
|
31
|
|
|
|
|
41
|
$s->{graph}{S} = $src; |
1483
|
|
|
|
|
|
|
# no not aggregate graphs with errors |
1484
|
31
|
100
|
|
|
|
39
|
if (grep { ! /^(gray|black)$/ } keys %{$s->{colors}}) { |
|
33
|
|
|
|
|
295
|
|
|
31
|
|
|
|
|
92
|
|
1485
|
2
|
|
|
|
|
4
|
push @elements, $s; |
1486
|
|
|
|
|
|
|
} else { |
1487
|
29
|
|
|
|
|
62
|
delete $s->{graph}{taillabel}; |
1488
|
29
|
|
|
|
|
72
|
$aggrs = $s; |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
} |
1491
|
22
|
50
|
|
|
|
90
|
push @elements, $aggrs if $aggrs; |
1492
|
|
|
|
|
|
|
} |
1493
|
|
|
|
|
|
|
} |
1494
|
|
|
|
|
|
|
} |
1495
|
|
|
|
|
|
|
} |
1496
|
25
|
|
|
|
|
57
|
return $self->elements2graphs(@elements); |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
######################################################################## |
1500
|
|
|
|
|
|
|
# RFC 2328 |
1501
|
|
|
|
|
|
|
# LS LSA LSA description |
1502
|
|
|
|
|
|
|
# type name |
1503
|
|
|
|
|
|
|
# ________________________________________________________ |
1504
|
|
|
|
|
|
|
# 4 Summary-LSAs Originated by area border |
1505
|
|
|
|
|
|
|
# routers, and flooded through- |
1506
|
|
|
|
|
|
|
# out the LSA's associated |
1507
|
|
|
|
|
|
|
# area. Each summary-LSA |
1508
|
|
|
|
|
|
|
# describes a route to a |
1509
|
|
|
|
|
|
|
# destination outside the area, |
1510
|
|
|
|
|
|
|
# yet still inside the AS |
1511
|
|
|
|
|
|
|
# (i.e., an inter-area route). |
1512
|
|
|
|
|
|
|
# Type 3 summary-LSAs describe |
1513
|
|
|
|
|
|
|
# routes to networks. Type 4 |
1514
|
|
|
|
|
|
|
# summary-LSAs describe |
1515
|
|
|
|
|
|
|
# routes to AS boundary routers. |
1516
|
|
|
|
|
|
|
######################################################################## |
1517
|
|
|
|
|
|
|
# boundarys => [ |
1518
|
|
|
|
|
|
|
# area => 'ipv4', |
1519
|
|
|
|
|
|
|
# asbrouter => 'ipv4', # Link State ID |
1520
|
|
|
|
|
|
|
# metric => 'int', # metric |
1521
|
|
|
|
|
|
|
# routerid => 'ipv4', # Advertising Router |
1522
|
|
|
|
|
|
|
# ], |
1523
|
|
|
|
|
|
|
######################################################################## |
1524
|
|
|
|
|
|
|
# $boundhash{$asbrouter} = { |
1525
|
|
|
|
|
|
|
# graph => { N => boundary6, color => red, style => dashed, } |
1526
|
|
|
|
|
|
|
# hashes => [ { boundary hash } ] |
1527
|
|
|
|
|
|
|
# arearids => { $area => { $routerid => 1 } |
1528
|
|
|
|
|
|
|
# aggregate => { $asbraggr => 1 } (optional) |
1529
|
|
|
|
|
|
|
# } |
1530
|
|
|
|
|
|
|
######################################################################## |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
# take boundary hash |
1533
|
|
|
|
|
|
|
# detect inconsistencies and set colors |
1534
|
|
|
|
|
|
|
sub check_boundary { |
1535
|
151
|
|
|
151
|
0
|
183
|
my OSPF::LSDB::View $self = shift; |
1536
|
151
|
50
|
|
|
|
280
|
my $boundhash = $self->{boundhash} or die "Uninitialized member"; |
1537
|
151
|
|
|
|
|
416
|
while (my($asbr,$bv) = each %$boundhash) { |
1538
|
101
|
|
|
|
|
120
|
my @areas = sort keys %{$bv->{arearids}}; |
|
101
|
|
|
|
|
217
|
|
1539
|
101
|
100
|
|
|
|
175
|
if (@areas > 1) { |
1540
|
31
|
|
|
|
|
95
|
$bv->{colors}{black} = \@areas; |
1541
|
|
|
|
|
|
|
} else { |
1542
|
70
|
|
|
|
|
215
|
$bv->{colors}{gray} = $areas[0]; |
1543
|
|
|
|
|
|
|
} |
1544
|
|
|
|
|
|
|
} |
1545
|
|
|
|
|
|
|
} |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
# take boundary structure |
1548
|
|
|
|
|
|
|
# return boundary hash |
1549
|
|
|
|
|
|
|
sub create_boundary { |
1550
|
99
|
|
|
99
|
0
|
130
|
my OSPF::LSDB::View $self = shift; |
1551
|
99
|
|
|
|
|
115
|
my $index = 0; |
1552
|
99
|
|
|
|
|
107
|
my %boundhash; |
1553
|
99
|
|
|
|
|
110
|
foreach my $b (@{$self->{ospf}{database}{boundarys}}) { |
|
99
|
|
|
|
|
179
|
|
1554
|
180
|
|
|
|
|
287
|
my $asbr = $b->{asbrouter}; |
1555
|
180
|
|
|
|
|
228
|
my $rid = $b->{routerid}; |
1556
|
180
|
|
|
|
|
228
|
my $area = $b->{area}; |
1557
|
180
|
|
|
|
|
211
|
my $elem = $boundhash{$asbr}; |
1558
|
180
|
100
|
|
|
|
280
|
if (! $elem) { |
1559
|
81
|
|
|
|
|
144
|
$boundhash{$asbr} = $elem = {}; |
1560
|
|
|
|
|
|
|
$elem->{graph} = { |
1561
|
81
|
|
|
|
|
261
|
N => "boundary$index", |
1562
|
|
|
|
|
|
|
label => $asbr, |
1563
|
|
|
|
|
|
|
shape => "box", |
1564
|
|
|
|
|
|
|
style => "dashed", |
1565
|
|
|
|
|
|
|
}; |
1566
|
81
|
|
|
|
|
134
|
$elem->{index} = $index++; |
1567
|
|
|
|
|
|
|
} |
1568
|
180
|
|
|
|
|
196
|
push @{$elem->{hashes}}, $b; |
|
180
|
|
|
|
|
250
|
|
1569
|
180
|
|
|
|
|
347
|
$elem->{arearids}{$area}{$rid}++; |
1570
|
|
|
|
|
|
|
} |
1571
|
99
|
|
|
|
|
172
|
$self->{boundhash} = \%boundhash; |
1572
|
|
|
|
|
|
|
} |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
# take hash containing boundary nodes |
1575
|
|
|
|
|
|
|
# return list of nodes |
1576
|
|
|
|
|
|
|
sub boundary2nodes { |
1577
|
151
|
|
|
151
|
0
|
170
|
my OSPF::LSDB::View $self = shift; |
1578
|
151
|
50
|
|
|
|
282
|
my $boundhash = $self->{boundhash} or die "Uninitialized member"; |
1579
|
151
|
|
|
|
|
258
|
return $self->elements2graphs(values %$boundhash); |
1580
|
|
|
|
|
|
|
} |
1581
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
# take boundary hash, router hash |
1583
|
|
|
|
|
|
|
# return list of edges from boundary router to router |
1584
|
|
|
|
|
|
|
sub boundary2edges { |
1585
|
99
|
|
|
99
|
0
|
114
|
my OSPF::LSDB::View $self = shift; |
1586
|
99
|
50
|
|
|
|
185
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
1587
|
99
|
50
|
|
|
|
190
|
my $boundhash = $self->{boundhash} or die "Uninitialized member"; |
1588
|
99
|
|
|
|
|
108
|
my @elements; |
1589
|
99
|
|
|
|
|
112
|
my $index = 0; |
1590
|
99
|
|
|
|
|
198
|
foreach my $asbr (sort keys %$boundhash) { |
1591
|
81
|
|
|
|
|
113
|
my $bv = $boundhash->{$asbr}; |
1592
|
81
|
|
|
|
|
99
|
my $src; |
1593
|
81
|
100
|
|
|
|
171
|
if ($bv->{graph}) { |
|
|
100
|
|
|
|
|
|
1594
|
18
|
|
|
|
|
23
|
$src = $bv->{graph}{N}; |
1595
|
|
|
|
|
|
|
} elsif ($routehash->{$asbr}) { |
1596
|
|
|
|
|
|
|
$src = $routehash->{$asbr}{graph}{N} |
1597
|
27
|
|
|
|
|
45
|
} |
1598
|
81
|
|
|
|
|
158
|
foreach my $b (@{$bv->{hashes}}) { |
|
81
|
|
|
|
|
135
|
|
1599
|
180
|
|
|
|
|
234
|
my $rid = $b->{routerid}; |
1600
|
|
|
|
|
|
|
my $dst = $routehash->{$rid}{graph}{N} |
1601
|
180
|
50
|
|
|
|
345
|
or die "No router graph $rid"; |
1602
|
180
|
|
|
|
|
207
|
my $area = $b->{area}; |
1603
|
180
|
|
|
|
|
285
|
my %colors = (gray => $area); |
1604
|
180
|
100
|
66
|
|
|
489
|
if ($asbr eq $rid) { |
|
|
100
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
$self->error($colors{brown} = |
1606
|
1
|
|
|
|
|
7
|
"AS boundary router $asbr is advertized by itself ". |
1607
|
|
|
|
|
|
|
"in area $area."); |
1608
|
|
|
|
|
|
|
} elsif ($routehash->{$asbr} && $routehash->{$asbr}{areas}{$area}) { |
1609
|
|
|
|
|
|
|
$self->error($colors{blue} = |
1610
|
8
|
|
|
|
|
47
|
"AS boundary router $asbr is router in same area $area."); |
1611
|
|
|
|
|
|
|
} |
1612
|
180
|
100
|
|
|
|
305
|
if (! $routehash->{$rid}{areas}{$area}) { |
1613
|
|
|
|
|
|
|
$self->error($colors{orange} = |
1614
|
2
|
|
|
|
|
11
|
"AS boundary router $asbr and router $rid ". |
1615
|
|
|
|
|
|
|
"not in same area $area."); |
1616
|
|
|
|
|
|
|
} |
1617
|
180
|
100
|
|
|
|
303
|
if ($bv->{arearids}{$area}{$rid} > 1) { |
1618
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
1619
|
8
|
|
|
|
|
42
|
"AS boundary router $asbr at router $rid ". |
1620
|
|
|
|
|
|
|
"has multiple entries in area $area."); |
1621
|
|
|
|
|
|
|
} |
1622
|
180
|
|
|
|
|
292
|
my $metric = $b->{metric}; |
1623
|
|
|
|
|
|
|
$b->{graph} = { |
1624
|
180
|
|
|
|
|
484
|
S => $src, |
1625
|
|
|
|
|
|
|
D => $dst, |
1626
|
|
|
|
|
|
|
headlabel => $metric, |
1627
|
|
|
|
|
|
|
style => "dashed", |
1628
|
|
|
|
|
|
|
}; |
1629
|
180
|
|
|
|
|
348
|
$b->{colors} = \%colors; |
1630
|
180
|
|
|
|
|
225
|
$b->{index} = $index++; |
1631
|
|
|
|
|
|
|
# in case of aggregation src is undef |
1632
|
180
|
100
|
|
|
|
375
|
push @elements, $b if $src; |
1633
|
|
|
|
|
|
|
} |
1634
|
|
|
|
|
|
|
} |
1635
|
99
|
|
|
|
|
175
|
return $self->elements2graphs(@elements); |
1636
|
|
|
|
|
|
|
} |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
######################################################################## |
1639
|
|
|
|
|
|
|
# $boundaggr{$asbraggr} = { |
1640
|
|
|
|
|
|
|
# graph => { N => boundary7, color => black, style => dashed, } |
1641
|
|
|
|
|
|
|
# routers => { $routerid => { $area => { $metric => [ { bound hash } ] } } } |
1642
|
|
|
|
|
|
|
# } |
1643
|
|
|
|
|
|
|
######################################################################## |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
# take boundary hash |
1646
|
|
|
|
|
|
|
# return boundary aggregate |
1647
|
|
|
|
|
|
|
sub create_boundaggr { |
1648
|
30
|
|
|
30
|
0
|
41
|
my OSPF::LSDB::View $self = shift; |
1649
|
|
|
|
|
|
|
# $ridasbrs{$rid}{$asbr} = { |
1650
|
|
|
|
|
|
|
# color => orange, |
1651
|
|
|
|
|
|
|
# areas => { $area => { $metric => [ { bound hash } ] } } |
1652
|
|
|
|
|
|
|
# } |
1653
|
30
|
50
|
|
|
|
100
|
my $boundhash = $self->{boundhash} or die "Uninitialized member"; |
1654
|
30
|
|
|
|
|
43
|
my %ridasbrs; |
1655
|
30
|
|
|
|
|
47
|
my $index = 0; |
1656
|
30
|
|
|
|
|
106
|
foreach my $asbr (sort keys %$boundhash) { |
1657
|
56
|
|
|
|
|
67
|
my $bv = $boundhash->{$asbr}; |
1658
|
|
|
|
|
|
|
# no not aggregate if ASBR has been deleted by create route |
1659
|
56
|
100
|
|
|
|
105
|
next unless $bv->{graph}; |
1660
|
36
|
|
|
|
|
41
|
my $colors = $bv->{colors}; |
1661
|
|
|
|
|
|
|
# no not aggregate graphs with errors |
1662
|
36
|
50
|
|
|
|
77
|
next if grep { ! /^(gray|black)$/ } keys %$colors; |
|
36
|
|
|
|
|
210
|
|
1663
|
36
|
|
|
|
|
47
|
foreach my $b (@{$bv->{hashes}}) { |
|
36
|
|
|
|
|
63
|
|
1664
|
46
|
|
|
|
|
79
|
my $rid = $b->{routerid}; |
1665
|
46
|
|
|
|
|
53
|
my $area = $b->{area}; |
1666
|
46
|
|
|
|
|
61
|
my $metric = $b->{metric}; |
1667
|
46
|
|
|
|
|
70
|
my $elem = $ridasbrs{$rid}{$asbr}; |
1668
|
46
|
100
|
33
|
|
|
109
|
if (! $elem) { |
|
|
50
|
33
|
|
|
|
|
1669
|
44
|
|
|
|
|
143
|
$ridasbrs{$rid}{$asbr} = $elem = { |
1670
|
|
|
|
|
|
|
colors => { %$colors }, |
1671
|
|
|
|
|
|
|
index => $index++, |
1672
|
|
|
|
|
|
|
}; |
1673
|
|
|
|
|
|
|
} elsif (! $elem->{colors}{gray} || ! $colors->{gray} || |
1674
|
|
|
|
|
|
|
$elem->{colors}{gray} ne $colors->{gray}) { |
1675
|
0
|
|
|
|
|
0
|
push @{$elem->{colors}{black}}, |
1676
|
|
|
|
|
|
|
(delete($elem->{colors}{gray}) || ()), |
1677
|
0
|
0
|
0
|
|
|
0
|
($colors->{gray} || ()), @{$colors->{black} || []}; |
|
0
|
|
0
|
|
|
0
|
|
1678
|
|
|
|
|
|
|
} |
1679
|
46
|
|
|
|
|
94
|
push @{$elem->{areas}{$area}{$metric}}, $b; |
|
46
|
|
|
|
|
193
|
|
1680
|
|
|
|
|
|
|
} |
1681
|
36
|
|
|
|
|
83
|
delete $bv->{graph}; |
1682
|
|
|
|
|
|
|
} |
1683
|
30
|
|
|
|
|
47
|
my %boundaggr; |
1684
|
30
|
|
|
|
|
44
|
$index = 0; |
1685
|
30
|
|
|
|
|
67
|
foreach my $rid (sort keys %ridasbrs) { |
1686
|
23
|
|
|
|
|
35
|
my $rv = $ridasbrs{$rid}; |
1687
|
23
|
|
|
|
|
82
|
my $asbraggr = join('\n', sort _cmp_ip keys %$rv); |
1688
|
23
|
|
|
|
|
47
|
my $elem = $boundaggr{$asbraggr}; |
1689
|
23
|
100
|
|
|
|
42
|
if (! $elem) { |
1690
|
22
|
|
|
|
|
45
|
$boundaggr{$asbraggr} = $elem = {}; |
1691
|
|
|
|
|
|
|
$elem->{graph} = { |
1692
|
22
|
|
|
|
|
78
|
N => "boundaryaggregate$index", |
1693
|
|
|
|
|
|
|
label => $asbraggr, |
1694
|
|
|
|
|
|
|
shape => "box", |
1695
|
|
|
|
|
|
|
style => "dashed", |
1696
|
|
|
|
|
|
|
}; |
1697
|
22
|
|
|
|
|
48
|
$elem->{index} = $index++; |
1698
|
|
|
|
|
|
|
} |
1699
|
23
|
|
|
|
|
53
|
foreach my $asbr (sort keys %$rv) { |
1700
|
44
|
|
|
|
|
60
|
my $bv = $rv->{$asbr}; |
1701
|
44
|
|
|
|
|
80
|
$boundhash->{$asbr}{aggregate}{$asbraggr}++; |
1702
|
44
|
|
|
|
|
58
|
my $colors = $bv->{colors}; |
1703
|
44
|
100
|
66
|
|
|
157
|
if (! $elem->{colors}) { |
|
|
100
|
100
|
|
|
|
|
1704
|
22
|
|
|
|
|
45
|
%{$elem->{colors}} = %$colors; |
|
22
|
|
|
|
|
49
|
|
1705
|
|
|
|
|
|
|
} elsif (! $elem->{colors}{gray} || ! $colors->{gray} || |
1706
|
|
|
|
|
|
|
$elem->{colors}{gray} ne $colors->{gray}) { |
1707
|
3
|
|
|
|
|
16
|
push @{$elem->{colors}{black}}, |
1708
|
|
|
|
|
|
|
(delete($elem->{colors}{gray}) || ()), |
1709
|
3
|
50
|
66
|
|
|
4
|
($colors->{gray} || ()), @{$colors->{black} || []}; |
|
3
|
|
33
|
|
|
18
|
|
1710
|
|
|
|
|
|
|
} |
1711
|
44
|
|
|
|
|
58
|
foreach my $area (sort keys %{$bv->{areas}}) { |
|
44
|
|
|
|
|
94
|
|
1712
|
44
|
|
|
|
|
53
|
my $ev = $bv->{areas}{$area}; |
1713
|
44
|
|
|
|
|
186
|
foreach my $metric (sort keys %$ev) { |
1714
|
44
|
|
|
|
|
56
|
my $bs = $ev->{$metric}; |
1715
|
44
|
|
|
|
|
52
|
push @{$elem->{routers}{$rid}{$area}{$metric}}, @$bs; |
|
44
|
|
|
|
|
140
|
|
1716
|
|
|
|
|
|
|
} |
1717
|
|
|
|
|
|
|
} |
1718
|
|
|
|
|
|
|
} |
1719
|
|
|
|
|
|
|
} |
1720
|
30
|
|
|
|
|
114
|
$self->{boundaggr} = \%boundaggr; |
1721
|
|
|
|
|
|
|
} |
1722
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
# take hash containing boundary aggregated nodes |
1724
|
|
|
|
|
|
|
# return list of nodes |
1725
|
|
|
|
|
|
|
sub boundaggr2nodes { |
1726
|
30
|
|
|
30
|
0
|
45
|
my OSPF::LSDB::View $self = shift; |
1727
|
30
|
50
|
|
|
|
76
|
my $boundaggr = $self->{boundaggr} or die "Uninitialized member"; |
1728
|
30
|
|
|
|
|
79
|
return $self->elements2graphs(values %$boundaggr); |
1729
|
|
|
|
|
|
|
} |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
# take boundary aggregate |
1732
|
|
|
|
|
|
|
# return list of edges from boundary aggregate routers to router |
1733
|
|
|
|
|
|
|
sub boundaggr2edges { |
1734
|
30
|
|
|
30
|
0
|
41
|
my OSPF::LSDB::View $self = shift; |
1735
|
30
|
50
|
|
|
|
98
|
my $boundaggr = $self->{boundaggr} or die "Uninitialized member"; |
1736
|
30
|
|
|
|
|
42
|
my @elements; |
1737
|
30
|
|
|
|
|
71
|
foreach my $asbraggr (sort keys %$boundaggr) { |
1738
|
22
|
|
|
|
|
28
|
my $bv = $boundaggr->{$asbraggr}; |
1739
|
22
|
|
|
|
|
34
|
my $src = $bv->{graph}{N}; |
1740
|
22
|
|
|
|
|
42
|
foreach my $rid (sort keys %{$bv->{routers}}) { |
|
22
|
|
|
|
|
59
|
|
1741
|
23
|
|
|
|
|
33
|
my $rv = $bv->{routers}{$rid}; |
1742
|
23
|
|
|
|
|
56
|
foreach my $area (sort keys %$rv) { |
1743
|
25
|
|
|
|
|
38
|
my $av = $rv->{$area}; |
1744
|
25
|
|
|
|
|
51
|
foreach my $metric (sort keys %$av) { |
1745
|
27
|
|
|
|
|
40
|
my $bs = $av->{$metric}; |
1746
|
27
|
|
|
|
|
30
|
my $aggrb; |
1747
|
27
|
|
|
|
|
32
|
foreach my $b (@$bs) { |
1748
|
46
|
|
|
|
|
65
|
$b->{graph}{S} = $src; |
1749
|
|
|
|
|
|
|
# no not aggregate graphs with errors |
1750
|
46
|
100
|
|
|
|
49
|
if (grep { ! /^(gray|black)$/ } keys %{$b->{colors}}) { |
|
50
|
|
|
|
|
194
|
|
|
46
|
|
|
|
|
106
|
|
1751
|
4
|
|
|
|
|
7
|
push @elements, $b; |
1752
|
|
|
|
|
|
|
} else { |
1753
|
42
|
|
|
|
|
107
|
$aggrb = $b; |
1754
|
|
|
|
|
|
|
} |
1755
|
|
|
|
|
|
|
} |
1756
|
27
|
50
|
|
|
|
117
|
push @elements, $aggrb if $aggrb; |
1757
|
|
|
|
|
|
|
} |
1758
|
|
|
|
|
|
|
} |
1759
|
|
|
|
|
|
|
} |
1760
|
|
|
|
|
|
|
} |
1761
|
30
|
|
|
|
|
78
|
return $self->elements2graphs(@elements); |
1762
|
|
|
|
|
|
|
} |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
######################################################################## |
1765
|
|
|
|
|
|
|
# RFC 2328 |
1766
|
|
|
|
|
|
|
# LS LSA LSA description |
1767
|
|
|
|
|
|
|
# type name |
1768
|
|
|
|
|
|
|
# ________________________________________________________ |
1769
|
|
|
|
|
|
|
# 5 AS-external-LSAs Originated by AS boundary |
1770
|
|
|
|
|
|
|
# routers, and flooded through- |
1771
|
|
|
|
|
|
|
# out the AS. Each |
1772
|
|
|
|
|
|
|
# AS-external-LSA describes |
1773
|
|
|
|
|
|
|
# a route to a destination in |
1774
|
|
|
|
|
|
|
# another Autonomous System. |
1775
|
|
|
|
|
|
|
# Default routes for the AS can |
1776
|
|
|
|
|
|
|
# also be described by |
1777
|
|
|
|
|
|
|
# AS-external-LSAs. |
1778
|
|
|
|
|
|
|
######################################################################## |
1779
|
|
|
|
|
|
|
# externals => [ |
1780
|
|
|
|
|
|
|
# address => 'ipv4', # Link State ID |
1781
|
|
|
|
|
|
|
# metric => 'int', # metric |
1782
|
|
|
|
|
|
|
# forward => 'ipv4', # Forwarding address |
1783
|
|
|
|
|
|
|
# netmask => 'ipv4', # Network Mask |
1784
|
|
|
|
|
|
|
# routerid => 'ipv4', # Advertising Router |
1785
|
|
|
|
|
|
|
# type => 'int', # bit E |
1786
|
|
|
|
|
|
|
# ], |
1787
|
|
|
|
|
|
|
######################################################################## |
1788
|
|
|
|
|
|
|
# $network = $address & $netmask |
1789
|
|
|
|
|
|
|
# $externhash{$network}{$netmask} = { |
1790
|
|
|
|
|
|
|
# graph => { N => external8, color => red, style => dashed, } |
1791
|
|
|
|
|
|
|
# hashes => [ { ase hash } ] |
1792
|
|
|
|
|
|
|
# routers => { $routerid => 1 } |
1793
|
|
|
|
|
|
|
# } |
1794
|
|
|
|
|
|
|
######################################################################## |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
# take external hash, net cluster hash, network hash, stub hash, summary hash |
1797
|
|
|
|
|
|
|
# detect inconsistencies and set colors |
1798
|
|
|
|
|
|
|
sub check_external { |
1799
|
99
|
|
|
99
|
0
|
188
|
my OSPF::LSDB::View $self = shift; |
1800
|
99
|
|
|
|
|
132
|
my($netcluster) = @_; |
1801
|
99
|
50
|
|
|
|
193
|
my $nets = $self->{nets} or die "Uninitialized member"; |
1802
|
99
|
50
|
|
|
|
163
|
my $stubs = $self->{stubs} or die "Uninitialized member"; |
1803
|
99
|
|
|
|
|
128
|
my $sums = $self->{sums}; |
1804
|
99
|
50
|
|
|
|
163
|
my $externhash = $self->{externhash} or die "Uninitialized member"; |
1805
|
99
|
|
|
|
|
213
|
foreach my $net (sort keys %$externhash) { |
1806
|
87
|
|
|
|
|
114
|
my $nv = $externhash->{$net}; |
1807
|
87
|
|
|
|
|
135
|
foreach my $mask (sort keys %$nv) { |
1808
|
87
|
|
|
|
|
106
|
my $mv = $nv->{$mask}; |
1809
|
87
|
|
|
|
|
183
|
my %colors = (gray => "ase"); |
1810
|
87
|
|
|
|
|
141
|
my $nid = "$net/$mask"; |
1811
|
87
|
100
|
|
|
|
189
|
if ($nets->{$net}{$mask}) { |
1812
|
|
|
|
|
|
|
$self->error($colors{blue} = |
1813
|
3
|
|
|
|
|
14
|
"AS external network $nid is also network."); |
1814
|
|
|
|
|
|
|
} |
1815
|
87
|
100
|
66
|
|
|
256
|
if ($stubs and $stubs->{$net}{$mask}) { |
1816
|
|
|
|
|
|
|
$self->error($colors{green} = |
1817
|
5
|
|
|
|
|
20
|
"AS external network $nid is also stub network."); |
1818
|
|
|
|
|
|
|
} |
1819
|
87
|
100
|
|
|
|
159
|
if ($sums->{$net}{$mask}) { |
1820
|
|
|
|
|
|
|
$self->error($colors{cyan} = |
1821
|
4
|
|
|
|
|
14
|
"AS external network $nid is also summary network."); |
1822
|
|
|
|
|
|
|
} |
1823
|
87
|
|
|
|
|
126
|
$mv->{colors} = \%colors; |
1824
|
87
|
|
|
|
|
102
|
push @{$netcluster->{"$net/$mask"}}, $mv->{graph}; |
|
87
|
|
|
|
|
277
|
|
1825
|
|
|
|
|
|
|
} |
1826
|
|
|
|
|
|
|
} |
1827
|
|
|
|
|
|
|
} |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
# take external structure, net cluster hash, network hash, link hash |
1830
|
|
|
|
|
|
|
# return external hash |
1831
|
|
|
|
|
|
|
sub create_external { |
1832
|
99
|
|
|
99
|
0
|
133
|
my OSPF::LSDB::View $self = shift; |
1833
|
99
|
|
|
|
|
151
|
my $index = 0; |
1834
|
99
|
|
|
|
|
121
|
my %externhash; |
1835
|
99
|
|
|
|
|
108
|
foreach my $e (@{$self->{ospf}{database}{externals}}) { |
|
99
|
|
|
|
|
175
|
|
1836
|
138
|
|
|
|
|
221
|
my $addr = $e->{address}; |
1837
|
138
|
|
|
|
|
165
|
my $mask = $e->{netmask}; |
1838
|
138
|
|
|
|
|
204
|
my $nid = "$addr/$mask"; |
1839
|
138
|
|
|
|
|
201
|
my $net = _maskip($addr, $mask); |
1840
|
138
|
|
|
|
|
196
|
my $rid = $e->{routerid}; |
1841
|
138
|
|
|
|
|
248
|
my $elem = $externhash{$net}{$mask}; |
1842
|
138
|
100
|
|
|
|
212
|
if (! $elem) { |
1843
|
87
|
|
|
|
|
180
|
$externhash{$net}{$mask} = $elem = {}; |
1844
|
|
|
|
|
|
|
$elem->{graph} = { |
1845
|
87
|
|
|
|
|
324
|
N => "external$index", |
1846
|
|
|
|
|
|
|
label => "$net\\n$mask", |
1847
|
|
|
|
|
|
|
shape => "egg", |
1848
|
|
|
|
|
|
|
style => "solid", |
1849
|
|
|
|
|
|
|
}; |
1850
|
87
|
|
|
|
|
162
|
$elem->{index} = $index++; |
1851
|
|
|
|
|
|
|
} |
1852
|
138
|
|
|
|
|
146
|
push @{$elem->{hashes}}, $e; |
|
138
|
|
|
|
|
253
|
|
1853
|
138
|
|
|
|
|
280
|
$elem->{routers}{$rid}++; |
1854
|
|
|
|
|
|
|
} |
1855
|
99
|
|
|
|
|
177
|
$self->{externhash} = \%externhash; |
1856
|
|
|
|
|
|
|
} |
1857
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
# take hash containing external nodes |
1859
|
|
|
|
|
|
|
# return list of nodes |
1860
|
|
|
|
|
|
|
sub external2nodes { |
1861
|
151
|
|
|
151
|
0
|
199
|
my OSPF::LSDB::View $self = shift; |
1862
|
151
|
50
|
|
|
|
275
|
my $externhash = $self->{externhash} or die "Uninitialized member"; |
1863
|
151
|
|
|
|
|
238
|
return $self->elements2graphs(map { values %$_ } values %$externhash); |
|
99
|
|
|
|
|
155
|
|
1864
|
|
|
|
|
|
|
} |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
# take external hash, router hash, boundary hash, boundary aggregate |
1867
|
|
|
|
|
|
|
# return list of edges from external network to router |
1868
|
|
|
|
|
|
|
sub external2edges { |
1869
|
99
|
|
|
99
|
0
|
126
|
my OSPF::LSDB::View $self = shift; |
1870
|
99
|
50
|
|
|
|
180
|
my $routehash = $self->{routehash} or die "Uninitialized member"; |
1871
|
99
|
|
|
|
|
183
|
my $boundhash = $self->{boundhash}; |
1872
|
99
|
|
|
|
|
132
|
my $boundaggr = $self->{boundaggr}; |
1873
|
99
|
50
|
|
|
|
178
|
my $externhash = $self->{externhash} or die "Uninitialized member"; |
1874
|
99
|
|
|
|
|
117
|
my @elements; |
1875
|
99
|
|
|
|
|
119
|
my $index = 0; |
1876
|
99
|
|
|
|
|
192
|
foreach my $net (sort keys %$externhash) { |
1877
|
87
|
|
|
|
|
122
|
my $nv = $externhash->{$net}; |
1878
|
87
|
|
|
|
|
161
|
foreach my $mask (sort keys %$nv) { |
1879
|
87
|
|
|
|
|
99
|
my $mv = $nv->{$mask}; |
1880
|
87
|
|
|
|
|
144
|
my $nid = "$net/$mask"; |
1881
|
87
|
|
|
|
|
132
|
my $src = $mv->{graph}{N}; |
1882
|
87
|
|
|
|
|
102
|
my %dtm; # when dst is aggregated, aggregate edges |
1883
|
87
|
|
|
|
|
123
|
foreach my $e (@{$mv->{hashes}}) { |
|
87
|
|
|
|
|
150
|
|
1884
|
138
|
|
|
|
|
194
|
my $rid = $e->{routerid}; |
1885
|
138
|
|
|
|
|
168
|
my $addr = $e->{address}; |
1886
|
138
|
|
|
|
|
156
|
my $addrip = $addr; |
1887
|
138
|
|
|
|
|
308
|
foreach (split(/\./, $mask)) { |
1888
|
489
|
100
|
|
|
|
739
|
last if $_ ne 255; |
1889
|
355
|
|
|
|
|
860
|
$addrip =~ s/^\.?\d+//; |
1890
|
|
|
|
|
|
|
} |
1891
|
138
|
|
|
|
|
213
|
my $type = $e->{type}; |
1892
|
138
|
|
|
|
|
211
|
my $metric = $e->{metric}; |
1893
|
138
|
|
|
|
|
230
|
my %colors = (gray => "ase"); |
1894
|
138
|
100
|
|
|
|
245
|
if ($mv->{routers}{$rid} > 1) { |
1895
|
|
|
|
|
|
|
$self->error($colors{yellow} = |
1896
|
9
|
|
|
|
|
33
|
"AS external network $nid at router $rid ". |
1897
|
|
|
|
|
|
|
"has multiple entries."); |
1898
|
|
|
|
|
|
|
} |
1899
|
138
|
100
|
|
|
|
251
|
my $style = $type == 1 ? "solid" : "dashed"; |
1900
|
138
|
|
|
|
|
346
|
my %graph = ( |
1901
|
|
|
|
|
|
|
S => $src, |
1902
|
|
|
|
|
|
|
headlabel => $metric, |
1903
|
|
|
|
|
|
|
style => $style, |
1904
|
|
|
|
|
|
|
taillabel => $addrip, |
1905
|
|
|
|
|
|
|
); |
1906
|
138
|
100
|
|
|
|
252
|
if ($routehash->{$rid}) { |
1907
|
|
|
|
|
|
|
my $dst = $routehash->{$rid}{graph}{N} |
1908
|
98
|
50
|
|
|
|
185
|
or die "No router graph $rid"; |
1909
|
98
|
|
|
|
|
128
|
$graph{D} = $dst; |
1910
|
98
|
|
|
|
|
343
|
$e->{elems}{$dst} = { |
1911
|
|
|
|
|
|
|
graph => \%graph, |
1912
|
|
|
|
|
|
|
colors => \%colors, |
1913
|
|
|
|
|
|
|
index => $index++, |
1914
|
|
|
|
|
|
|
}; |
1915
|
98
|
100
|
|
|
|
162
|
push @elements, $e->{elems}{$dst} if $src; |
1916
|
98
|
|
|
|
|
197
|
next; |
1917
|
|
|
|
|
|
|
} |
1918
|
40
|
|
|
|
|
68
|
my $av = $boundhash->{$rid}{aggregate}; |
1919
|
40
|
100
|
|
|
|
100
|
if (! $av) { |
1920
|
|
|
|
|
|
|
my $dst = $boundhash->{$rid}{graph}{N} |
1921
|
12
|
50
|
|
|
|
23
|
or die "No ASB router graph $rid"; |
1922
|
12
|
|
|
|
|
20
|
$graph{D} = $dst; |
1923
|
12
|
|
|
|
|
32
|
$e->{elems}{$dst} = { |
1924
|
|
|
|
|
|
|
graph => \%graph, |
1925
|
|
|
|
|
|
|
colors => \%colors, |
1926
|
|
|
|
|
|
|
index => $index++, |
1927
|
|
|
|
|
|
|
}; |
1928
|
12
|
100
|
|
|
|
35
|
push @elements, $e->{elems}{$dst} if $src; |
1929
|
12
|
|
|
|
|
23
|
next; |
1930
|
|
|
|
|
|
|
} |
1931
|
28
|
|
|
|
|
75
|
foreach my $asbraggr (sort keys %$av) { |
1932
|
36
|
|
|
|
|
50
|
my $num = $av->{$asbraggr}; |
1933
|
|
|
|
|
|
|
my $dst = $boundaggr->{$asbraggr}{graph}{N} |
1934
|
36
|
50
|
|
|
|
79
|
or die "No ASBR graph $asbraggr"; |
1935
|
36
|
|
|
|
|
46
|
$graph{D} = $dst; |
1936
|
36
|
|
|
|
|
204
|
$e->{elems}{$dst} = { |
1937
|
|
|
|
|
|
|
graph => { %graph }, |
1938
|
|
|
|
|
|
|
colors => { %colors }, |
1939
|
|
|
|
|
|
|
index => $index++, |
1940
|
|
|
|
|
|
|
}; |
1941
|
|
|
|
|
|
|
# no not aggregate graphs with errors |
1942
|
36
|
100
|
|
|
|
76
|
if (grep { ! /^(gray|black)$/ } keys %colors) { |
|
38
|
|
|
|
|
142
|
|
1943
|
2
|
50
|
|
|
|
9
|
push @elements, $e->{elems}{$dst} if $src; |
1944
|
|
|
|
|
|
|
} else { |
1945
|
34
|
|
|
|
|
125
|
$dtm{$dst}{$type}{$metric} = $e->{elems}{$dst}; |
1946
|
|
|
|
|
|
|
} |
1947
|
|
|
|
|
|
|
} |
1948
|
|
|
|
|
|
|
} |
1949
|
87
|
100
|
|
|
|
209
|
push @elements, map { values %$_ } map { values %$_ } values %dtm |
|
5
|
|
|
|
|
28
|
|
|
5
|
|
|
|
|
11
|
|
1950
|
|
|
|
|
|
|
if $src; |
1951
|
|
|
|
|
|
|
} |
1952
|
|
|
|
|
|
|
} |
1953
|
99
|
|
|
|
|
163
|
return $self->elements2graphs(@elements); |
1954
|
|
|
|
|
|
|
} |
1955
|
|
|
|
|
|
|
|
1956
|
|
|
|
|
|
|
######################################################################## |
1957
|
|
|
|
|
|
|
# $externaggr{$netaggr} = { |
1958
|
|
|
|
|
|
|
# graph => { N => external9, color => red, style => dashed, } |
1959
|
|
|
|
|
|
|
# routers => { $routerid => { $type => { $metric => [ { ase hash } ] } } } |
1960
|
|
|
|
|
|
|
# } |
1961
|
|
|
|
|
|
|
######################################################################## |
1962
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
# take external hash |
1964
|
|
|
|
|
|
|
# return external aggregate |
1965
|
|
|
|
|
|
|
sub create_externaggr { |
1966
|
19
|
|
|
19
|
0
|
31
|
my OSPF::LSDB::View $self = shift; |
1967
|
|
|
|
|
|
|
# $ridnets{$rid}{$network} = |
1968
|
|
|
|
|
|
|
# color => orange, |
1969
|
|
|
|
|
|
|
# types => { $type => { $metric => [ { ase hash } ] } } |
1970
|
19
|
50
|
|
|
|
42
|
my $externhash = $self->{externhash} or die "Uninitialized member"; |
1971
|
19
|
|
|
|
|
31
|
my %ridnets; |
1972
|
19
|
|
|
|
|
24
|
my $index = 0; |
1973
|
19
|
|
|
|
|
127
|
foreach my $net (sort keys %$externhash) { |
1974
|
73
|
|
|
|
|
103
|
my $nv = $externhash->{$net}; |
1975
|
73
|
|
|
|
|
128
|
foreach my $mask (sort keys %$nv) { |
1976
|
73
|
|
|
|
|
87
|
my $mv = $nv->{$mask}; |
1977
|
73
|
|
|
|
|
149
|
my $nid = "$net/$mask"; |
1978
|
|
|
|
|
|
|
# no not aggregate clustered graphs |
1979
|
73
|
100
|
|
|
|
139
|
next if $mv->{graph}{C}; |
1980
|
70
|
|
|
|
|
78
|
my $colors = $mv->{colors}; |
1981
|
|
|
|
|
|
|
# no not aggregate graphs with errors |
1982
|
70
|
100
|
|
|
|
137
|
next if grep { ! /^(gray|black)$/ } keys %$colors; |
|
72
|
|
|
|
|
282
|
|
1983
|
68
|
|
|
|
|
83
|
foreach my $e (@{$mv->{hashes}}) { |
|
68
|
|
|
|
|
124
|
|
1984
|
107
|
|
|
|
|
129
|
my $rid = $e->{routerid}; |
1985
|
107
|
|
|
|
|
122
|
my $type = $e->{type}; |
1986
|
107
|
|
|
|
|
117
|
my $metric = $e->{metric}; |
1987
|
107
|
|
|
|
|
158
|
my $elem = $ridnets{$rid}{$nid}; |
1988
|
107
|
100
|
33
|
|
|
174
|
if (! $elem) { |
|
|
50
|
33
|
|
|
|
|
1989
|
105
|
|
|
|
|
371
|
$ridnets{$rid}{$nid} = $elem = { |
1990
|
|
|
|
|
|
|
colors => { %$colors }, |
1991
|
|
|
|
|
|
|
index => $index++, |
1992
|
|
|
|
|
|
|
}; |
1993
|
|
|
|
|
|
|
} elsif (! $elem->{colors}{gray} || ! $colors->{gray} || |
1994
|
|
|
|
|
|
|
$elem->{colors}{gray} ne $colors->{gray}) { |
1995
|
0
|
|
|
|
|
0
|
push @{$elem->{colors}{black}}, |
1996
|
|
|
|
|
|
|
(delete($elem->{colors}{gray}) || ()), |
1997
|
0
|
0
|
0
|
|
|
0
|
($colors->{gray} || ()), @{$colors->{black} || []}; |
|
0
|
|
0
|
|
|
0
|
|
1998
|
|
|
|
|
|
|
} |
1999
|
107
|
|
|
|
|
145
|
push @{$elem->{types}{$type}{$metric}}, $e; |
|
107
|
|
|
|
|
363
|
|
2000
|
|
|
|
|
|
|
} |
2001
|
68
|
|
|
|
|
126
|
delete $mv->{graph}; |
2002
|
|
|
|
|
|
|
} |
2003
|
|
|
|
|
|
|
} |
2004
|
19
|
|
|
|
|
32
|
my %externaggr; |
2005
|
19
|
|
|
|
|
31
|
$index = 0; |
2006
|
19
|
|
|
|
|
83
|
foreach my $rid (sort keys %ridnets) { |
2007
|
38
|
|
|
|
|
58
|
my $rv = $ridnets{$rid}; |
2008
|
38
|
|
|
|
|
138
|
my $netaggr = join('\n', sort _cmp_ip_net keys %$rv); |
2009
|
38
|
|
|
|
|
72
|
my $elem = $externaggr{$netaggr}; |
2010
|
38
|
100
|
|
|
|
60
|
if (! $elem) { |
2011
|
32
|
|
|
|
|
71
|
$externaggr{$netaggr} = $elem = {}; |
2012
|
|
|
|
|
|
|
$elem->{graph} = { |
2013
|
32
|
|
|
|
|
149
|
N => "externalaggregate$index", |
2014
|
|
|
|
|
|
|
label => $netaggr, |
2015
|
|
|
|
|
|
|
shape => "egg", |
2016
|
|
|
|
|
|
|
style => "solid", |
2017
|
|
|
|
|
|
|
}; |
2018
|
32
|
|
|
|
|
64
|
$elem->{index} = $index++; |
2019
|
|
|
|
|
|
|
} |
2020
|
38
|
|
|
|
|
142
|
foreach my $nid (sort keys %$rv) { |
2021
|
105
|
|
|
|
|
126
|
my $nv = $rv->{$nid}; |
2022
|
105
|
|
|
|
|
142
|
my $colors = $nv->{colors}; |
2023
|
105
|
100
|
33
|
|
|
381
|
if (! $elem->{colors}) { |
|
|
50
|
33
|
|
|
|
|
2024
|
32
|
|
|
|
|
117
|
%{$elem->{colors}} = %$colors; |
|
32
|
|
|
|
|
76
|
|
2025
|
|
|
|
|
|
|
} elsif (! $elem->{colors}{gray} || ! $colors->{gray} || |
2026
|
|
|
|
|
|
|
$elem->{colors}{gray} ne $colors->{gray}) { |
2027
|
0
|
|
|
|
|
0
|
push @{$elem->{colors}{black}}, |
2028
|
|
|
|
|
|
|
(delete($elem->{colors}{gray}) || ()), |
2029
|
0
|
0
|
0
|
|
|
0
|
($colors->{gray} || ()), @{$colors->{black} || []}; |
|
0
|
|
0
|
|
|
0
|
|
2030
|
|
|
|
|
|
|
} |
2031
|
105
|
|
|
|
|
155
|
foreach my $type (sort keys %{$nv->{types}}) { |
|
105
|
|
|
|
|
228
|
|
2032
|
105
|
|
|
|
|
121
|
my $tv = $nv->{types}{$type}; |
2033
|
105
|
|
|
|
|
175
|
foreach my $metric (sort keys %$tv) { |
2034
|
105
|
|
|
|
|
134
|
my $es = $tv->{$metric}; |
2035
|
105
|
|
|
|
|
113
|
push @{$elem->{routers}{$rid}{$type}{$metric}}, @$es; |
|
105
|
|
|
|
|
643
|
|
2036
|
|
|
|
|
|
|
} |
2037
|
|
|
|
|
|
|
} |
2038
|
|
|
|
|
|
|
} |
2039
|
|
|
|
|
|
|
} |
2040
|
19
|
|
|
|
|
129
|
$self->{externaggr} = \%externaggr; |
2041
|
|
|
|
|
|
|
} |
2042
|
|
|
|
|
|
|
|
2043
|
|
|
|
|
|
|
# take hash containing external aggregated nodes |
2044
|
|
|
|
|
|
|
# return list of nodes |
2045
|
|
|
|
|
|
|
sub externaggr2nodes { |
2046
|
19
|
|
|
19
|
0
|
33
|
my OSPF::LSDB::View $self = shift; |
2047
|
19
|
50
|
|
|
|
43
|
my $externaggr = $self->{externaggr} or die "Uninitialized member"; |
2048
|
19
|
|
|
|
|
52
|
return $self->elements2graphs(values %$externaggr); |
2049
|
|
|
|
|
|
|
} |
2050
|
|
|
|
|
|
|
|
2051
|
|
|
|
|
|
|
# take external aggregate |
2052
|
|
|
|
|
|
|
# return list of edges from external aggregate network to router |
2053
|
|
|
|
|
|
|
sub externaggr2edges { |
2054
|
19
|
|
|
19
|
0
|
29
|
my OSPF::LSDB::View $self = shift; |
2055
|
19
|
50
|
|
|
|
53
|
my $externaggr = $self->{externaggr} or die "Uninitialized member"; |
2056
|
19
|
|
|
|
|
27
|
my @elements; |
2057
|
19
|
|
|
|
|
23
|
my $index = 0; |
2058
|
19
|
|
|
|
|
88
|
foreach my $netaggr (sort keys %$externaggr) { |
2059
|
32
|
|
|
|
|
59
|
my $nv = $externaggr->{$netaggr}; |
2060
|
32
|
|
|
|
|
64
|
my $src = $nv->{graph}{N}; |
2061
|
32
|
|
|
|
|
34
|
my %dtm; |
2062
|
32
|
|
|
|
|
36
|
foreach my $rid (sort keys %{$nv->{routers}}) { |
|
32
|
|
|
|
|
85
|
|
2063
|
38
|
|
|
|
|
91
|
my $rv = $nv->{routers}{$rid}; |
2064
|
38
|
|
|
|
|
73
|
foreach my $type (sort keys %$rv) { |
2065
|
38
|
|
|
|
|
55
|
my $tv = $rv->{$type}; |
2066
|
38
|
|
|
|
|
71
|
foreach my $metric (sort keys %$tv) { |
2067
|
40
|
|
|
|
|
53
|
my $es = $tv->{$metric}; |
2068
|
40
|
|
|
|
|
53
|
foreach my $e (@$es) { |
2069
|
107
|
|
|
|
|
117
|
foreach my $dst (sort keys %{$e->{elems}}) { |
|
107
|
|
|
|
|
241
|
|
2070
|
111
|
|
|
|
|
142
|
my $elem = $e->{elems}{$dst}; |
2071
|
111
|
|
|
|
|
109
|
my %graph = %{$elem->{graph}}; |
|
111
|
|
|
|
|
356
|
|
2072
|
111
|
|
|
|
|
184
|
$graph{S} = $src; |
2073
|
111
|
|
|
|
|
138
|
delete $graph{taillabel}; |
2074
|
111
|
|
|
|
|
108
|
my %colors = %{$elem->{colors}}; |
|
111
|
|
|
|
|
224
|
|
2075
|
111
|
|
|
|
|
224
|
my $newelem = { |
2076
|
|
|
|
|
|
|
graph => \%graph, |
2077
|
|
|
|
|
|
|
colors => \%colors, |
2078
|
|
|
|
|
|
|
index => $index++, |
2079
|
|
|
|
|
|
|
}; |
2080
|
|
|
|
|
|
|
# no not aggregate graphs with errors |
2081
|
111
|
100
|
|
|
|
242
|
if (grep { ! /^(gray|black)$/ } keys %colors) { |
|
115
|
|
|
|
|
392
|
|
2082
|
4
|
|
|
|
|
8
|
push @elements, $newelem; |
2083
|
|
|
|
|
|
|
} else { |
2084
|
107
|
|
|
|
|
335
|
$dtm{$dst}{$type}{$metric} = $newelem; |
2085
|
|
|
|
|
|
|
} |
2086
|
|
|
|
|
|
|
} |
2087
|
|
|
|
|
|
|
} |
2088
|
|
|
|
|
|
|
} |
2089
|
|
|
|
|
|
|
} |
2090
|
|
|
|
|
|
|
} |
2091
|
32
|
|
|
|
|
71
|
push @elements, map { values %$_ } map { values %$_ } values %dtm; |
|
35
|
|
|
|
|
104
|
|
|
35
|
|
|
|
|
73
|
|
2092
|
|
|
|
|
|
|
} |
2093
|
19
|
|
|
|
|
48
|
return $self->elements2graphs(@elements); |
2094
|
|
|
|
|
|
|
} |
2095
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
# take cluster hash |
2097
|
|
|
|
|
|
|
# insert cluster into graphs referenced more than once |
2098
|
|
|
|
|
|
|
sub set_cluster { |
2099
|
24
|
|
|
24
|
0
|
67
|
my OSPF::LSDB::View $self = shift; |
2100
|
24
|
|
|
|
|
41
|
my($type) = @_; |
2101
|
24
|
50
|
|
|
|
69
|
my $cluster = $self->{$type."cluster"} or die "Uninitialized member"; |
2102
|
24
|
|
|
|
|
101
|
while (my($id,$graphlist) = each %$cluster) { |
2103
|
98
|
100
|
|
|
|
210
|
next if @$graphlist < 2; |
2104
|
24
|
|
|
|
|
35
|
foreach (@$graphlist) { |
2105
|
55
|
|
|
|
|
108
|
$_->{C} = $id; |
2106
|
|
|
|
|
|
|
} |
2107
|
|
|
|
|
|
|
} |
2108
|
|
|
|
|
|
|
} |
2109
|
|
|
|
|
|
|
|
2110
|
|
|
|
|
|
|
# take list of nodes ( { N => node, C => cluster, label => ... }, ... ) |
2111
|
|
|
|
|
|
|
# return nodes of dot graph |
2112
|
|
|
|
|
|
|
sub graph_nodes { |
2113
|
199
|
|
|
199
|
0
|
255
|
my $class = shift; |
2114
|
199
|
|
|
|
|
294
|
my @nodes = @_; |
2115
|
199
|
|
|
|
|
590
|
my $dot = ""; |
2116
|
199
|
|
|
|
|
294
|
foreach (@nodes) { |
2117
|
858
|
|
|
|
|
1017
|
my $cluster = $_->{C}; |
2118
|
858
|
|
|
|
|
904
|
$dot .= "\t"; |
2119
|
858
|
100
|
|
|
|
1120
|
$dot .= "subgraph \"cluster $cluster\" { " if $cluster; |
2120
|
858
|
|
|
|
|
1114
|
$dot .= "$_->{N} [\n"; |
2121
|
858
|
|
|
|
|
2682
|
foreach my $k (sort keys %$_) { |
2122
|
5254
|
100
|
100
|
|
|
10769
|
next if $k eq 'C' || $k eq 'N'; |
2123
|
4341
|
|
|
|
|
4811
|
my $v = $_->{$k}; |
2124
|
4341
|
|
|
|
|
6710
|
$dot .= "\t\t$k=\"$v\"\n"; |
2125
|
|
|
|
|
|
|
} |
2126
|
858
|
|
|
|
|
1107
|
$dot .= "\t]"; |
2127
|
858
|
100
|
|
|
|
1119
|
$dot .= " }" if $cluster; |
2128
|
858
|
|
|
|
|
1028
|
$dot .= ";\n"; |
2129
|
|
|
|
|
|
|
} |
2130
|
199
|
|
|
|
|
676
|
return $dot; |
2131
|
|
|
|
|
|
|
} |
2132
|
|
|
|
|
|
|
|
2133
|
|
|
|
|
|
|
# take array containing elements, create color |
2134
|
|
|
|
|
|
|
# return nodes or edges of dot graph |
2135
|
|
|
|
|
|
|
sub elements2graphs { |
2136
|
2565
|
|
|
2565
|
0
|
2836
|
my OSPF::LSDB::View $self = shift; |
2137
|
2565
|
|
|
|
|
3413
|
my @elements = sort { $a->{index} <=> $b->{index} } grep { $_->{graph} } @_; |
|
1587
|
|
|
|
|
2381
|
|
|
2425
|
|
|
|
|
3902
|
|
2138
|
2565
|
|
|
|
|
3136
|
foreach my $elem (@elements) { |
2139
|
1990
|
|
|
|
|
2254
|
my $graph = $elem->{graph}; |
2140
|
1990
|
|
|
|
|
2860
|
my $color = $self->colors2string($elem->{colors}); |
2141
|
1990
|
|
|
|
|
2920
|
my $message = $elem->{colors}{$color}; |
2142
|
1990
|
|
|
|
|
2474
|
$graph->{color} = $color; |
2143
|
1990
|
|
|
|
|
2552
|
$graph->{tooltip} = $message; |
2144
|
1990
|
100
|
|
|
|
3350
|
if ($self->{todo}{warning}) { |
2145
|
1478
|
100
|
|
|
|
2080
|
if ($graph->{label}) { |
2146
|
707
|
|
|
|
|
1051
|
$graph->{label} .= '\n'; |
2147
|
|
|
|
|
|
|
} else { |
2148
|
771
|
|
|
|
|
1230
|
$graph->{label} = ""; |
2149
|
|
|
|
|
|
|
} |
2150
|
1478
|
50
|
|
|
|
2148
|
if ($self->{todo}{warning}{all}) { |
2151
|
0
|
|
|
|
|
0
|
$graph->{label} .= join('\n', values %{$elem->{colors}}); |
|
0
|
|
|
|
|
0
|
|
2152
|
|
|
|
|
|
|
} else { |
2153
|
1478
|
|
|
|
|
2620
|
$graph->{label} .= $message; |
2154
|
|
|
|
|
|
|
} |
2155
|
|
|
|
|
|
|
} |
2156
|
|
|
|
|
|
|
} |
2157
|
2565
|
50
|
|
|
|
3549
|
return map { $_->{graph} || () } @elements; |
|
1990
|
|
|
|
|
4543
|
|
2158
|
|
|
|
|
|
|
} |
2159
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
# take list of edges ( { S => srcNode , D => dstNode, label => ... }, ... ) |
2161
|
|
|
|
|
|
|
# return edges of dot graph |
2162
|
|
|
|
|
|
|
sub graph_edges { |
2163
|
189
|
|
|
189
|
0
|
235
|
my $class = shift; |
2164
|
189
|
|
|
|
|
324
|
my @edges = @_; |
2165
|
189
|
|
|
|
|
232
|
my $dot = ""; |
2166
|
189
|
|
|
|
|
283
|
foreach (@edges) { |
2167
|
1234
|
|
|
|
|
1972
|
$dot .= "\t$_->{S} -> $_->{D} [\n"; |
2168
|
1234
|
|
|
|
|
3841
|
foreach my $k (sort keys %$_) { |
2169
|
8539
|
100
|
100
|
|
|
17091
|
next if $k eq 'S' || $k eq 'D'; |
2170
|
6071
|
|
|
|
|
7064
|
my $v = $_->{$k}; |
2171
|
6071
|
|
|
|
|
9022
|
$dot .= "\t\t$k=\"$v\"\n"; |
2172
|
|
|
|
|
|
|
} |
2173
|
1234
|
|
|
|
|
1833
|
$dot .= "\t];\n"; |
2174
|
|
|
|
|
|
|
} |
2175
|
189
|
|
|
|
|
1623
|
return $dot; |
2176
|
|
|
|
|
|
|
} |
2177
|
|
|
|
|
|
|
|
2178
|
|
|
|
|
|
|
# take lsdb structure, router id, todo hash |
2179
|
|
|
|
|
|
|
# return dot graph |
2180
|
|
|
|
|
|
|
sub graph_database { |
2181
|
183
|
|
|
183
|
0
|
352
|
my OSPF::LSDB::View $self = shift; |
2182
|
183
|
|
|
|
|
277
|
my $todo = $self->{todo}; |
2183
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
# convert ospf structure into separate hashes and create cluster hashes |
2185
|
183
|
|
|
|
|
217
|
my $netindex = 0; |
2186
|
183
|
|
|
|
|
504
|
$self->create_network(\$netindex); |
2187
|
183
|
100
|
|
|
|
387
|
if ($todo->{intra}) { |
2188
|
4
|
50
|
|
|
|
9
|
$self->create_intranetworks() if $self->ipv6; |
2189
|
|
|
|
|
|
|
} |
2190
|
|
|
|
|
|
|
# add missing network may add graphs to nethash |
2191
|
|
|
|
|
|
|
# must be called before add_transit_value in create_router |
2192
|
183
|
|
|
|
|
509
|
$self->add_missing_network(\$netindex); |
2193
|
183
|
|
|
|
|
223
|
my $routeindex = 0; |
2194
|
183
|
|
|
|
|
432
|
$self->create_router(\$routeindex); |
2195
|
183
|
100
|
|
|
|
394
|
if ($todo->{link}) { |
2196
|
2
|
50
|
|
|
|
4
|
$self->create_link() if $self->ipv6; |
2197
|
|
|
|
|
|
|
} |
2198
|
183
|
100
|
|
|
|
307
|
if ($todo->{intra}) { |
2199
|
4
|
50
|
|
|
|
8
|
$self->create_intrarouters() if $self->ipv6; |
2200
|
|
|
|
|
|
|
} |
2201
|
183
|
100
|
|
|
|
570
|
$self->create_summary() if $todo->{summary}; |
2202
|
183
|
100
|
|
|
|
501
|
$self->create_boundary() if $todo->{boundary}; |
2203
|
183
|
100
|
|
|
|
504
|
$self->create_external() if $todo->{external}; |
2204
|
|
|
|
|
|
|
|
2205
|
|
|
|
|
|
|
# add missing router may add graphs to routehash |
2206
|
|
|
|
|
|
|
# must be called before check_router |
2207
|
183
|
|
|
|
|
412
|
$self->add_missing_router(\$routeindex); |
2208
|
|
|
|
|
|
|
|
2209
|
183
|
|
|
|
|
300
|
my %netcluster; |
2210
|
|
|
|
|
|
|
my %transitcluster; |
2211
|
183
|
|
|
|
|
490
|
$self->check_network(\%netcluster); |
2212
|
183
|
|
|
|
|
432
|
$self->check_router(); |
2213
|
183
|
|
|
|
|
471
|
$self->check_transit(\%transitcluster); |
2214
|
183
|
100
|
|
|
|
446
|
$self->check_stub(\%netcluster) unless $self->ipv6; |
2215
|
183
|
100
|
|
|
|
396
|
if ($todo->{link}) { |
2216
|
2
|
50
|
|
|
|
5
|
$self->check_link() if $self->ipv6; |
2217
|
|
|
|
|
|
|
} |
2218
|
183
|
100
|
|
|
|
322
|
if ($todo->{intra}) { |
2219
|
4
|
50
|
|
|
|
10
|
$self->check_intrarouter() if $self->ipv6; |
2220
|
4
|
50
|
|
|
|
9
|
$self->check_intranetwork() if $self->ipv6; |
2221
|
|
|
|
|
|
|
} |
2222
|
183
|
100
|
|
|
|
526
|
$self->check_summary(\%netcluster) if $todo->{summary}; |
2223
|
183
|
100
|
|
|
|
598
|
$self->check_boundary() if $todo->{boundary}; |
2224
|
183
|
100
|
|
|
|
501
|
$self->check_external(\%netcluster) if $todo->{external}; |
2225
|
183
|
|
|
|
|
308
|
$self->{netcluster} = \%netcluster; |
2226
|
183
|
|
|
|
|
284
|
$self->{transitcluster} = \%transitcluster; |
2227
|
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
|
# remove duplicate router may delete graphs from boundhash |
2229
|
|
|
|
|
|
|
# must be called after check_boundary |
2230
|
183
|
|
|
|
|
389
|
$self->remove_duplicate_router(); |
2231
|
|
|
|
|
|
|
|
2232
|
|
|
|
|
|
|
# insert cluster with more than one entry into graphs |
2233
|
183
|
100
|
|
|
|
309
|
if ($todo->{cluster}) { |
2234
|
12
|
|
|
|
|
39
|
$self->set_cluster("net"); |
2235
|
12
|
|
|
|
|
20
|
$self->set_cluster("transit"); |
2236
|
|
|
|
|
|
|
} |
2237
|
|
|
|
|
|
|
|
2238
|
|
|
|
|
|
|
# graphs within clusters are not aggregated |
2239
|
|
|
|
|
|
|
$self->create_sumaggr() |
2240
|
183
|
100
|
100
|
|
|
662
|
if $todo->{summary} && $todo->{summary}{aggregate}; |
2241
|
|
|
|
|
|
|
$self->create_boundaggr() |
2242
|
183
|
100
|
100
|
|
|
588
|
if $todo->{boundary} && $todo->{boundary}{aggregate}; |
2243
|
|
|
|
|
|
|
$self->create_externaggr() |
2244
|
183
|
100
|
100
|
|
|
568
|
if $todo->{external} && $todo->{external}{aggregate}; |
2245
|
|
|
|
|
|
|
|
2246
|
183
|
|
|
|
|
212
|
my @nodes; |
2247
|
183
|
|
|
|
|
319
|
push @nodes, $self->router2nodes(); |
2248
|
183
|
|
|
|
|
472
|
push @nodes, $self->transit2nodes(); |
2249
|
183
|
100
|
|
|
|
408
|
push @nodes, $self->stub2nodes() unless $self->ipv6; |
2250
|
183
|
|
|
|
|
391
|
push @nodes, $self->network2nodes(); |
2251
|
183
|
100
|
|
|
|
347
|
if ($todo->{link}) { |
2252
|
2
|
50
|
|
|
|
3
|
push @nodes, $self->link2nodes() if $self->ipv6; |
2253
|
|
|
|
|
|
|
} |
2254
|
183
|
100
|
|
|
|
301
|
if ($todo->{intra}) { |
2255
|
4
|
50
|
|
|
|
10
|
push @nodes, $self->intrarouter2nodes() if $self->ipv6; |
2256
|
4
|
50
|
|
|
|
10
|
push @nodes, $self->intranetwork2nodes() if $self->ipv6; |
2257
|
|
|
|
|
|
|
} |
2258
|
183
|
100
|
|
|
|
375
|
if ($todo->{summary}) { |
2259
|
144
|
|
|
|
|
373
|
push @nodes, $self->summary2nodes(); |
2260
|
|
|
|
|
|
|
push @nodes, $self->sumaggr2nodes() |
2261
|
144
|
100
|
|
|
|
313
|
if $todo->{summary}{aggregate}; |
2262
|
|
|
|
|
|
|
} |
2263
|
183
|
100
|
|
|
|
353
|
if ($todo->{boundary}) { |
2264
|
151
|
|
|
|
|
285
|
push @nodes, $self->boundary2nodes(); |
2265
|
|
|
|
|
|
|
push @nodes, $self->boundaggr2nodes() |
2266
|
151
|
100
|
|
|
|
407
|
if $todo->{boundary}{aggregate}; |
2267
|
|
|
|
|
|
|
} |
2268
|
183
|
100
|
|
|
|
302
|
if ($todo->{external}) { |
2269
|
151
|
|
|
|
|
281
|
push @nodes, $self->external2nodes(); |
2270
|
|
|
|
|
|
|
push @nodes, $self->externaggr2nodes() |
2271
|
151
|
100
|
|
|
|
296
|
if $todo->{external}{aggregate}; |
2272
|
|
|
|
|
|
|
} |
2273
|
183
|
|
|
|
|
385
|
my $dot = $self->graph_nodes(@nodes); |
2274
|
|
|
|
|
|
|
|
2275
|
183
|
|
|
|
|
237
|
my @edges; |
2276
|
183
|
|
|
|
|
415
|
push @edges, $self->router2edges("pointtopoint"); |
2277
|
183
|
|
|
|
|
364
|
push @edges, $self->transit2edges(); |
2278
|
183
|
100
|
|
|
|
510
|
push @edges, $self->stub2edges() unless $self->ipv6; |
2279
|
183
|
|
|
|
|
364
|
push @edges, $self->router2edges("virtual"); |
2280
|
183
|
|
|
|
|
407
|
push @edges, $self->network2edges(); |
2281
|
183
|
100
|
|
|
|
371
|
if ($todo->{link}) { |
2282
|
2
|
50
|
|
|
|
4
|
push @edges, $self->link2edges() if $self->ipv6; |
2283
|
|
|
|
|
|
|
} |
2284
|
183
|
100
|
|
|
|
301
|
if ($todo->{intra}) { |
2285
|
4
|
50
|
|
|
|
9
|
push @edges, $self->intrarouter2edges() if $self->ipv6; |
2286
|
4
|
50
|
|
|
|
9
|
push @edges, $self->intranetwork2edges() if $self->ipv6; |
2287
|
|
|
|
|
|
|
} |
2288
|
183
|
100
|
|
|
|
313
|
if ($todo->{summary}) { |
2289
|
144
|
|
|
|
|
279
|
push @edges, $self->summary2edges(); |
2290
|
|
|
|
|
|
|
push @edges, $self->sumaggr2edges() |
2291
|
144
|
100
|
|
|
|
375
|
if $todo->{summary}{aggregate}; |
2292
|
|
|
|
|
|
|
} |
2293
|
183
|
100
|
|
|
|
316
|
if ($todo->{boundary}) { |
2294
|
151
|
|
|
|
|
295
|
push @edges, $self->boundary2edges(); |
2295
|
|
|
|
|
|
|
push @edges, $self->boundaggr2edges() |
2296
|
151
|
100
|
|
|
|
329
|
if $todo->{boundary}{aggregate}; |
2297
|
|
|
|
|
|
|
} |
2298
|
183
|
100
|
|
|
|
320
|
if ($todo->{external}) { |
2299
|
151
|
|
|
|
|
311
|
push @edges, $self->external2edges(); |
2300
|
|
|
|
|
|
|
push @edges, $self->externaggr2edges() |
2301
|
151
|
100
|
|
|
|
423
|
if $todo->{external}{aggregate}; |
2302
|
|
|
|
|
|
|
} |
2303
|
183
|
|
|
|
|
363
|
$dot .= $self->graph_edges(@edges); |
2304
|
|
|
|
|
|
|
|
2305
|
183
|
|
|
|
|
1533
|
return $dot; |
2306
|
|
|
|
|
|
|
} |
2307
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
# return dot default settings |
2309
|
|
|
|
|
|
|
sub graph_default { |
2310
|
185
|
|
|
185
|
0
|
239
|
my $class = shift; |
2311
|
185
|
|
|
|
|
305
|
my $dot = ""; |
2312
|
185
|
|
|
|
|
355
|
$dot .= "\tnode [ color=gray50 fontsize=14 ];\n"; |
2313
|
185
|
|
|
|
|
276
|
$dot .= "\tedge [ color=gray50 fontsize=8 ];\n"; |
2314
|
185
|
|
|
|
|
364
|
return $dot; |
2315
|
|
|
|
|
|
|
} |
2316
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
=pod |
2318
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
=over |
2320
|
|
|
|
|
|
|
|
2321
|
|
|
|
|
|
|
=item $self-Egraph(%todo) |
2322
|
|
|
|
|
|
|
|
2323
|
|
|
|
|
|
|
Convert the internal database into graphviz dot format. |
2324
|
|
|
|
|
|
|
The output for the dot program is returned as string. |
2325
|
|
|
|
|
|
|
|
2326
|
|
|
|
|
|
|
The B<%todo> parameter allows to tune the displayed details. |
2327
|
|
|
|
|
|
|
It consists of the subkeys: |
2328
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
=over 8 |
2330
|
|
|
|
|
|
|
|
2331
|
|
|
|
|
|
|
=item B |
2332
|
|
|
|
|
|
|
|
2333
|
|
|
|
|
|
|
Display the summary AS boundary routers. |
2334
|
|
|
|
|
|
|
If the additional subkey B is given, multiple AS boundary |
2335
|
|
|
|
|
|
|
routers are aggregated in one node. |
2336
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
=item B |
2338
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
Display the AS external networks. |
2340
|
|
|
|
|
|
|
If the additional subkey B is given, multiple AS external |
2341
|
|
|
|
|
|
|
networks are aggregated in one node. |
2342
|
|
|
|
|
|
|
|
2343
|
|
|
|
|
|
|
=item B |
2344
|
|
|
|
|
|
|
|
2345
|
|
|
|
|
|
|
The same network is always displayed in the same rectangular cluster, |
2346
|
|
|
|
|
|
|
even if is belongs to different LSA types. |
2347
|
|
|
|
|
|
|
|
2348
|
|
|
|
|
|
|
=item B |
2349
|
|
|
|
|
|
|
|
2350
|
|
|
|
|
|
|
Display the summary networks. |
2351
|
|
|
|
|
|
|
If the additional subkey B is given, multiple networks |
2352
|
|
|
|
|
|
|
are aggregated in one node. |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
=item B |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
Write the most severe warning about OSPF inconsistencies into the |
2357
|
|
|
|
|
|
|
label of the dot graph. |
2358
|
|
|
|
|
|
|
This warning determines also the color of the node or edge. |
2359
|
|
|
|
|
|
|
If the additional subkey B is given, all warnings are added. |
2360
|
|
|
|
|
|
|
|
2361
|
|
|
|
|
|
|
=back |
2362
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
=cut |
2364
|
|
|
|
|
|
|
|
2365
|
|
|
|
|
|
|
# take ospf structure, todo hash |
2366
|
|
|
|
|
|
|
# return the complete dot graph |
2367
|
|
|
|
|
|
|
sub graph { |
2368
|
183
|
|
|
183
|
1
|
924
|
my OSPF::LSDB::View $self = shift; |
2369
|
183
|
|
|
|
|
277
|
%{$self->{todo}} = @_; |
|
183
|
|
|
|
|
532
|
|
2370
|
183
|
|
|
|
|
497
|
$self->create_area_grays(); |
2371
|
183
|
|
|
|
|
274
|
my $dot = "digraph \"ospf lsdb\" {\n"; |
2372
|
183
|
|
|
|
|
320
|
$dot .= $self->graph_default(); |
2373
|
183
|
|
|
|
|
357
|
$dot .= $self->graph_database(); |
2374
|
183
|
|
|
|
|
353
|
$dot .= "}\n"; |
2375
|
183
|
|
|
|
|
487
|
return $dot; |
2376
|
|
|
|
|
|
|
} |
2377
|
|
|
|
|
|
|
|
2378
|
|
|
|
|
|
|
# return legend routers as dot graph |
2379
|
|
|
|
|
|
|
sub legend_router { |
2380
|
1
|
|
|
1
|
0
|
2
|
my $class = shift; |
2381
|
1
|
|
|
|
|
2
|
my $index = 0; |
2382
|
1
|
|
|
|
|
8
|
my @nodes = ( |
2383
|
|
|
|
|
|
|
{ |
2384
|
|
|
|
|
|
|
label => 'ospf\nrouter', |
2385
|
|
|
|
|
|
|
}, { |
2386
|
|
|
|
|
|
|
label => 'current\nlocation', |
2387
|
|
|
|
|
|
|
peripheries => 2, |
2388
|
|
|
|
|
|
|
}, { |
2389
|
|
|
|
|
|
|
label => 'area border\nrouter', |
2390
|
|
|
|
|
|
|
style => 'bold', |
2391
|
|
|
|
|
|
|
}, { |
2392
|
|
|
|
|
|
|
label => 'summary AS\nboundary router', |
2393
|
|
|
|
|
|
|
style => 'dashed', |
2394
|
|
|
|
|
|
|
}, |
2395
|
|
|
|
|
|
|
); |
2396
|
1
|
|
|
|
|
3
|
foreach (@nodes) { |
2397
|
4
|
|
|
|
|
8
|
$_->{N} = 'router'. $index++; |
2398
|
4
|
|
50
|
|
|
15
|
$_->{shape} ||= 'box'; |
2399
|
4
|
|
100
|
|
|
11
|
$_->{style} ||= 'solid'; |
2400
|
|
|
|
|
|
|
} |
2401
|
|
|
|
|
|
|
|
2402
|
1
|
|
|
|
|
2
|
my $dot = ""; |
2403
|
1
|
|
|
|
|
3
|
$dot .= $class->graph_nodes(@nodes); |
2404
|
1
|
|
|
|
|
3
|
$dot .= "\t{ rank=same;"; |
2405
|
1
|
|
|
|
|
3
|
$dot .= join("", map { " $_->{N};" } @nodes); |
|
4
|
|
|
|
|
9
|
|
2406
|
1
|
|
|
|
|
3
|
$dot .= " }\n"; |
2407
|
1
|
|
|
|
|
6
|
return $dot; |
2408
|
|
|
|
|
|
|
} |
2409
|
|
|
|
|
|
|
|
2410
|
|
|
|
|
|
|
# return legend networks as dot graph |
2411
|
|
|
|
|
|
|
sub legend_network { |
2412
|
1
|
|
|
1
|
0
|
3
|
my $class = shift; |
2413
|
1
|
|
|
|
|
2
|
my $index = 0; |
2414
|
1
|
|
|
|
|
9
|
my @nodes = ( |
2415
|
|
|
|
|
|
|
{ |
2416
|
|
|
|
|
|
|
label => 'transit\nnetwork', |
2417
|
|
|
|
|
|
|
style => 'bold', |
2418
|
|
|
|
|
|
|
}, { |
2419
|
|
|
|
|
|
|
label => 'stub\nnetwork', |
2420
|
|
|
|
|
|
|
}, { |
2421
|
|
|
|
|
|
|
label => 'summary\nnetwork', |
2422
|
|
|
|
|
|
|
style => 'dashed', |
2423
|
|
|
|
|
|
|
}, { |
2424
|
|
|
|
|
|
|
color => 'gray35', |
2425
|
|
|
|
|
|
|
label => 'AS external\nnetwork', |
2426
|
|
|
|
|
|
|
shape => 'egg', |
2427
|
|
|
|
|
|
|
}, |
2428
|
|
|
|
|
|
|
); |
2429
|
1
|
|
|
|
|
2
|
foreach (@nodes) { |
2430
|
4
|
|
|
|
|
9
|
$_->{N} = 'network'. $index++; |
2431
|
4
|
|
100
|
|
|
166
|
$_->{shape} ||= 'ellipse'; |
2432
|
4
|
|
100
|
|
|
11
|
$_->{style} ||= 'solid'; |
2433
|
|
|
|
|
|
|
} |
2434
|
|
|
|
|
|
|
|
2435
|
1
|
|
|
|
|
3
|
my $dot = ""; |
2436
|
1
|
|
|
|
|
4
|
$dot .= $class->graph_nodes(@nodes); |
2437
|
1
|
|
|
|
|
3
|
$dot .= "\t{ rank=same;"; |
2438
|
1
|
|
|
|
|
4
|
$dot .= join("", map { " $_->{N};" } @nodes); |
|
4
|
|
|
|
|
10
|
|
2439
|
1
|
|
|
|
|
3
|
$dot .= " }\n"; |
2440
|
1
|
|
|
|
|
5
|
return $dot; |
2441
|
|
|
|
|
|
|
} |
2442
|
|
|
|
|
|
|
|
2443
|
|
|
|
|
|
|
# return legend router network edges as dot graph |
2444
|
|
|
|
|
|
|
sub legend_edge { |
2445
|
1
|
|
|
1
|
0
|
2
|
my $class = shift; |
2446
|
1
|
|
|
|
|
9
|
my @networknodes = ( |
2447
|
|
|
|
|
|
|
{ |
2448
|
|
|
|
|
|
|
label => 'network', |
2449
|
|
|
|
|
|
|
}, { |
2450
|
|
|
|
|
|
|
label => 'transit\nnetwork', |
2451
|
|
|
|
|
|
|
style => 'bold', |
2452
|
|
|
|
|
|
|
}, { |
2453
|
|
|
|
|
|
|
color => 'gray35', |
2454
|
|
|
|
|
|
|
label => 'ASE type 1\nnetwork', |
2455
|
|
|
|
|
|
|
shape => 'egg', |
2456
|
|
|
|
|
|
|
}, { |
2457
|
|
|
|
|
|
|
color => 'gray35', |
2458
|
|
|
|
|
|
|
label => 'ASE type 2\nnetwork', |
2459
|
|
|
|
|
|
|
shape => 'egg', |
2460
|
|
|
|
|
|
|
}, |
2461
|
|
|
|
|
|
|
); |
2462
|
1
|
|
|
|
|
3
|
foreach (@networknodes) { |
2463
|
4
|
|
100
|
|
|
10
|
$_->{shape} ||= 'ellipse'; |
2464
|
4
|
|
100
|
|
|
12
|
$_->{style} ||= 'solid'; |
2465
|
|
|
|
|
|
|
} |
2466
|
|
|
|
|
|
|
|
2467
|
1
|
|
|
|
|
6
|
my @routernodes = ( |
2468
|
|
|
|
|
|
|
{ |
2469
|
|
|
|
|
|
|
label => 'router', |
2470
|
|
|
|
|
|
|
}, { |
2471
|
|
|
|
|
|
|
label => 'designated\nrouter', |
2472
|
|
|
|
|
|
|
}, { |
2473
|
|
|
|
|
|
|
label => 'AS boundary\nrouter', |
2474
|
|
|
|
|
|
|
}, { |
2475
|
|
|
|
|
|
|
label => 'AS boundary\nrouter', |
2476
|
|
|
|
|
|
|
}, |
2477
|
|
|
|
|
|
|
); |
2478
|
1
|
|
|
|
|
3
|
foreach (@routernodes) { |
2479
|
4
|
|
50
|
|
|
14
|
$_->{shape} ||= 'box'; |
2480
|
4
|
|
50
|
|
|
11
|
$_->{style} ||= 'solid'; |
2481
|
|
|
|
|
|
|
} |
2482
|
|
|
|
|
|
|
|
2483
|
1
|
|
|
|
|
2
|
my $index = 0; |
2484
|
1
|
|
|
|
|
10
|
my @edges = ( |
2485
|
|
|
|
|
|
|
{ |
2486
|
|
|
|
|
|
|
headlabel => '.IP', |
2487
|
|
|
|
|
|
|
style => 'solid', |
2488
|
|
|
|
|
|
|
taillabel => 'cost', |
2489
|
|
|
|
|
|
|
}, { |
2490
|
|
|
|
|
|
|
style => 'bold', |
2491
|
|
|
|
|
|
|
taillabel => '.IP', |
2492
|
|
|
|
|
|
|
}, { |
2493
|
|
|
|
|
|
|
color => 'gray35', |
2494
|
|
|
|
|
|
|
headlabel => 'cost', |
2495
|
|
|
|
|
|
|
style => 'solid', |
2496
|
|
|
|
|
|
|
taillabel => '.IP', |
2497
|
|
|
|
|
|
|
}, { |
2498
|
|
|
|
|
|
|
color => 'gray35', |
2499
|
|
|
|
|
|
|
headlabel => 'cost', |
2500
|
|
|
|
|
|
|
style => 'dashed', |
2501
|
|
|
|
|
|
|
taillabel => '.IP', |
2502
|
|
|
|
|
|
|
}, |
2503
|
|
|
|
|
|
|
); |
2504
|
1
|
|
|
|
|
4
|
for(my $i=0; $i<@edges; $i++) { |
2505
|
4
|
|
|
|
|
8
|
$networknodes[$i]{N} = 'edgenetwork'. $index; |
2506
|
4
|
|
|
|
|
8
|
$routernodes [$i]{N} = 'edgerouter'. $index; |
2507
|
4
|
|
|
|
|
6
|
$edges [$i]{S} = 'edgenetwork'. $index; |
2508
|
4
|
|
|
|
|
9
|
$edges [$i]{D} = 'edgerouter'. $index; |
2509
|
4
|
|
|
|
|
7
|
$index++; |
2510
|
|
|
|
|
|
|
} |
2511
|
|
|
|
|
|
|
# swap arrow for cost .IP explanation |
2512
|
1
|
|
|
|
|
4
|
($edges[0]{D}, $edges[0]{S}) = ($edges[0]{S}, $edges[0]{D}); |
2513
|
|
|
|
|
|
|
|
2514
|
1
|
|
|
|
|
2
|
my $dot = ""; |
2515
|
1
|
|
|
|
|
3
|
$dot .= $class->graph_nodes(@networknodes); |
2516
|
1
|
|
|
|
|
4
|
$dot .= $class->graph_nodes(@routernodes); |
2517
|
1
|
|
|
|
|
3
|
$dot .= $class->graph_edges(@edges); |
2518
|
1
|
|
|
|
|
3
|
$dot .= "\t{ rank=same;"; |
2519
|
1
|
|
|
|
|
4
|
$dot .= join("", map { " $_->{S};" } @edges); |
|
4
|
|
|
|
|
10
|
|
2520
|
1
|
|
|
|
|
3
|
$dot .= " }\n"; |
2521
|
1
|
|
|
|
|
10
|
return $dot; |
2522
|
|
|
|
|
|
|
} |
2523
|
|
|
|
|
|
|
|
2524
|
|
|
|
|
|
|
# return legend router link to router or network as dot graph |
2525
|
|
|
|
|
|
|
sub legend_link { |
2526
|
1
|
|
|
1
|
0
|
3
|
my $class = shift; |
2527
|
1
|
|
|
|
|
5
|
my @routernodes = ( |
2528
|
|
|
|
|
|
|
{}, {}, { |
2529
|
|
|
|
|
|
|
label => 'designated\nrouter', |
2530
|
|
|
|
|
|
|
}, {}, {}, |
2531
|
|
|
|
|
|
|
); |
2532
|
1
|
|
|
|
|
3
|
foreach (@routernodes) { |
2533
|
5
|
|
100
|
|
|
17
|
$_->{label} ||= 'router'; |
2534
|
5
|
|
50
|
|
|
14
|
$_->{shape} ||= 'box'; |
2535
|
5
|
|
50
|
|
|
12
|
$_->{style} ||= 'solid'; |
2536
|
|
|
|
|
|
|
} |
2537
|
|
|
|
|
|
|
|
2538
|
1
|
|
|
|
|
9
|
my @dstnodes = ( |
2539
|
|
|
|
|
|
|
{}, { |
2540
|
|
|
|
|
|
|
label => 'transit\nnetwork', |
2541
|
|
|
|
|
|
|
style => 'bold', |
2542
|
|
|
|
|
|
|
shape => 'ellipse', |
2543
|
|
|
|
|
|
|
}, { |
2544
|
|
|
|
|
|
|
label => 'transit\nnetwork', |
2545
|
|
|
|
|
|
|
style => 'bold', |
2546
|
|
|
|
|
|
|
shape => 'ellipse', |
2547
|
|
|
|
|
|
|
}, { |
2548
|
|
|
|
|
|
|
label => 'stub\nnetwork', |
2549
|
|
|
|
|
|
|
style => 'solid', |
2550
|
|
|
|
|
|
|
shape => 'ellipse', |
2551
|
|
|
|
|
|
|
}, {}, |
2552
|
|
|
|
|
|
|
); |
2553
|
1
|
|
|
|
|
3
|
foreach (@dstnodes) { |
2554
|
|
|
|
|
|
|
$_->{label} ||= 'router', |
2555
|
5
|
|
100
|
|
|
17
|
$_->{shape} ||= 'box'; |
|
|
|
100
|
|
|
|
|
2556
|
5
|
|
100
|
|
|
11
|
$_->{style} ||= 'solid'; |
2557
|
|
|
|
|
|
|
} |
2558
|
|
|
|
|
|
|
|
2559
|
1
|
|
|
|
|
3
|
my $index = 0; |
2560
|
1
|
|
|
|
|
6
|
my @edges = ( |
2561
|
|
|
|
|
|
|
{ |
2562
|
|
|
|
|
|
|
label => 'point-to-point\nlink', |
2563
|
|
|
|
|
|
|
}, { |
2564
|
|
|
|
|
|
|
label => 'link to\ntransit network', |
2565
|
|
|
|
|
|
|
}, { |
2566
|
|
|
|
|
|
|
label => 'link to\ntransit network', |
2567
|
|
|
|
|
|
|
style => 'bold', |
2568
|
|
|
|
|
|
|
}, { |
2569
|
|
|
|
|
|
|
label => 'link to\nstub network', |
2570
|
|
|
|
|
|
|
}, { |
2571
|
|
|
|
|
|
|
label => 'virtual\nlink', |
2572
|
|
|
|
|
|
|
style => 'dotted', |
2573
|
|
|
|
|
|
|
}, |
2574
|
|
|
|
|
|
|
); |
2575
|
1
|
|
|
|
|
2
|
foreach (@edges) { |
2576
|
5
|
|
100
|
|
|
13
|
$_->{style} ||= 'solid'; |
2577
|
|
|
|
|
|
|
} |
2578
|
1
|
|
|
|
|
5
|
for(my $i=0; $i<@edges; $i++) { |
2579
|
5
|
|
|
|
|
8
|
$routernodes[$i]{N} = 'linkrouter'. $index; |
2580
|
5
|
|
|
|
|
12
|
$dstnodes [$i]{N} = 'linkdst'. $index; |
2581
|
5
|
|
|
|
|
6
|
$edges [$i]{S} = 'linkrouter'. $index; |
2582
|
5
|
|
|
|
|
7
|
$edges [$i]{D} = 'linkdst'. $index; |
2583
|
5
|
|
|
|
|
12
|
$index++; |
2584
|
|
|
|
|
|
|
} |
2585
|
|
|
|
|
|
|
|
2586
|
1
|
|
|
|
|
3
|
my $dot = ""; |
2587
|
1
|
|
|
|
|
4
|
$dot .= $class->graph_nodes(@routernodes); |
2588
|
1
|
|
|
|
|
4
|
$dot .= $class->graph_nodes(@dstnodes); |
2589
|
1
|
|
|
|
|
3
|
$dot .= $class->graph_edges(@edges); |
2590
|
1
|
|
|
|
|
3
|
$dot .= "\t{ rank=same;"; |
2591
|
1
|
|
|
|
|
3
|
$dot .= join("", map { " $_->{S};" } @edges); |
|
5
|
|
|
|
|
11
|
|
2592
|
1
|
|
|
|
|
3
|
$dot .= " }\n"; |
2593
|
1
|
|
|
|
|
11
|
return $dot; |
2594
|
|
|
|
|
|
|
} |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
# return legend summary network and router edges as dot graph |
2597
|
|
|
|
|
|
|
sub legend_summary { |
2598
|
1
|
|
|
1
|
0
|
3
|
my $class = shift; |
2599
|
1
|
|
|
|
|
10
|
my @networknodes = ( |
2600
|
|
|
|
|
|
|
{ |
2601
|
|
|
|
|
|
|
label => 'summary\nnetwork', |
2602
|
|
|
|
|
|
|
style => 'dashed', |
2603
|
|
|
|
|
|
|
}, { |
2604
|
|
|
|
|
|
|
label => 'summary AS\nboundary router', |
2605
|
|
|
|
|
|
|
shape => 'box', |
2606
|
|
|
|
|
|
|
style => 'dashed', |
2607
|
|
|
|
|
|
|
}, { |
2608
|
|
|
|
|
|
|
label => 'router and summary \nAS boundary router', |
2609
|
|
|
|
|
|
|
shape => 'box', |
2610
|
|
|
|
|
|
|
}, { |
2611
|
|
|
|
|
|
|
color => 'gray35', |
2612
|
|
|
|
|
|
|
label => 'ASE\nnetwork', |
2613
|
|
|
|
|
|
|
shape => 'egg', |
2614
|
|
|
|
|
|
|
}, |
2615
|
|
|
|
|
|
|
); |
2616
|
1
|
|
|
|
|
3
|
foreach (@networknodes) { |
2617
|
4
|
|
100
|
|
|
9
|
$_->{shape} ||= 'ellipse'; |
2618
|
4
|
|
100
|
|
|
10
|
$_->{style} ||= 'solid'; |
2619
|
|
|
|
|
|
|
} |
2620
|
|
|
|
|
|
|
|
2621
|
1
|
|
|
|
|
5
|
my @routernodes = ( |
2622
|
|
|
|
|
|
|
{}, {}, { |
2623
|
|
|
|
|
|
|
color => 'black', |
2624
|
|
|
|
|
|
|
}, { |
2625
|
|
|
|
|
|
|
color => 'gray35', |
2626
|
|
|
|
|
|
|
label => 'summary AS\nboundary router', |
2627
|
|
|
|
|
|
|
style => 'dashed', |
2628
|
|
|
|
|
|
|
}, |
2629
|
|
|
|
|
|
|
); |
2630
|
1
|
|
|
|
|
3
|
foreach (@routernodes) { |
2631
|
4
|
|
100
|
|
|
11
|
$_->{label} ||= 'area border\nrouter'; |
2632
|
4
|
|
50
|
|
|
12
|
$_->{shape} ||= 'box'; |
2633
|
4
|
|
100
|
|
|
10
|
$_->{style} ||= 'bold'; |
2634
|
|
|
|
|
|
|
} |
2635
|
|
|
|
|
|
|
|
2636
|
1
|
|
|
|
|
3
|
my $index = 0; |
2637
|
1
|
|
|
|
|
8
|
my @edges = ( |
2638
|
|
|
|
|
|
|
{ |
2639
|
|
|
|
|
|
|
headlabel => 'cost', |
2640
|
|
|
|
|
|
|
style => 'dashed', |
2641
|
|
|
|
|
|
|
taillabel => '.IP', |
2642
|
|
|
|
|
|
|
}, { |
2643
|
|
|
|
|
|
|
headlabel => 'cost', |
2644
|
|
|
|
|
|
|
style => 'dashed', |
2645
|
|
|
|
|
|
|
}, { |
2646
|
|
|
|
|
|
|
color => 'gray75', |
2647
|
|
|
|
|
|
|
headlabel => 'cost', |
2648
|
|
|
|
|
|
|
style => 'dashed', |
2649
|
|
|
|
|
|
|
}, { |
2650
|
|
|
|
|
|
|
color => 'gray35', |
2651
|
|
|
|
|
|
|
headlabel => 'cost', |
2652
|
|
|
|
|
|
|
style => 'solid', |
2653
|
|
|
|
|
|
|
taillabel => '.IP', |
2654
|
|
|
|
|
|
|
}, |
2655
|
|
|
|
|
|
|
); |
2656
|
1
|
|
|
|
|
4
|
for(my $i=0; $i<@edges; $i++) { |
2657
|
4
|
|
|
|
|
8
|
$networknodes[$i]{N} = 'summarynetwork'. $index; |
2658
|
4
|
|
|
|
|
6
|
$routernodes [$i]{N} = 'summaryrouter'. $index; |
2659
|
4
|
|
|
|
|
8
|
$edges [$i]{S} = 'summarynetwork'. $index; |
2660
|
4
|
|
|
|
|
6
|
$edges [$i]{D} = 'summaryrouter'. $index; |
2661
|
4
|
|
|
|
|
9
|
$index++; |
2662
|
|
|
|
|
|
|
} |
2663
|
|
|
|
|
|
|
|
2664
|
1
|
|
|
|
|
3
|
my $dot = ""; |
2665
|
1
|
|
|
|
|
3
|
$dot .= $class->graph_nodes(@networknodes); |
2666
|
1
|
|
|
|
|
3
|
$dot .= $class->graph_nodes(@routernodes); |
2667
|
1
|
|
|
|
|
3
|
$dot .= $class->graph_edges(@edges); |
2668
|
1
|
|
|
|
|
3
|
$dot .= "\t{ rank=same;"; |
2669
|
1
|
|
|
|
|
3
|
$dot .= join("", map { " $_->{S};" } @edges); |
|
4
|
|
|
|
|
9
|
|
2670
|
1
|
|
|
|
|
3
|
$dot .= " }\n"; |
2671
|
1
|
|
|
|
|
10
|
return $dot; |
2672
|
|
|
|
|
|
|
} |
2673
|
|
|
|
|
|
|
|
2674
|
|
|
|
|
|
|
# return additional invisible edges to get a better layout for the legend |
2675
|
|
|
|
|
|
|
sub legend_rank { |
2676
|
2
|
|
|
2
|
0
|
4
|
my $class = shift; |
2677
|
2
|
|
|
|
|
3
|
my $dot = ""; |
2678
|
2
|
|
|
|
|
4
|
$dot .= "\trouter0 -> network0 -> edgerouter0"; |
2679
|
2
|
|
|
|
|
3
|
$dot .= " [ style=invis ];\n"; |
2680
|
2
|
|
|
|
|
4
|
$dot .= "\tedgenetwork0 -> linkrouter0"; |
2681
|
2
|
|
|
|
|
3
|
$dot .= " [ style=invis ];\n"; |
2682
|
2
|
|
|
|
|
3
|
$dot .= "\tlinkdst0 -> summarynetwork0"; |
2683
|
2
|
|
|
|
|
10
|
$dot .= " [ style=invis ];\n"; |
2684
|
2
|
|
|
|
|
3
|
return $dot; |
2685
|
|
|
|
|
|
|
} |
2686
|
|
|
|
|
|
|
|
2687
|
|
|
|
|
|
|
# return legend default settings |
2688
|
|
|
|
|
|
|
sub legend_default { |
2689
|
2
|
|
|
2
|
0
|
4
|
my $class = shift; |
2690
|
2
|
|
|
|
|
3
|
my $dot = ""; |
2691
|
2
|
|
|
|
|
7
|
$dot .= $class->graph_default(); |
2692
|
2
|
|
|
|
|
4
|
return $dot; |
2693
|
|
|
|
|
|
|
} |
2694
|
|
|
|
|
|
|
|
2695
|
|
|
|
|
|
|
=pod |
2696
|
|
|
|
|
|
|
|
2697
|
|
|
|
|
|
|
=item OSPF::LSDB::View-Elegend() |
2698
|
|
|
|
|
|
|
|
2699
|
|
|
|
|
|
|
Return a string of a dot graphic containing drawing and description |
2700
|
|
|
|
|
|
|
of possible nodes and edges. |
2701
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
=back |
2703
|
|
|
|
|
|
|
|
2704
|
|
|
|
|
|
|
=cut |
2705
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
# return legend as dot graph |
2707
|
|
|
|
|
|
|
sub legend { |
2708
|
2
|
|
|
2
|
1
|
2678
|
my $class = shift; |
2709
|
2
|
|
|
|
|
3
|
my $dot = "digraph \"ospf legend\" {\n"; |
2710
|
2
|
|
|
|
|
10
|
$dot .= $class->legend_default(); |
2711
|
2
|
|
|
|
|
8
|
$dot .= $class->legend_rank(); |
2712
|
2
|
|
|
|
|
12
|
$dot .= $class->legend_router(); |
2713
|
2
|
|
|
|
|
8
|
$dot .= $class->legend_network(); |
2714
|
2
|
|
|
|
|
9
|
$dot .= $class->legend_edge(); |
2715
|
2
|
|
|
|
|
11
|
$dot .= $class->legend_link(); |
2716
|
2
|
|
|
|
|
7
|
$dot .= $class->legend_summary(); |
2717
|
2
|
|
|
|
|
4
|
$dot .= "}\n"; |
2718
|
2
|
|
|
|
|
6
|
return $dot; |
2719
|
|
|
|
|
|
|
} |
2720
|
|
|
|
|
|
|
|
2721
|
|
|
|
|
|
|
=pod |
2722
|
|
|
|
|
|
|
|
2723
|
|
|
|
|
|
|
=head1 ERRORS |
2724
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
The methods die if any error occures. |
2726
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
Inconsistencies within the OSPF link state database are visualized |
2728
|
|
|
|
|
|
|
with different colors. |
2729
|
|
|
|
|
|
|
The error message may be printed into the graph as warnings. |
2730
|
|
|
|
|
|
|
All warnings may be optained with the get_errors() method. |
2731
|
|
|
|
|
|
|
|
2732
|
|
|
|
|
|
|
=head1 SEE ALSO |
2733
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
L, |
2735
|
|
|
|
|
|
|
L |
2736
|
|
|
|
|
|
|
|
2737
|
|
|
|
|
|
|
L, |
2738
|
|
|
|
|
|
|
L |
2739
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
RFC 2328 - OSPF Version 2 - April 1998 |
2741
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
=head1 AUTHORS |
2743
|
|
|
|
|
|
|
|
2744
|
|
|
|
|
|
|
Alexander Bluhm |
2745
|
|
|
|
|
|
|
|
2746
|
|
|
|
|
|
|
=cut |
2747
|
|
|
|
|
|
|
|
2748
|
|
|
|
|
|
|
1; |