File Coverage

blib/lib/OSPF/LSDB/View.pm
Criterion Covered Total %
statement 1351 1363 99.1
branch 414 506 81.8
condition 132 193 68.3
subroutine 70 70 100.0
pod 3 60 5.0
total 1970 2192 89.8


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   3003 use strict;
  13         19  
  13         595  
18 13     13   94 use warnings;
  13         24  
  13         605  
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   62 use base 'OSPF::LSDB';
  13         23  
  13         4552  
111 13     13   5858 use List::MoreUtils qw(uniq);
  13         135913  
  13         80  
112 13         114 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   9685 );
  13         28  
124              
125             sub new {
126 113     113 1 84418 my OSPF::LSDB::View $self = OSPF::LSDB::new(@_);
127 113 100       520 die "$_[0] does not support IPv6" if $self->ipv6();
128 112         241 return $self;
129             }
130              
131             # convert decimal dotted IPv4 address to packed format
132 2584     2584   9392 sub _ip2pack($) { pack("CCCC", split(/\./, $_[0])) }
133              
134             # convert packed IPv4 address to decimal dotted format
135 966     966   3166 sub _pack2ip($) { join('.', unpack("CCCC", $_[0])) }
136              
137             # mask decimal dotted IPv4 network with decimal dotted IPv4 netmask
138 966     966   1329 sub _maskip($$) { _pack2ip(_ip2pack($_[0]) & _ip2pack($_[1])) }
139              
140             # compare function for sorting decimal dotted IPv4 address
141 141     141   402 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 185     185   310 my @a = split(/\//, $a);
146 185         238 my @b = split(/\//, $b);
147 185   33     218 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 284 my OSPF::LSDB::View $self = shift;
155 183 50       706 my $ospf = $self->{ospf} or die "Uninitialized member";
156 183         347 my @areas = sort _cmp_ip @{$ospf->{self}{areas}};
  183         1108  
157 183         791 my @colors = map { "gray". int(50 + ($_* 50 / @areas)) } (0..$#areas);
  283         1199  
158 183         518 my %areagrays;
159 183         616 @areagrays{@areas} = @colors;
160 183         398 $areagrays{ase} = "gray35";
161 183         530 $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 2091 my OSPF::LSDB::View $self = shift;
175 1990         2238 my($colors) = @_;
176 1990 100       3071 if (my $area = $colors->{gray}) {
177 1875 50       2938 my $areagrays = $self->{areagrays} or die "Uninitialized member";
178 1875         2007 my $gray = $areagrays->{$area};
179 1875         1732 delete $colors->{purple};
180 1875 50       2303 if (! $gray) {
181 0         0 $self->error($colors->{purple} = "Unexpected area $area.");
182             } else {
183 1875 100       3991 $colors->{$gray} = $area eq "ase" ? "AS external" : "Area: $area";
184 1875         2458 delete $colors->{gray};
185             }
186             }
187 1990 100       1921 if (my @areas = uniq @{$colors->{black} || []}) {
  1990 100       7508  
188 115         393 $colors->{black} = "Areas: @areas";
189             }
190 1990         5537 return (sort { $COLORWEIGHT{$a} <=> $COLORWEIGHT{$b} } keys %$colors)[-1];
  305         959  
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 221 my OSPF::LSDB::View $self = shift;
234 112 50       396 my $routehash = $self->{routehash} or die "Uninitialized member";
235 112         471 while (my($rid,$rv) = each %$routehash) {
236 252         298 my %colors;
237 252         312 my @areas = sort keys %{$rv->{areas}};
  252         665  
238 252 100       583 if (@areas > 1) {
239 49         146 $colors{black} = \@areas;
240 49 100       95 if (my @badareas = map { $_->{area} || () }
  4 100       27  
241 100         291 grep { ! $_->{bits}{B} } @{$rv->{hashes}}) {
  49         87  
242             $self->error($colors{orange} =
243 1         8 "Router $rid in multiple areas is not border router ".
244             "in areas @badareas.");
245             }
246             } else {
247 203         404 $colors{gray} = $areas[0];
248             }
249 252 100       397 if (my @badareas = grep { $rv->{areas}{$_} > 1 } @areas) {
  306         945  
250             $self->error($colors{yellow} =
251 1         11 "Router $rid has multiple entries in areas @badareas.");
252             }
253 252 100       538 if ($rv->{missing}) {
    100          
254 13         73 $self->error($colors{red} = "Router $rid missing.");
255 291         644 } elsif (my @badids = grep { $_ ne $rid } map { $_->{routerid} }
  291         540  
256 239         342 @{$rv->{hashes}}) {
257             $self->error($colors{magenta} =
258 1         9 "Router $rid advertized by @badids.");
259             }
260 252         840 $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 284 my OSPF::LSDB::View $self = shift;
270 183         342 my($index) = @_;
271 183         451 my $routerid = $self->{ospf}{self}{routerid};
272 183         1161 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         435 my($transitindex, $stubindex) = (0, 0);
281 183         282 foreach my $r (@{$self->{ospf}{database}{routers}}) {
  183         552  
282 453 100       868 my $rid = $self->ipv6 ? $r->{routerid} : $r->{router};
283 453         725 my $area = $r->{area};
284 453         586 my $bits = $r->{bits};
285 453         561 my $elem = $routehash{$rid};
286 453 100       810 if (! $elem) {
287 373         710 $routehash{$rid} = $elem = {};
288             $elem->{graph} = {
289             N => "router$$index",
290             label => $rid,
291             shape => "box",
292 373 100       2074 style => $bits->{B} ? "bold" : "solid",
293             };
294 373         751 $elem->{index} = $$index++;
295 373 100       907 if ($rid eq $routerid) {
296 172         411 $elem->{graph}{peripheries} = 2;
297             }
298             }
299 453         488 push @{$elem->{hashes}}, $r;
  453         873  
300 453 100       836 if ($self->ipv6) {
301 162         203 my $lsid = $r->{router};
302 162         433 $elem->{areas}{$area}{$lsid}++;
303             } else {
304 291         536 $elem->{areas}{$area}++;
305             }
306              
307 453         574 foreach my $l (@{$r->{pointtopoints}}) {
  453         853  
308 40         124 $self->add_router_value(\%pointtopointhash, $rid, $area, $l);
309 40         127 $self->{ifaddrs}{$l->{interface}}{$rid}++;
310             }
311 453         513 foreach my $l (@{$r->{transits}}) {
  453         751  
312 301         1016 $self->add_transit_value(\%transithash, \%transitnets,
313             \$transitindex, $rid, $area, $l);
314 301         808 $self->{ifaddrs}{$l->{interface}}{$rid}++;
315             }
316 453         593 foreach my $l (@{$r->{stubs}}) {
  453         850  
317 36         193 $self->add_stub_value(\%stubhash, \%stubs, \%stubareas,
318             \$stubindex, $rid, $area, $l);
319             }
320 453         525 foreach my $l (@{$r->{virtuals}}) {
  453         848  
321 40         101 $self->add_router_value(\%virtualhash, $rid, $area, $l);
322             }
323             }
324 183         359 $self->{routehash} = \%routehash;
325 183         375 $self->{pointtopointhash} = \%pointtopointhash;
326 183         360 $self->{transithash} = \%transithash;
327 183         368 $self->{transitnets} = \%transitnets;
328 183 100       669 $self->{stubhash} = \%stubhash unless $self->ipv6;
329 183 100       420 $self->{stubs} = \%stubs unless $self->ipv6;
330 183 100       423 $self->{stubareas} = \%stubareas unless $self->ipv6;
331 183         583 $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 209 my OSPF::LSDB::View $self = shift;
339 112         266 my($index) = @_;
340 112         128 my %rid2areas;
341 112 50       324 my $nethash = $self->{nethash} or die "Uninitialized member";
342 92         109 my @hashes = map { @{$_->{hashes}} } map { values %$_ }
  92         235  
  91         254  
343 112         355 map { values %$_ } map { values %$_ } values %$nethash;
  89         139  
  88         196  
344 112         261 foreach my $n (@hashes) {
345 94         177 my $area = $n->{area};
346 94         219 $rid2areas{$n->{routerid}}{$area} = 1;
347 94         124 foreach (@{$n->{attachments}}) {
  94         186  
348 196         381 $rid2areas{$_->{routerid}}{$area} = 1;
349             }
350             }
351 112         458 $self->add_missing_router_common($index, %rid2areas);
352             }
353              
354             sub add_missing_router_common {
355 183     183 0 266 my OSPF::LSDB::View $self = shift;
356 183         457 my($index, %rid2areas) = @_;
357 183         339 my $boundhash = $self->{boundhash};
358 183         344 my $externhash = $self->{externhash};
359 99         112 my @rids = map { keys %{$_->{routers}} }
  99         238  
360 183         532 map { values %$_ } values %$externhash;
  99         200  
361 183         405 foreach my $rid (@rids) {
362             # if ase is conneted to boundary router, router is not missing
363 153 100       243 next if $boundhash->{$rid};
364 43         83 $rid2areas{$rid}{ase} = 1;
365             }
366 183         292 my $sumhash = $self->{sumhash};
367 165         280 my @arearids = map { $_->{arearids} }
368 183         643 (values %$boundhash, map { values %$_ } values %$sumhash);
  64         197  
369 183         529 foreach my $ar (@arearids) {
370 165         503 while (my($area,$av) = each %$ar) {
371 226         529 while (my($rid,$num) = each %$av) {
372 376         902 $rid2areas{$rid}{$area} = 1;
373             }
374             }
375             }
376 183         348 foreach my $type (qw(pointtopoint virtual)) {
377 366 50       1013 my $linkhash = $self->{$type."hash"} or die "Uninitialized member";
378 366         1702 while (my($dstrid,$dv) = each %$linkhash) {
379 74         203 while (my($area,$av) = each %$dv) {
380 74         269 $rid2areas{$dstrid}{$area} = 1;
381             }
382             }
383             }
384 183         444 my $routerid = $self->{ospf}{self}{routerid};
385 183 50       467 my $routehash = $self->{routehash} or die "Uninitialized member";
386 183         679 foreach my $rid (sort keys %rid2areas) {
387 346         460 my $rv = $rid2areas{$rid};
388 346         454 my $elem = $routehash->{$rid};
389 346 100       1022 if (! $elem) {
390 25         49 $routehash->{$rid} = $elem = {};
391             $elem->{graph} = {
392 25         130 N => "router$$index",
393             label => $rid,
394             shape => "box",
395             style => "dotted",
396             };
397 25         71 $elem->{index} = $$index++;
398 25 100       67 if ($rid eq $routerid) {
399 11         26 $elem->{graph}{peripheries} = 2;
400             }
401 25         37 push @{$elem->{hashes}}, {};
  25         64  
402 25         46 $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 297 my OSPF::LSDB::View $self = shift;
412 183 50       492 my $routehash = $self->{routehash} or die "Uninitialized member";
413 183         297 my $boundhash = $self->{boundhash};
414             # if AS boundary router is also regular router, only use the regular
415 183         588 while (my($asbr,$bv) = each %$boundhash) {
416 101 100       297 if ($routehash->{$asbr}) {
417 34         108 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 238 my OSPF::LSDB::View $self = shift;
426 183 50       462 my $routehash = $self->{routehash} or die "Uninitialized member";
427 183         632 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 100 my OSPF::LSDB::View $self = shift;
472 80         139 my($linkhash, $rid, $area, $link) = @_;
473 80         122 my $dstrid = $link->{routerid};
474 80         165 my $elem = $linkhash->{$dstrid}{$area}{$rid};
475 80 100       152 if (! $elem) {
476 74         141 $linkhash->{$dstrid}{$area}{$rid} = $elem = {};
477             }
478 80         96 push @{$elem->{hashes}}, $link;
  80         208  
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 337 my OSPF::LSDB::View $self = shift;
485 224         380 my($type) = @_;
486 224 100       496 my $name = $type eq "pointtopoint" ? "Point-to-point" : "Virtual";
487 224 100       388 my $style = $type eq "pointtopoint" ? "solid" : "dotted";
488 224 50       429 my $routehash = $self->{routehash} or die "Uninitialized member";
489 224 50       549 my $linkhash = $self->{$type."hash"} or die "Uninitialized member";
490 224         295 my $ifaddrs = $self->{ifaddrs};
491 224         242 my @elements;
492 224         260 my $index = 0;
493 224         494 foreach my $dstrid (sort keys %$linkhash) {
494 52         107 my $dv = $linkhash->{$dstrid};
495 52         226 foreach my $area (sort keys %$dv) {
496 52         94 my $ev = $dv->{$area};
497 52         120 foreach my $rid (sort keys %$ev) {
498 52         68 my $rv = $ev->{$rid};
499 52         109 my %colors = (gray => $area);
500 52         219 my $src = $routehash->{$rid}{graph}{N};
501 52         101 my $dst = $routehash->{$dstrid}{graph}{N};
502 52         63 my @hashes = @{$rv->{hashes}};
  52         91  
503 52 100 100     221 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     339 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         81 foreach my $link (@hashes) {
520 55         101 my $intf = $link->{interface};
521 55         58 delete $colors{green};
522 55 100 66     196 if ($type eq "pointtopoint" and $ifaddrs->{$intf} &&
      100        
523             $ifaddrs->{$intf}{$rid} > 1) {
524             $self->error($colors{green} =
525 1         10 "$name link at router $rid to router $dstrid ".
526             "interface address $intf not unique.");
527             }
528 55         66 delete $colors{blue};
529 55 100 100     131 if ($type eq "pointtopoint" and my @badrids = sort
530 28         106 grep { $_ ne $rid } keys %{$ifaddrs->{$intf}}) {
  27         73  
531             $self->error($colors{blue} =
532 1         9 "$name link at router $rid to router $dstrid ".
533             "interface address $intf also at router @badrids.");
534             }
535 55         89 my $metric = $link->{metric};
536 55         452 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         412 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 221 my OSPF::LSDB::View $self = shift;
579 112         231 my($transitcluster) = @_;
580 112 50       308 my $nethash = $self->{nethash} or die "Uninitialized member";
581 112 50       347 my $transithash = $self->{transithash} or die "Uninitialized member";
582 112         367 foreach my $addr (sort keys %$transithash) {
583 95         138 my $av = $transithash->{$addr};
584 95         114 my %colors;
585 95 100 100     295 if (! $nethash->{$addr} && keys %$av > 1) {
586             $self->error($colors{orange} =
587 3         23 "Transit network $addr missing in multiple areas.");
588             }
589 95         289 foreach my $area (sort keys %$av) {
590 101         166 my $ev = $av->{$area};
591 101         166 $colors{gray} = $area;
592 101         117 delete $colors{blue};
593 101 100 100     267 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         285 foreach my $rid (sort keys %$ev) {
599 193         226 my $rv = $ev->{$rid};
600 193 100       437 next unless $rv->{graph};
601 15         24 delete @colors{qw(yellow red)};
602 15 100 100     62 if ($nethash->{$addr}) {
    100          
603             $self->error($colors{yellow} =
604 1         9 "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         20 "Transit network $addr network missing.");
609             }
610 15         24 %{$rv->{colors}} = %colors;
  15         36  
611 15         23 push @{$transitcluster->{$addr}}, $rv->{graph};
  15         42  
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 939 my OSPF::LSDB::View $self = shift;
621 195         325 my($transithash, $transitnets, $index, $rid, $area, $link) = @_;
622 195 50       473 my $nethash = $self->{nethash} or die "Uninitialized member";
623 195         275 my $addr = $link->{address};
624 195         444 my $intf = $link->{interface};
625 195         576 $transitnets->{$intf}{$rid}{$area}{$addr}++;
626 195         331 my $elem = $transithash->{$addr}{$area}{$rid};
627 195 100       357 if (! $elem) {
628 193         381 $transithash->{$addr}{$area}{$rid} = $elem = {};
629             # check if address is in nethash and in matching nethash area
630 193 100 100     442 if (! $nethash->{$addr} || ! map { $_->{$area} ? 1 : () }
  187 100       640  
631 181         378 map { values %$_ } values %{$nethash->{$addr}}) {
  179         411  
632             $elem->{graph} = {
633 15         66 N => "transitnet$$index",
634             label => $addr,
635             shape => "ellipse",
636             style => "dotted",
637             };
638 15         28 $elem->{index} = $$index++;
639             }
640             }
641 195         308 push @{$elem->{hashes}}, $link;
  195         514  
642             }
643              
644             # take hash containing transit network nodes
645             # return list of nodes
646             sub transit2nodes {
647 112     112 0 177 my OSPF::LSDB::View $self = shift;
648 112 50       304 my $transithash = $self->{transithash} or die "Uninitialized member";
649 112         305 return $self->elements2graphs(map { values %$_ } map { values %$_ }
  101         266  
  95         191  
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 193 my OSPF::LSDB::View $self = shift;
657 112 50       336 my $nethash = $self->{nethash} or die "Uninitialized member";
658 112 50       296 my $routehash = $self->{routehash} or die "Uninitialized member";
659 112 50       259 my $transithash = $self->{transithash} or die "Uninitialized member";
660 112         209 my $ifaddrs = $self->{ifaddrs};
661 112         141 my @elements;
662 112         198 my $index = 0;
663 112         295 foreach my $addr (sort keys %$transithash) {
664 95         145 my $av = $transithash->{$addr};
665 95         183 foreach my $area (sort keys %$av) {
666 101         146 my $ev = $av->{$area};
667 101         222 foreach my $rid (sort keys %$ev) {
668 193         239 my $rv = $ev->{$rid};
669 193         364 my %colors = (gray => $area);
670 193         328 my $src = $routehash->{$rid}{graph}{N};
671 193 100       202 if (@{$rv->{hashes}} > 1) {
  193         414  
672             $self->error($colors{yellow} =
673 2         15 "Transit network $addr at router $rid ".
674             "has multiple entries in area $area.");
675             }
676 193         233 foreach my $link (@{$rv->{hashes}}) {
  193         356  
677 195         300 my $intf = $link->{interface};
678 195         200 delete $colors{green};
679 195 100 66     695 if ($ifaddrs->{$intf} && $ifaddrs->{$intf}{$rid} > 1) {
680             $self->error($colors{green} =
681 3         21 "Transit link at router $rid to network $addr ".
682             "interface address $intf not unique.");
683             }
684 195         291 delete $colors{blue};
685 195 100       226 if (my @badrids = sort grep { $_ ne $rid }
  198         618  
686 195         418 keys %{$ifaddrs->{$intf}}) {
687             $self->error($colors{blue} =
688 3         22 "Transit link at router $rid to network $addr ".
689             "interface address $intf also at router @badrids.");
690             }
691 195         330 my $metric = $link->{metric};
692             # link from designated router to attached net
693 195 100       495 my $style = $addr eq $intf ? "bold" : "solid";
694 195         219 delete $colors{magenta};
695 195         193 delete $colors{brown};
696 195         216 delete $colors{tan};
697 195 100       305 if ($rv->{graph}) {
698 16         24 my $dst = $rv->{graph}{N};
699 16         100 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         46 next;
711             }
712 179         233 my $av = $nethash->{$addr};
713 179         307 foreach my $mask (sort keys %$av) {
714 181         207 my $mv = $av->{$mask};
715 181         279 my $nid = "$addr/$mask";
716 181         224 my $intfip = $intf;
717 181         389 foreach (split(/\./, $mask)) {
718 724 100       1048 last if $_ ne 255;
719 543         1747 $intfip =~ s/^\.?\d+//;
720             }
721 181         218 delete $colors{magenta};
722 181 100       328 if (_maskip($addr, $mask) ne _maskip($intf, $mask)) {
723             $self->error($colors{magenta} =
724 1         11 "Transit network $addr in area $area ".
725             "at router $rid interface $intf ".
726             "not in network $nid.");
727 1         1 $intfip = $intf;
728             }
729 181         397 foreach my $netrid (sort keys %$mv) {
730 187         236 my $nv = $mv->{$netrid};
731 187 100       347 my $ev = $nv->{$area}
732             or next;
733 183         288 delete $colors{brown};
734 183         194 delete $colors{tan};
735 183 100 100     709 if (! $ev->{attachrouters}{$rid}) {
    100          
736             $self->error($colors{brown} =
737 2         16 "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         16 "Transit link at router $rid in area $area ".
742             "is designated but network $nid is not.");
743             }
744 183         259 my $dst = $ev->{graph}{N};
745 183         1460 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         310 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 173 my OSPF::LSDB::View $self = shift;
790 112         199 my($netcluster) = @_;
791 112 50       361 my $nethash = $self->{nethash} or die "Uninitialized member";
792 112         177 my %netsmv;
793 112         317 foreach my $addr (sort keys %$nethash) {
794 88         147 my $av = $nethash->{$addr};
795 88         162 foreach my $mask (sort keys %$av) {
796 89         113 my $mv = $av->{$mask};
797 89         144 my $net = _maskip($addr, $mask);
798 89         107 push @{$netsmv{$net}{$mask}}, $mv;
  89         303  
799             }
800             }
801              
802 112 50       378 my $stubhash = $self->{stubhash} or die "Uninitialized member";
803 112         426 foreach my $net (sort keys %$stubhash) {
804 31         67 my $nv = $stubhash->{$net};
805 31         80 foreach my $mask (sort keys %$nv) {
806 31         45 my $mv = $nv->{$mask};
807 31         34 my %colors;
808 31         65 my $nid = "$net/$mask";
809 31 100       97 if ($netsmv{$net}{$mask}) {
810             $self->error($colors{blue} =
811 5         29 "Stub network $nid is also network.");
812             }
813 31         55 delete $colors{orange};
814 31 100       97 if (keys %$mv > 1) {
815             $self->error($colors{orange} =
816 1         6 "Stub network $nid in multiple areas.");
817             }
818 31         84 foreach my $area (sort keys %$mv) {
819 32         47 my $ev = $mv->{$area};
820 32         71 $colors{gray} = $area;
821 32         48 delete $colors{green};
822 32 100       108 if (keys %$ev > 1) {
823             $self->error($colors{green} =
824 1         9 "Stub network $nid in area $area at multiple routers.");
825             }
826 32         37 delete $colors{magenta};
827 32 100 100     110 if ($netsmv{$net}{$mask} and my @otherareas = sort
828 7         31 grep { $_ ne $area } map { keys %$_ } map { values %$_ }
  7         11  
  7         16  
829 5         13 @{$netsmv{$net}{$mask}}) {
830             $self->error($colors{magenta} =
831 1         8 "Stub network $nid in area $area ".
832             "is also network in areas @otherareas.");
833             }
834 32         82 foreach my $rid (sort keys %$ev) {
835 33         62 my $rv = $ev->{$rid};
836 33         48 delete $colors{yellow};
837 33 100 100     118 if ($netsmv{$net}{$mask} and grep { $_->{$rid} }
  7         23  
838 5         14 @{$netsmv{$net}{$mask}}) {
839             $self->error($colors{yellow} =
840 1         5 "Stub network $nid is also network at router $rid.");
841             }
842 33         157 %{$rv->{colors}} = %colors;
  33         111  
843 33         59 push @{$netcluster->{"$net/$mask"}}, $rv->{graph};
  33         189  
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 58 my OSPF::LSDB::View $self = shift;
854 36         109 my($stubhash, $stubs, $stubareas, $index, $rid, $area, $link) = @_;
855 36         82 my $addr = $link->{network};
856 36         74 my $mask = $link->{netmask};
857 36         94 my $net = _maskip($addr, $mask);
858 36         105 $stubs->{$net}{$mask}++;
859 36         98 $stubareas->{$net}{$mask}{$area}++;
860 36         143 my $elem = $stubhash->{$net}{$mask}{$area}{$rid};
861 36 100       95 if (! $elem) {
862 33         105 $stubhash->{$net}{$mask}{$area}{$rid} = $elem = {};
863             $elem->{graph} = {
864 33         257 N => "stubnet$$index",
865             label => "$net\\n$mask",
866             shape => "ellipse",
867             style => "solid",
868             };
869 33         100 $elem->{index} = $$index++;
870             }
871 36         56 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 230 my OSPF::LSDB::View $self = shift;
878 112 50       306 my $stubhash = $self->{stubhash} or die "Uninitialized member";
879 32         74 return $self->elements2graphs(map { values %$_ } map { values %$_ }
  31         63  
880 112         530 map { values %$_ } values %$stubhash);
  31         67  
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 237 my OSPF::LSDB::View $self = shift;
887 112 50       386 my $routehash = $self->{routehash} or die "Uninitialized member";
888 112 50       335 my $stubhash = $self->{stubhash} or die "Uninitialized member";
889 112         159 my @elements;
890 112         458 my $index = 0;
891 112         328 foreach my $net (sort keys %$stubhash) {
892 31         59 my $nv = $stubhash->{$net};
893 31         84 foreach my $mask (sort keys %$nv) {
894 31         83 my $mv = $nv->{$mask};
895 31         67 foreach my $area (sort keys %$mv) {
896 32         49 my $ev = $mv->{$area};
897 32         59 foreach my $rid (sort keys %$ev) {
898 33         51 my $rv = $ev->{$rid};
899 33         73 my %colors = (gray => $area);
900 33         74 my $src = $routehash->{$rid}{graph}{N};
901 33         81 my $nid = "$net/$mask";
902 33 100       50 if (@{$rv->{hashes}} > 1) {
  33         92  
903             $self->error($colors{yellow} =
904 2         15 "Stub network $nid at router $rid ".
905             "has multiple entries in area $area.");
906             }
907 33         54 foreach my $link (@{$rv->{hashes}}) {
  33         75  
908 36         56 my $dst = $rv->{graph}{N};
909 36         61 my $addr = $link->{network};
910 36         45 my @headlabel;
911 36         309 delete $colors{magenta};
912 36 100       104 if ($net ne $addr) {
913             $self->error($colors{magenta} =
914 3         15 "Stub network $nid address $addr ".
915             "is not network.");
916 3         5 my $intfip = $addr;
917 3         9 foreach (split(/\./, $mask)) {
918 12 100       18 last if $_ ne 255;
919 9         25 $intfip =~ s/^\.?\d+//;
920             }
921 3         8 @headlabel = (headlabel => $intfip);
922             }
923 36         58 my $metric = $link->{metric};
924 36         294 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         229 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 195 my OSPF::LSDB::View $self = shift;
980 112         252 my($netcluster) = @_;
981 112 50       287 my $nethash = $self->{nethash} or die "Uninitialized member";
982 112 50       270 my $nets = $self->{nets} or die "Uninitialized member";
983 112         154 my %colors;
984 112         378 foreach my $addr (sort keys %$nethash) {
985 88         378 my $av = $nethash->{$addr};
986 88         148 delete $colors{magenta};
987 88 100       207 if (keys %$av > 1) {
988             $self->error($colors{magenta} =
989 1         6 "Network $addr with multiple netmasks.");
990             }
991 88         185 foreach my $mask (sort keys %$av) {
992 89         131 my $mv = $av->{$mask};
993 89         201 my $nid = "$addr/$mask";
994 89         183 my $net = _maskip($addr, $mask);
995 89         137 delete $colors{green};
996 89 100       304 if ($nets->{$net}{$mask} > 1) {
997             $self->error($colors{green} =
998 11         79 "Network $nid not unique in network $net.");
999             }
1000 89         135 delete $colors{blue};
1001 89 100       220 if (keys %$mv > 1) {
1002             $self->error($colors{blue} =
1003 2         8 "Network $nid at multiple routers.");
1004             }
1005 89         207 foreach my $rid (sort keys %$mv) {
1006 91         155 my $rv = $mv->{$rid};
1007 91         112 delete $colors{orange};
1008 91 100       181 if (keys %$rv > 1) {
1009             $self->error($colors{orange} =
1010 1         7 "Network $nid at router $rid in multiple areas.");
1011             }
1012 91         204 foreach my $area (sort keys %$rv) {
1013 92         116 my $ev = $rv->{$area};
1014 92         164 $colors{gray} = $area;
1015 92         138 delete $colors{yellow};
1016 92 100       244 if (@{$ev->{hashes}} > 1) {
  92         250  
1017             $self->error($colors{yellow} =
1018 2         10 "Network $nid at router $rid ".
1019             "has multiple entries in area $area.");
1020             }
1021 92         113 delete $colors{brown};
1022 92         129 my @attrids = keys %{$ev->{attachrouters}};
  92         255  
1023 92 100       208 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       224 if (@attrids == 1) {
1029             $self->error($colors{brown} =
1030 1         37 "Network $nid at router $rid attached only ".
1031             "to router @attrids in area $area.");
1032             }
1033 92         156 %{$ev->{colors}} = %colors;
  92         200  
1034 92         112 push @{$netcluster->{"$net/$mask"}}, $ev->{graph};
  92         517  
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 159 my OSPF::LSDB::View $self = shift;
1045 112         239 my($index) = @_;
1046 112         288 my %nethash;
1047             my %nets;
1048 112         0 my %netareas;
1049 112         132 foreach my $n (@{$self->{ospf}{database}{networks}}) {
  112         403  
1050 94         195 my $addr = $n->{address};
1051 94         143 my $mask = $n->{netmask};
1052 94         206 my $nid = "$addr/$mask";
1053 94         212 my $net = _maskip($addr, $mask);
1054 94         293 $nets{$net}{$mask}++;
1055 94         161 my $rid = $n->{routerid};
1056 94         128 my $area = $n->{area};
1057 94         225 $netareas{$net}{$mask}{$area}++;
1058 94         331 my $elem = $nethash{$addr}{$mask}{$rid}{$area};
1059 94 100       248 if (! $elem) {
1060 92         225 $nethash{$addr}{$mask}{$rid}{$area} = $elem = {};
1061             $elem->{graph} = {
1062 92         519 N => "network$$index",
1063             label => "$net\\n$mask",
1064             shape => "ellipse",
1065             style => "bold",
1066             };
1067 92         285 $elem->{index} = $$index++;
1068             }
1069 94         140 push @{$elem->{hashes}}, $n;
  94         426  
1070 94         125 foreach my $att (@{$n->{attachments}}) {
  94         186  
1071 196         468 $elem->{attachrouters}{$att->{routerid}} = 1;
1072             }
1073             }
1074 112         288 $self->{nethash} = \%nethash;
1075 112         241 $self->{nets} = \%nets;
1076 112         260 $self->{netareas} = \%netareas;
1077             }
1078              
1079             # only necessary for ipv6
1080             sub add_missing_network {
1081 112     112 0 194 my OSPF::LSDB::View $self = shift;
1082 112         218 my($index) = @_;
1083             }
1084              
1085             # take hash containing network nodes
1086             # return list of nodes
1087             sub network2nodes {
1088 112     112 0 159 my OSPF::LSDB::View $self = shift;
1089 112 50       272 my $nethash = $self->{nethash} or die "Uninitialized member";
1090 91         179 return $self->elements2graphs(map { values %$_ } map { values %$_ }
  89         144  
1091 112         365 map { values %$_ } values %$nethash);
  88         179  
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 205 my OSPF::LSDB::View $self = shift;
1098 112 50       307 my $nethash = $self->{nethash} or die "Uninitialized member";
1099 112 50       306 my $routehash = $self->{routehash} or die "Uninitialized member";
1100 112 50       250 my $transithash = $self->{transithash} or die "Uninitialized member";
1101 112         159 my @elements;
1102 112         148 my $index = 0;
1103 112         330 foreach my $addr (sort keys %$nethash) {
1104 88         130 my $av = $nethash->{$addr};
1105 88         170 foreach my $mask (sort keys %$av) {
1106 89         109 my $mv = $av->{$mask};
1107 89         162 my $nid = "$addr/$mask";
1108 89         134 my $intfip = $addr;
1109 89         258 foreach (split(/\./, $mask)) {
1110 356 100       519 last if $_ ne 255;
1111 267         647 $intfip =~ s/^\.?\d+//;
1112             }
1113 89         211 foreach my $rid (sort keys %$mv) {
1114 91         139 my $rv = $mv->{$rid};
1115 91         160 foreach my $area (sort keys %$rv) {
1116 92         126 my $ev = $rv->{$area};
1117 92         142 my $src = $ev->{graph}{N};
1118 92         193 foreach my $net (@{$ev->{hashes}}) {
  92         178  
1119 94         105 my %attcolors;
1120 94         105 foreach (@{$net->{attachments}}) {
  94         204  
1121 196         304 my $arid = $_->{routerid};
1122 196 100       314 if ($attcolors{$arid}) {
1123             $self->error($attcolors{$arid}{yellow} =
1124 2         16 "Network $nid in area $area at router $rid ".
1125             "attached to router $arid multiple times.");
1126 2         4 next;
1127             }
1128 194         325 $attcolors{$arid}{gray} = $area;
1129 194 100 66     624 if ($routehash->{$arid}{areas} &&
1130             ! $routehash->{$arid}{areas}{$area}) {
1131             $self->error($attcolors{$arid}{orange} =
1132 4         33 "Network $nid and router $arid ".
1133             "not in same area $area.");
1134 4         8 next;
1135             }
1136 190         280 my $tv = $transithash->{$addr}{$area}{$arid};
1137 190 100 100     408 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         2 next;
1142             }
1143 189 100 100     549 if ($arid eq $rid && $tv && ! grep { $addr eq
      100        
1144 86         347 $_->{interface} } @{$tv->{hashes}}) {
  85         150  
1145             $self->error($attcolors{$arid}{tan} =
1146 11         63 "Network $nid at router $arid in area $area ".
1147             "is designated but transit link is not.");
1148 11         17 next;
1149             }
1150             }
1151 94         183 foreach (@{$net->{attachments}}) {
  94         179  
1152 196         258 my $arid = $_->{routerid};
1153             my $dst = $routehash->{$arid}{graph}{N}
1154 196 50       355 or die "No router graph $arid";
1155 196         220 my $style = "solid";
1156 196         201 my @taillabel;
1157 196 100       268 if ($arid eq $rid) {
1158             # router is designated router
1159 93         103 $style = "bold";
1160 93         181 @taillabel = (taillabel => $intfip);
1161             }
1162             push @elements, {
1163             graph => {
1164             S => $src,
1165             D => $dst,
1166             style => $style,
1167             @taillabel,
1168             },
1169 196         445 colors => { %{$attcolors{$arid}} },
  196         694  
1170             index => $index++,
1171             };
1172             }
1173 94 100       356 if (! $attcolors{$rid}) {
1174             my $dst = $routehash->{$rid}{graph}{N}
1175 3 50       10 or die "No router graph $rid";
1176 3         9 $attcolors{$rid}{gray} = $area;
1177             $self->error($attcolors{$rid}{red} =
1178 3         20 "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         242 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 151 my OSPF::LSDB::View $self = shift;
1238 92         378 my($netcluster) = @_;
1239 92 50       267 my $netareas = $self->{netareas} or die "Uninitialized member";
1240 92 50       333 my $stubareas = $self->{stubareas} or die "Uninitialized member";
1241 92 50       251 my $sumhash = $self->{sumhash} or die "Uninitialized member";
1242 92         303 foreach my $net (sort keys %$sumhash) {
1243 55         81 my $nv = $sumhash->{$net};
1244 55         110 foreach my $mask (sort keys %$nv) {
1245 55         80 my $mv = $nv->{$mask};
1246 55         71 my %colors;
1247 55         133 my $nid = "$net/$mask";
1248 55         80 my @areas = sort keys %{$mv->{arearids}};
  55         161  
1249 55 100       4988 if (@areas > 1) {
1250 25         37 $colors{black} = \@areas;
1251             } else {
1252 30         67 $colors{gray} = $areas[0];
1253             }
1254 55 100       97 if (my @badareas = grep { $netareas->{$net}{$mask}{$_} } @areas) {
  80         211  
1255             $self->error($colors{blue} =
1256 2         13 "Summary network $nid is also network in areas @badareas.");
1257             }
1258 55 100 66     194 if ($stubareas and
1259 80         225 my @badareas = grep { $stubareas->{$net}{$mask}{$_} } @areas) {
1260             $self->error($colors{green} =
1261 3         24 "Summary network $nid is also stub network ".
1262             "in areas @badareas.");
1263             }
1264 55         101 $mv->{colors} = \%colors;
1265 55         58 push @{$netcluster->{"$net/$mask"}}, $mv->{graph};
  55         210  
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 169 my OSPF::LSDB::View $self = shift;
1274 92         147 my $index = 0;
1275 92         147 my %sumhash;
1276             my %sums;
1277 92         160 foreach my $s (@{$self->{ospf}{database}{summarys}}) {
  92         333  
1278 158         242 my $addr = $s->{address};
1279 158         227 my $mask = $s->{netmask};
1280 158         213 my $nid = "$addr/$mask";
1281 158         212 my $net = _maskip($addr, $mask);
1282 158         277 $sums{$net}{$mask}++;
1283 158         211 my $rid = $s->{routerid};
1284 158         166 my $area = $s->{area};
1285 158         197 my $elem = $sumhash{$net}{$mask};
1286 158 100       238 if (! $elem) {
1287 55         121 $sumhash{$net}{$mask} = $elem = {};
1288             $elem->{graph} = {
1289 55         251 N => "summary$index",
1290             label => "$net\\n$mask",
1291             shape => "ellipse",
1292             style => "dashed",
1293             };
1294 55         122 $elem->{index} = $index++;
1295             }
1296 158         194 push @{$elem->{hashes}}, $s;
  158         261  
1297 158         343 $elem->{arearids}{$area}{$rid}++;
1298             }
1299 92         174 $self->{sumhash} = \%sumhash;
1300 92         201 $self->{sums} = \%sums;
1301             }
1302              
1303             # take hash containing summary nodes
1304             # return list of nodes
1305             sub summary2nodes {
1306 144     144 0 224 my OSPF::LSDB::View $self = shift;
1307 144 50       403 my $sumhash = $self->{sumhash} or die "Uninitialized member";
1308 144         368 return $self->elements2graphs(map { values %$_ } values %$sumhash);
  64         139  
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 131 my OSPF::LSDB::View $self = shift;
1315 92 50       234 my $routehash = $self->{routehash} or die "Uninitialized member";
1316 92 50       242 my $sumhash = $self->{sumhash} or die "Uninitialized member";
1317 92         107 my @elements;
1318 92         114 my $index = 0;
1319 92         246 foreach my $net (sort keys %$sumhash) {
1320 55         75 my $nv = $sumhash->{$net};
1321 55         128 foreach my $mask (sort keys %$nv) {
1322 55         59 my $mv = $nv->{$mask};
1323 55         98 my $nid = "$net/$mask";
1324 55   66     169 my $src = $mv->{graph} && $mv->{graph}{N};
1325 55         64 foreach my $s (@{$mv->{hashes}}) {
  55         88  
1326 158         259 my $rid = $s->{routerid};
1327             my $dst = $routehash->{$rid}{graph}{N}
1328 158 50       301 or die "No router graph $rid";
1329 158         194 my $addr = $s->{address};
1330 158         168 my $addrip = $addr;
1331 158         339 foreach (split(/\./, $mask)) {
1332 632 100       887 last if $_ ne 255;
1333 474         1024 $addrip =~ s/^\.?\d+//;
1334             }
1335 158         211 my $area = $s->{area};
1336 158         266 my %colors = (gray => $area);
1337 158 100       266 if (! $routehash->{$rid}{areas}{$area}) {
1338             $self->error($colors{orange} =
1339 1         8 "Summary network $nid and router $rid ".
1340             "not in same area $area.");
1341             }
1342 158 100       290 if ($mv->{arearids}{$area}{$rid} > 1) {
1343             $self->error($colors{yellow} =
1344 4         22 "Summary network $nid at router $rid ".
1345             "has multiple entries in area $area.");
1346             }
1347 158         196 my $metric = $s->{metric};
1348             $s->{graph} = {
1349 158         561 S => $src,
1350             D => $dst,
1351             headlabel => $metric,
1352             style => "dashed",
1353             taillabel => $addrip,
1354             };
1355 158         220 $s->{colors} = \%colors;
1356 158         203 $s->{index} = $index++;
1357             # in case of aggregation src is undef
1358 158 100       351 push @elements, $s if $src;
1359             }
1360             }
1361             }
1362 92         186 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 43 my OSPF::LSDB::View $self = shift;
1376             # $ridnets{$rid}{$network} = {
1377             # color => orange,
1378             # areas => { $area => { $metric => [ { sum hash } ] } }
1379             # }
1380 25 50       105 my $sumhash = $self->{sumhash} or die "Uninitialized member";
1381 25         45 my %ridareanets;
1382 25         73 my $index = 0;
1383 25         99 foreach my $net (sort keys %$sumhash) {
1384 46         70 my $nv = $sumhash->{$net};
1385 46         76 foreach my $mask (sort keys %$nv) {
1386 46         63 my $mv = $nv->{$mask};
1387 46         86 my $nid = "$net/$mask";
1388             # no not aggregate clustered graphs
1389 46 100       109 next if $mv->{graph}{C};
1390 25         72 my $colors = $mv->{colors};
1391             # no not aggregate graphs with errors
1392 25 100       61 next if grep { ! /^(gray|black)$/ } keys %$colors;
  26         176  
1393 24         42 my $areaaggr = join('\n', sort _cmp_ip keys %{$mv->{arearids}});
  24         94  
1394 24         35 foreach my $s (@{$mv->{hashes}}) {
  24         54  
1395 31         46 my $rid = $s->{routerid};
1396 31         43 my $area = $s->{area};
1397 31         47 my $metric = $s->{metric};
1398 31         57 my $elem = $ridareanets{$rid}{$areaaggr}{$nid};
1399 31 100 66     80 if (! $elem) {
    100 66        
1400 27         119 $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         32 push @{$elem->{colors}{black}},
1407             (delete($elem->{colors}{gray}) || ()),
1408 3 50 33     7 ($colors->{gray} || ()), @{$colors->{black} || []};
  3   33     14  
1409             }
1410 31         44 push @{$elem->{areas}{$area}{$metric}}, $s;
  31         116  
1411             }
1412 24         60 delete $mv->{graph};
1413             }
1414             }
1415 25         30 my %sumaggr;
1416 25         52 $index = 0;
1417 25         61 foreach my $rid (sort keys %ridareanets) {
1418 17         41 my $rv = $ridareanets{$rid};
1419 17         50 foreach my $area (sort keys %$rv) {
1420 18         33 my $av = $rv->{$area};
1421 18         70 my $netaggr = join('\n', sort _cmp_ip_net keys %$av);
1422 18         74 my $elem = $sumaggr{$netaggr};
1423 18 100       48 if (! $elem) {
1424 17         51 $sumaggr{$netaggr} = $elem = {};
1425             $elem->{graph} = {
1426 17         82 N => "summaryaggregate$index",
1427             label => $netaggr,
1428             shape => "ellipse",
1429             style => "dashed",
1430             };
1431 17         44 $elem->{index} = $index++;
1432             }
1433 18         57 foreach my $nid (sort keys %$av) {
1434 27         34 my $nv = $av->{$nid};
1435 27         45 my $colors = $nv->{colors};
1436 27 100 66     94 if (! $elem->{colors}) {
    100 66        
1437 17         38 %{$elem->{colors}} = %$colors;
  17         59  
1438             } elsif (! $elem->{colors}{gray} || ! $colors->{gray} ||
1439             $elem->{colors}{gray} ne $colors->{gray}) {
1440 1         7 push @{$elem->{colors}{black}},
1441             (delete($elem->{colors}{gray}) || ()),
1442 1 50 33     2 ($colors->{gray} || ()), @{$colors->{black} || []};
  1   33     6  
1443             }
1444 27         43 foreach my $area (sort keys %{$nv->{areas}}) {
  27         72  
1445 30         55 my $ev = $nv->{areas}{$area};
1446 30         73 foreach my $metric (sort keys %$ev) {
1447 30         42 my $ss = $ev->{$metric};
1448 30         34 push @{$elem->{routers}{$rid}{$area}{$metric}}, @$ss;
  30         117  
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 41 my OSPF::LSDB::View $self = shift;
1461 25 50       105 my $sumaggr = $self->{sumaggr} or die "Uninitialized member";
1462 25         97 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 56 my OSPF::LSDB::View $self = shift;
1469 25 50       78 my $sumaggr = $self->{sumaggr} or die "Uninitialized member";
1470 25         33 my @elements;
1471 25         76 foreach my $netaggr (sort keys %$sumaggr) {
1472 17         30 my $nv = $sumaggr->{$netaggr};
1473 17         41 my $src = $nv->{graph}{N};
1474 17         20 foreach my $rid (sort keys %{$nv->{routers}}) {
  17         63  
1475 18         30 my $rv = $nv->{routers}{$rid};
1476 18         56 foreach my $area (sort keys %$rv) {
1477 20         26 my $av = $rv->{$area};
1478 20         53 foreach my $metric (sort keys %$av) {
1479 22         59 my $ss = $av->{$metric};
1480 22         32 my $aggrs;
1481 22         49 foreach my $s (@$ss) {
1482 31         45 $s->{graph}{S} = $src;
1483             # no not aggregate graphs with errors
1484 31 100       37 if (grep { ! /^(gray|black)$/ } keys %{$s->{colors}}) {
  33         149  
  31         71  
1485 2         3 push @elements, $s;
1486             } else {
1487 29         47 delete $s->{graph}{taillabel};
1488 29         33 $aggrs = $s;
1489             }
1490             }
1491 22 50       79 push @elements, $aggrs if $aggrs;
1492             }
1493             }
1494             }
1495             }
1496 25         54 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 212 my OSPF::LSDB::View $self = shift;
1536 151 50       422 my $boundhash = $self->{boundhash} or die "Uninitialized member";
1537 151         537 while (my($asbr,$bv) = each %$boundhash) {
1538 101         138 my @areas = sort keys %{$bv->{arearids}};
  101         235  
1539 101 100       194 if (@areas > 1) {
1540 31         139 $bv->{colors}{black} = \@areas;
1541             } else {
1542 70         235 $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 201 my OSPF::LSDB::View $self = shift;
1551 99         168 my $index = 0;
1552 99         120 my %boundhash;
1553 99         211 foreach my $b (@{$self->{ospf}{database}{boundarys}}) {
  99         431  
1554 180         312 my $asbr = $b->{asbrouter};
1555 180         221 my $rid = $b->{routerid};
1556 180         227 my $area = $b->{area};
1557 180         197 my $elem = $boundhash{$asbr};
1558 180 100       302 if (! $elem) {
1559 81         192 $boundhash{$asbr} = $elem = {};
1560             $elem->{graph} = {
1561 81         316 N => "boundary$index",
1562             label => $asbr,
1563             shape => "box",
1564             style => "dashed",
1565             };
1566 81         163 $elem->{index} = $index++;
1567             }
1568 180         187 push @{$elem->{hashes}}, $b;
  180         263  
1569 180         359 $elem->{arearids}{$area}{$rid}++;
1570             }
1571 99         241 $self->{boundhash} = \%boundhash;
1572             }
1573              
1574             # take hash containing boundary nodes
1575             # return list of nodes
1576             sub boundary2nodes {
1577 151     151 0 251 my OSPF::LSDB::View $self = shift;
1578 151 50       407 my $boundhash = $self->{boundhash} or die "Uninitialized member";
1579 151         333 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 146 my OSPF::LSDB::View $self = shift;
1586 99 50       269 my $routehash = $self->{routehash} or die "Uninitialized member";
1587 99 50       283 my $boundhash = $self->{boundhash} or die "Uninitialized member";
1588 99         120 my @elements;
1589 99         142 my $index = 0;
1590 99         258 foreach my $asbr (sort keys %$boundhash) {
1591 81         157 my $bv = $boundhash->{$asbr};
1592 81         80 my $src;
1593 81 100       193 if ($bv->{graph}) {
    100          
1594 18         26 $src = $bv->{graph}{N};
1595             } elsif ($routehash->{$asbr}) {
1596             $src = $routehash->{$asbr}{graph}{N}
1597 27         64 }
1598 81         106 foreach my $b (@{$bv->{hashes}}) {
  81         149  
1599 180         274 my $rid = $b->{routerid};
1600             my $dst = $routehash->{$rid}{graph}{N}
1601 180 50       343 or die "No router graph $rid";
1602 180         230 my $area = $b->{area};
1603 180         274 my %colors = (gray => $area);
1604 180 100 66     565 if ($asbr eq $rid) {
    100          
1605             $self->error($colors{brown} =
1606 1         9 "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         48 "AS boundary router $asbr is router in same area $area.");
1611             }
1612 180 100       328 if (! $routehash->{$rid}{areas}{$area}) {
1613             $self->error($colors{orange} =
1614 2         12 "AS boundary router $asbr and router $rid ".
1615             "not in same area $area.");
1616             }
1617 180 100       349 if ($bv->{arearids}{$area}{$rid} > 1) {
1618             $self->error($colors{yellow} =
1619 8         41 "AS boundary router $asbr at router $rid ".
1620             "has multiple entries in area $area.");
1621             }
1622 180         298 my $metric = $b->{metric};
1623             $b->{graph} = {
1624 180         506 S => $src,
1625             D => $dst,
1626             headlabel => $metric,
1627             style => "dashed",
1628             };
1629 180         669 $b->{colors} = \%colors;
1630 180         219 $b->{index} = $index++;
1631             # in case of aggregation src is undef
1632 180 100       363 push @elements, $b if $src;
1633             }
1634             }
1635 99         217 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 51 my OSPF::LSDB::View $self = shift;
1649             # $ridasbrs{$rid}{$asbr} = {
1650             # color => orange,
1651             # areas => { $area => { $metric => [ { bound hash } ] } }
1652             # }
1653 30 50       120 my $boundhash = $self->{boundhash} or die "Uninitialized member";
1654 30         49 my %ridasbrs;
1655 30         53 my $index = 0;
1656 30         109 foreach my $asbr (sort keys %$boundhash) {
1657 56         82 my $bv = $boundhash->{$asbr};
1658             # no not aggregate if ASBR has been deleted by create route
1659 56 100       132 next unless $bv->{graph};
1660 36         60 my $colors = $bv->{colors};
1661             # no not aggregate graphs with errors
1662 36 50       96 next if grep { ! /^(gray|black)$/ } keys %$colors;
  36         225  
1663 36         52 foreach my $b (@{$bv->{hashes}}) {
  36         77  
1664 46         70 my $rid = $b->{routerid};
1665 46         65 my $area = $b->{area};
1666 46         61 my $metric = $b->{metric};
1667 46         74 my $elem = $ridasbrs{$rid}{$asbr};
1668 46 100 33     105 if (! $elem) {
    50 33        
1669 44         147 $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         95 push @{$elem->{areas}{$area}{$metric}}, $b;
  46         176  
1680             }
1681 36         88 delete $bv->{graph};
1682             }
1683 30         42 my %boundaggr;
1684 30         46 $index = 0;
1685 30         82 foreach my $rid (sort keys %ridasbrs) {
1686 23         78 my $rv = $ridasbrs{$rid};
1687 23         132 my $asbraggr = join('\n', sort _cmp_ip keys %$rv);
1688 23         51 my $elem = $boundaggr{$asbraggr};
1689 23 100       53 if (! $elem) {
1690 22         58 $boundaggr{$asbraggr} = $elem = {};
1691             $elem->{graph} = {
1692 22         111 N => "boundaryaggregate$index",
1693             label => $asbraggr,
1694             shape => "box",
1695             style => "dashed",
1696             };
1697 22         55 $elem->{index} = $index++;
1698             }
1699 23         66 foreach my $asbr (sort keys %$rv) {
1700 44         68 my $bv = $rv->{$asbr};
1701 44         90 $boundhash->{$asbr}{aggregate}{$asbraggr}++;
1702 44         63 my $colors = $bv->{colors};
1703 44 100 66     179 if (! $elem->{colors}) {
    100 100        
1704 22         59 %{$elem->{colors}} = %$colors;
  22         55  
1705             } elsif (! $elem->{colors}{gray} || ! $colors->{gray} ||
1706             $elem->{colors}{gray} ne $colors->{gray}) {
1707 3         18 push @{$elem->{colors}{black}},
1708             (delete($elem->{colors}{gray}) || ()),
1709 3 50 66     5 ($colors->{gray} || ()), @{$colors->{black} || []};
  3   33     20  
1710             }
1711 44         64 foreach my $area (sort keys %{$bv->{areas}}) {
  44         104  
1712 44         60 my $ev = $bv->{areas}{$area};
1713 44         86 foreach my $metric (sort keys %$ev) {
1714 44         52 my $bs = $ev->{$metric};
1715 44         49 push @{$elem->{routers}{$rid}{$area}{$metric}}, @$bs;
  44         156  
1716             }
1717             }
1718             }
1719             }
1720 30         109 $self->{boundaggr} = \%boundaggr;
1721             }
1722              
1723             # take hash containing boundary aggregated nodes
1724             # return list of nodes
1725             sub boundaggr2nodes {
1726 30     30 0 60 my OSPF::LSDB::View $self = shift;
1727 30 50       91 my $boundaggr = $self->{boundaggr} or die "Uninitialized member";
1728 30         75 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 50 my OSPF::LSDB::View $self = shift;
1735 30 50       78 my $boundaggr = $self->{boundaggr} or die "Uninitialized member";
1736 30         41 my @elements;
1737 30         104 foreach my $asbraggr (sort keys %$boundaggr) {
1738 22         48 my $bv = $boundaggr->{$asbraggr};
1739 22         34 my $src = $bv->{graph}{N};
1740 22         33 foreach my $rid (sort keys %{$bv->{routers}}) {
  22         61  
1741 23         39 my $rv = $bv->{routers}{$rid};
1742 23         107 foreach my $area (sort keys %$rv) {
1743 25         42 my $av = $rv->{$area};
1744 25         66 foreach my $metric (sort keys %$av) {
1745 27         42 my $bs = $av->{$metric};
1746 27         32 my $aggrb;
1747 27         49 foreach my $b (@$bs) {
1748 46         60 $b->{graph}{S} = $src;
1749             # no not aggregate graphs with errors
1750 46 100       52 if (grep { ! /^(gray|black)$/ } keys %{$b->{colors}}) {
  50         227  
  46         80  
1751 4         6 push @elements, $b;
1752             } else {
1753 42         80 $aggrb = $b;
1754             }
1755             }
1756 27 50       101 push @elements, $aggrb if $aggrb;
1757             }
1758             }
1759             }
1760             }
1761 30         73 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 164 my OSPF::LSDB::View $self = shift;
1800 99         189 my($netcluster) = @_;
1801 99 50       313 my $nets = $self->{nets} or die "Uninitialized member";
1802 99 50       273 my $stubs = $self->{stubs} or die "Uninitialized member";
1803 99         595 my $sums = $self->{sums};
1804 99 50       284 my $externhash = $self->{externhash} or die "Uninitialized member";
1805 99         344 foreach my $net (sort keys %$externhash) {
1806 87         129 my $nv = $externhash->{$net};
1807 87         165 foreach my $mask (sort keys %$nv) {
1808 87         106 my $mv = $nv->{$mask};
1809 87         203 my %colors = (gray => "ase");
1810 87         154 my $nid = "$net/$mask";
1811 87 100       231 if ($nets->{$net}{$mask}) {
1812             $self->error($colors{blue} =
1813 3         18 "AS external network $nid is also network.");
1814             }
1815 87 100 66     299 if ($stubs and $stubs->{$net}{$mask}) {
1816             $self->error($colors{green} =
1817 5         24 "AS external network $nid is also stub network.");
1818             }
1819 87 100       157 if ($sums->{$net}{$mask}) {
1820             $self->error($colors{cyan} =
1821 4         15 "AS external network $nid is also summary network.");
1822             }
1823 87         132 $mv->{colors} = \%colors;
1824 87         108 push @{$netcluster->{"$net/$mask"}}, $mv->{graph};
  87         297  
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 138 my OSPF::LSDB::View $self = shift;
1833 99         132 my $index = 0;
1834 99         148 my %externhash;
1835 99         167 foreach my $e (@{$self->{ospf}{database}{externals}}) {
  99         337  
1836 138         224 my $addr = $e->{address};
1837 138         198 my $mask = $e->{netmask};
1838 138         207 my $nid = "$addr/$mask";
1839 138         221 my $net = _maskip($addr, $mask);
1840 138         216 my $rid = $e->{routerid};
1841 138         225 my $elem = $externhash{$net}{$mask};
1842 138 100       217 if (! $elem) {
1843 87         169 $externhash{$net}{$mask} = $elem = {};
1844             $elem->{graph} = {
1845 87         345 N => "external$index",
1846             label => "$net\\n$mask",
1847             shape => "egg",
1848             style => "solid",
1849             };
1850 87         144 $elem->{index} = $index++;
1851             }
1852 138         137 push @{$elem->{hashes}}, $e;
  138         349  
1853 138         274 $elem->{routers}{$rid}++;
1854             }
1855 99         235 $self->{externhash} = \%externhash;
1856             }
1857              
1858             # take hash containing external nodes
1859             # return list of nodes
1860             sub external2nodes {
1861 151     151 0 245 my OSPF::LSDB::View $self = shift;
1862 151 50       369 my $externhash = $self->{externhash} or die "Uninitialized member";
1863 151         341 return $self->elements2graphs(map { values %$_ } values %$externhash);
  99         173  
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 173 my OSPF::LSDB::View $self = shift;
1870 99 50       281 my $routehash = $self->{routehash} or die "Uninitialized member";
1871 99         166 my $boundhash = $self->{boundhash};
1872 99         147 my $boundaggr = $self->{boundaggr};
1873 99 50       225 my $externhash = $self->{externhash} or die "Uninitialized member";
1874 99         121 my @elements;
1875 99         141 my $index = 0;
1876 99         266 foreach my $net (sort keys %$externhash) {
1877 87         123 my $nv = $externhash->{$net};
1878 87         160 foreach my $mask (sort keys %$nv) {
1879 87         144 my $mv = $nv->{$mask};
1880 87         143 my $nid = "$net/$mask";
1881 87         142 my $src = $mv->{graph}{N};
1882 87         83 my %dtm; # when dst is aggregated, aggregate edges
1883 87         194 foreach my $e (@{$mv->{hashes}}) {
  87         149  
1884 138         241 my $rid = $e->{routerid};
1885 138         169 my $addr = $e->{address};
1886 138         148 my $addrip = $addr;
1887 138         314 foreach (split(/\./, $mask)) {
1888 489 100       675 last if $_ ne 255;
1889 355         746 $addrip =~ s/^\.?\d+//;
1890             }
1891 138         208 my $type = $e->{type};
1892 138         180 my $metric = $e->{metric};
1893 138         246 my %colors = (gray => "ase");
1894 138 100       243 if ($mv->{routers}{$rid} > 1) {
1895             $self->error($colors{yellow} =
1896 9         35 "AS external network $nid at router $rid ".
1897             "has multiple entries.");
1898             }
1899 138 100       233 my $style = $type == 1 ? "solid" : "dashed";
1900 138         343 my %graph = (
1901             S => $src,
1902             headlabel => $metric,
1903             style => $style,
1904             taillabel => $addrip,
1905             );
1906 138 100       242 if ($routehash->{$rid}) {
1907             my $dst = $routehash->{$rid}{graph}{N}
1908 98 50       188 or die "No router graph $rid";
1909 98         120 $graph{D} = $dst;
1910 98         303 $e->{elems}{$dst} = {
1911             graph => \%graph,
1912             colors => \%colors,
1913             index => $index++,
1914             };
1915 98 100       152 push @elements, $e->{elems}{$dst} if $src;
1916 98         166 next;
1917             }
1918 40         57 my $av = $boundhash->{$rid}{aggregate};
1919 40 100       94 if (! $av) {
1920             my $dst = $boundhash->{$rid}{graph}{N}
1921 12 50       27 or die "No ASB router graph $rid";
1922 12         16 $graph{D} = $dst;
1923 12         35 $e->{elems}{$dst} = {
1924             graph => \%graph,
1925             colors => \%colors,
1926             index => $index++,
1927             };
1928 12 100       22 push @elements, $e->{elems}{$dst} if $src;
1929 12         22 next;
1930             }
1931 28         72 foreach my $asbraggr (sort keys %$av) {
1932 36         53 my $num = $av->{$asbraggr};
1933             my $dst = $boundaggr->{$asbraggr}{graph}{N}
1934 36 50       85 or die "No ASBR graph $asbraggr";
1935 36         86 $graph{D} = $dst;
1936 36         218 $e->{elems}{$dst} = {
1937             graph => { %graph },
1938             colors => { %colors },
1939             index => $index++,
1940             };
1941             # no not aggregate graphs with errors
1942 36 100       75 if (grep { ! /^(gray|black)$/ } keys %colors) {
  38         146  
1943 2 50       9 push @elements, $e->{elems}{$dst} if $src;
1944             } else {
1945 34         118 $dtm{$dst}{$type}{$metric} = $e->{elems}{$dst};
1946             }
1947             }
1948             }
1949 87 100       209 push @elements, map { values %$_ } map { values %$_ } values %dtm
  5         13  
  5         10  
1950             if $src;
1951             }
1952             }
1953 99         187 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 41 my OSPF::LSDB::View $self = shift;
1967             # $ridnets{$rid}{$network} =
1968             # color => orange,
1969             # types => { $type => { $metric => [ { ase hash } ] } }
1970 19 50       69 my $externhash = $self->{externhash} or die "Uninitialized member";
1971 19         28 my %ridnets;
1972 19         37 my $index = 0;
1973 19         110 foreach my $net (sort keys %$externhash) {
1974 73         102 my $nv = $externhash->{$net};
1975 73         135 foreach my $mask (sort keys %$nv) {
1976 73         128 my $mv = $nv->{$mask};
1977 73         126 my $nid = "$net/$mask";
1978             # no not aggregate clustered graphs
1979 73 100       142 next if $mv->{graph}{C};
1980 70         89 my $colors = $mv->{colors};
1981             # no not aggregate graphs with errors
1982 70 100       129 next if grep { ! /^(gray|black)$/ } keys %$colors;
  72         285  
1983 68         85 foreach my $e (@{$mv->{hashes}}) {
  68         121  
1984 107         191 my $rid = $e->{routerid};
1985 107         127 my $type = $e->{type};
1986 107         132 my $metric = $e->{metric};
1987 107         135 my $elem = $ridnets{$rid}{$nid};
1988 107 100 33     166 if (! $elem) {
    50 33        
1989 105         381 $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         128 push @{$elem->{types}{$type}{$metric}}, $e;
  107         337  
2000             }
2001 68         114 delete $mv->{graph};
2002             }
2003             }
2004 19         39 my %externaggr;
2005 19         43 $index = 0;
2006 19         61 foreach my $rid (sort keys %ridnets) {
2007 38         60 my $rv = $ridnets{$rid};
2008 38         167 my $netaggr = join('\n', sort _cmp_ip_net keys %$rv);
2009 38         79 my $elem = $externaggr{$netaggr};
2010 38 100       73 if (! $elem) {
2011 32         87 $externaggr{$netaggr} = $elem = {};
2012             $elem->{graph} = {
2013 32         171 N => "externalaggregate$index",
2014             label => $netaggr,
2015             shape => "egg",
2016             style => "solid",
2017             };
2018 32         85 $elem->{index} = $index++;
2019             }
2020 38         114 foreach my $nid (sort keys %$rv) {
2021 105         134 my $nv = $rv->{$nid};
2022 105         163 my $colors = $nv->{colors};
2023 105 100 33     373 if (! $elem->{colors}) {
    50 33        
2024 32         81 %{$elem->{colors}} = %$colors;
  32         83  
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         119 foreach my $type (sort keys %{$nv->{types}}) {
  105         239  
2032 105         122 my $tv = $nv->{types}{$type};
2033 105         193 foreach my $metric (sort keys %$tv) {
2034 105         115 my $es = $tv->{$metric};
2035 105         98 push @{$elem->{routers}{$rid}{$type}{$metric}}, @$es;
  105         349  
2036             }
2037             }
2038             }
2039             }
2040 19         161 $self->{externaggr} = \%externaggr;
2041             }
2042              
2043             # take hash containing external aggregated nodes
2044             # return list of nodes
2045             sub externaggr2nodes {
2046 19     19 0 34 my OSPF::LSDB::View $self = shift;
2047 19 50       54 my $externaggr = $self->{externaggr} or die "Uninitialized member";
2048 19         56 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 28 my OSPF::LSDB::View $self = shift;
2055 19 50       63 my $externaggr = $self->{externaggr} or die "Uninitialized member";
2056 19         30 my @elements;
2057 19         31 my $index = 0;
2058 19         143 foreach my $netaggr (sort keys %$externaggr) {
2059 32         55 my $nv = $externaggr->{$netaggr};
2060 32         61 my $src = $nv->{graph}{N};
2061 32         30 my %dtm;
2062 32         43 foreach my $rid (sort keys %{$nv->{routers}}) {
  32         132  
2063 38         62 my $rv = $nv->{routers}{$rid};
2064 38         140 foreach my $type (sort keys %$rv) {
2065 38         54 my $tv = $rv->{$type};
2066 38         78 foreach my $metric (sort keys %$tv) {
2067 40         52 my $es = $tv->{$metric};
2068 40         59 foreach my $e (@$es) {
2069 107         113 foreach my $dst (sort keys %{$e->{elems}}) {
  107         237  
2070 111         125 my $elem = $e->{elems}{$dst};
2071 111         106 my %graph = %{$elem->{graph}};
  111         385  
2072 111         144 $graph{S} = $src;
2073 111         128 delete $graph{taillabel};
2074 111         106 my %colors = %{$elem->{colors}};
  111         215  
2075 111         233 my $newelem = {
2076             graph => \%graph,
2077             colors => \%colors,
2078             index => $index++,
2079             };
2080             # no not aggregate graphs with errors
2081 111 100       191 if (grep { ! /^(gray|black)$/ } keys %colors) {
  115         390  
2082 4         12 push @elements, $newelem;
2083             } else {
2084 107         307 $dtm{$dst}{$type}{$metric} = $newelem;
2085             }
2086             }
2087             }
2088             }
2089             }
2090             }
2091 32         109 push @elements, map { values %$_ } map { values %$_ } values %dtm;
  35         110  
  35         74  
2092             }
2093 19         133 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 36 my OSPF::LSDB::View $self = shift;
2100 24         48 my($type) = @_;
2101 24 50       74 my $cluster = $self->{$type."cluster"} or die "Uninitialized member";
2102 24         86 while (my($id,$graphlist) = each %$cluster) {
2103 98 100       202 next if @$graphlist < 2;
2104 24         32 foreach (@$graphlist) {
2105 55         106 $_->{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 296 my $class = shift;
2114 199         401 my @nodes = @_;
2115 199         321 my $dot = "";
2116 199         475 foreach (@nodes) {
2117 858         1129 my $cluster = $_->{C};
2118 858         947 $dot .= "\t";
2119 858 100       1134 $dot .= "subgraph \"cluster $cluster\" { " if $cluster;
2120 858         1212 $dot .= "$_->{N} [\n";
2121 858         2632 foreach my $k (sort keys %$_) {
2122 5254 100 100     10072 next if $k eq 'C' || $k eq 'N';
2123 4341         4540 my $v = $_->{$k};
2124 4341         6259 $dot .= "\t\t$k=\"$v\"\n";
2125             }
2126 858         1395 $dot .= "\t]";
2127 858 100       1094 $dot .= " }" if $cluster;
2128 858         945 $dot .= ";\n";
2129             }
2130 199         589 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 2704 my OSPF::LSDB::View $self = shift;
2137 2565         3124 my @elements = sort { $a->{index} <=> $b->{index} } grep { $_->{graph} } @_;
  1577         2304  
  2425         3981  
2138 2565         2966 foreach my $elem (@elements) {
2139 1990         2191 my $graph = $elem->{graph};
2140 1990         2857 my $color = $self->colors2string($elem->{colors});
2141 1990         2631 my $message = $elem->{colors}{$color};
2142 1990         2658 $graph->{color} = $color;
2143 1990         2337 $graph->{tooltip} = $message;
2144 1990 100       3152 if ($self->{todo}{warning}) {
2145 1478 100       1825 if ($graph->{label}) {
2146 707         1169 $graph->{label} .= '\n';
2147             } else {
2148 771         1231 $graph->{label} = "";
2149             }
2150 1478 50       2024 if ($self->{todo}{warning}{all}) {
2151 0         0 $graph->{label} .= join('\n', values %{$elem->{colors}});
  0         0  
2152             } else {
2153 1478         2436 $graph->{label} .= $message;
2154             }
2155             }
2156             }
2157 2565 50       3637 return map { $_->{graph} || () } @elements;
  1990         4280  
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 253 my $class = shift;
2164 189         394 my @edges = @_;
2165 189         310 my $dot = "";
2166 189         402 foreach (@edges) {
2167 1234         2137 $dot .= "\t$_->{S} -> $_->{D} [\n";
2168 1234         3782 foreach my $k (sort keys %$_) {
2169 8539 100 100     16046 next if $k eq 'S' || $k eq 'D';
2170 6071         6388 my $v = $_->{$k};
2171 6071         8148 $dot .= "\t\t$k=\"$v\"\n";
2172             }
2173 1234         1650 $dot .= "\t];\n";
2174             }
2175 189         1607 return $dot;
2176             }
2177              
2178             # take lsdb structure, router id, todo hash
2179             # return dot graph
2180             sub graph_database {
2181 183     183 0 349 my OSPF::LSDB::View $self = shift;
2182 183         364 my $todo = $self->{todo};
2183              
2184             # convert ospf structure into separate hashes and create cluster hashes
2185 183         289 my $netindex = 0;
2186 183         827 $self->create_network(\$netindex);
2187 183 100       668 if ($todo->{intra}) {
2188 4 50       11 $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         669 $self->add_missing_network(\$netindex);
2193 183         315 my $routeindex = 0;
2194 183         772 $self->create_router(\$routeindex);
2195 183 100       489 if ($todo->{link}) {
2196 2 50       5 $self->create_link() if $self->ipv6;
2197             }
2198 183 100       522 if ($todo->{intra}) {
2199 4 50       9 $self->create_intrarouters() if $self->ipv6;
2200             }
2201 183 100       1014 $self->create_summary() if $todo->{summary};
2202 183 100       860 $self->create_boundary() if $todo->{boundary};
2203 183 100       912 $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         622 $self->add_missing_router(\$routeindex);
2208              
2209 183         359 my %netcluster;
2210             my %transitcluster;
2211 183         688 $self->check_network(\%netcluster);
2212 183         609 $self->check_router();
2213 183         773 $self->check_transit(\%transitcluster);
2214 183 100       562 $self->check_stub(\%netcluster) unless $self->ipv6;
2215 183 100       576 if ($todo->{link}) {
2216 2 50       4 $self->check_link() if $self->ipv6;
2217             }
2218 183 100       487 if ($todo->{intra}) {
2219 4 50       9 $self->check_intrarouter() if $self->ipv6;
2220 4 50       11 $self->check_intranetwork() if $self->ipv6;
2221             }
2222 183 100       796 $self->check_summary(\%netcluster) if $todo->{summary};
2223 183 100       766 $self->check_boundary() if $todo->{boundary};
2224 183 100       740 $self->check_external(\%netcluster) if $todo->{external};
2225 183         381 $self->{netcluster} = \%netcluster;
2226 183         349 $self->{transitcluster} = \%transitcluster;
2227              
2228             # remove duplicate router may delete graphs from boundhash
2229             # must be called after check_boundary
2230 183         909 $self->remove_duplicate_router();
2231              
2232             # insert cluster with more than one entry into graphs
2233 183 100       472 if ($todo->{cluster}) {
2234 12         68 $self->set_cluster("net");
2235 12         31 $self->set_cluster("transit");
2236             }
2237              
2238             # graphs within clusters are not aggregated
2239             $self->create_sumaggr()
2240 183 100 100     941 if $todo->{summary} && $todo->{summary}{aggregate};
2241             $self->create_boundaggr()
2242 183 100 100     859 if $todo->{boundary} && $todo->{boundary}{aggregate};
2243             $self->create_externaggr()
2244 183 100 100     868 if $todo->{external} && $todo->{external}{aggregate};
2245              
2246 183         278 my @nodes;
2247 183         455 push @nodes, $self->router2nodes();
2248 183         703 push @nodes, $self->transit2nodes();
2249 183 100       498 push @nodes, $self->stub2nodes() unless $self->ipv6;
2250 183         609 push @nodes, $self->network2nodes();
2251 183 100       446 if ($todo->{link}) {
2252 2 50       6 push @nodes, $self->link2nodes() if $self->ipv6;
2253             }
2254 183 100       458 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       433 if ($todo->{summary}) {
2259 144         530 push @nodes, $self->summary2nodes();
2260             push @nodes, $self->sumaggr2nodes()
2261 144 100       418 if $todo->{summary}{aggregate};
2262             }
2263 183 100       441 if ($todo->{boundary}) {
2264 151         442 push @nodes, $self->boundary2nodes();
2265             push @nodes, $self->boundaggr2nodes()
2266 151 100       553 if $todo->{boundary}{aggregate};
2267             }
2268 183 100       424 if ($todo->{external}) {
2269 151         441 push @nodes, $self->external2nodes();
2270             push @nodes, $self->externaggr2nodes()
2271 151 100       420 if $todo->{external}{aggregate};
2272             }
2273 183         585 my $dot = $self->graph_nodes(@nodes);
2274              
2275 183         262 my @edges;
2276 183         572 push @edges, $self->router2edges("pointtopoint");
2277 183         548 push @edges, $self->transit2edges();
2278 183 100       561 push @edges, $self->stub2edges() unless $self->ipv6;
2279 183         472 push @edges, $self->router2edges("virtual");
2280 183         545 push @edges, $self->network2edges();
2281 183 100       540 if ($todo->{link}) {
2282 2 50       5 push @edges, $self->link2edges() if $self->ipv6;
2283             }
2284 183 100       484 if ($todo->{intra}) {
2285 4 50       10 push @edges, $self->intrarouter2edges() if $self->ipv6;
2286 4 50       12 push @edges, $self->intranetwork2edges() if $self->ipv6;
2287             }
2288 183 100       431 if ($todo->{summary}) {
2289 144         456 push @edges, $self->summary2edges();
2290             push @edges, $self->sumaggr2edges()
2291 144 100       527 if $todo->{summary}{aggregate};
2292             }
2293 183 100       417 if ($todo->{boundary}) {
2294 151         569 push @edges, $self->boundary2edges();
2295             push @edges, $self->boundaggr2edges()
2296 151 100       442 if $todo->{boundary}{aggregate};
2297             }
2298 183 100       391 if ($todo->{external}) {
2299 151         593 push @edges, $self->external2edges();
2300             push @edges, $self->externaggr2edges()
2301 151 100       523 if $todo->{external}{aggregate};
2302             }
2303 183         526 $dot .= $self->graph_edges(@edges);
2304              
2305 183         1655 return $dot;
2306             }
2307              
2308             # return dot default settings
2309             sub graph_default {
2310 185     185 0 345 my $class = shift;
2311 185         359 my $dot = "";
2312 185         422 $dot .= "\tnode [ color=gray50 fontsize=14 ];\n";
2313 185         353 $dot .= "\tedge [ color=gray50 fontsize=8 ];\n";
2314 185         420 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 1533 my OSPF::LSDB::View $self = shift;
2369 183         321 %{$self->{todo}} = @_;
  183         703  
2370 183         827 $self->create_area_grays();
2371 183         456 my $dot = "digraph \"ospf lsdb\" {\n";
2372 183         529 $dot .= $self->graph_default();
2373 183         755 $dot .= $self->graph_database();
2374 183         401 $dot .= "}\n";
2375 183         586 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         9 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     16 $_->{shape} ||= 'box';
2399 4   100     8 $_->{style} ||= 'solid';
2400             }
2401              
2402 1         2 my $dot = "";
2403 1         5 $dot .= $class->graph_nodes(@nodes);
2404 1         3 $dot .= "\t{ rank=same;";
2405 1         4 $dot .= join("", map { " $_->{N};" } @nodes);
  4         8  
2406 1         2 $dot .= " }\n";
2407 1         4 return $dot;
2408             }
2409              
2410             # return legend networks as dot graph
2411             sub legend_network {
2412 1     1 0 4 my $class = shift;
2413 1         3 my $index = 0;
2414 1         7 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         8 $_->{N} = 'network'. $index++;
2431 4   100     255 $_->{shape} ||= 'ellipse';
2432 4   100     10 $_->{style} ||= 'solid';
2433             }
2434              
2435 1         1 my $dot = "";
2436 1         4 $dot .= $class->graph_nodes(@nodes);
2437 1         3 $dot .= "\t{ rank=same;";
2438 1         3 $dot .= join("", map { " $_->{N};" } @nodes);
  4         9  
2439 1         3 $dot .= " }\n";
2440 1         4 return $dot;
2441             }
2442              
2443             # return legend router network edges as dot graph
2444             sub legend_edge {
2445 1     1 0 3 my $class = shift;
2446 1         8 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     11 $_->{shape} ||= 'ellipse';
2464 4   100     9 $_->{style} ||= 'solid';
2465             }
2466              
2467 1         5 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     11 $_->{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         6 $networknodes[$i]{N} = 'edgenetwork'. $index;
2506 4         7 $routernodes [$i]{N} = 'edgerouter'. $index;
2507 4         7 $edges [$i]{S} = 'edgenetwork'. $index;
2508 4         7 $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         3 my $dot = "";
2515 1         3 $dot .= $class->graph_nodes(@networknodes);
2516 1         3 $dot .= $class->graph_nodes(@routernodes);
2517 1         5 $dot .= $class->graph_edges(@edges);
2518 1         3 $dot .= "\t{ rank=same;";
2519 1         4 $dot .= join("", map { " $_->{S};" } @edges);
  4         8  
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 2 my $class = shift;
2527 1         5 my @routernodes = (
2528             {}, {}, {
2529             label => 'designated\nrouter',
2530             }, {}, {},
2531             );
2532 1         4 foreach (@routernodes) {
2533 5   100     15 $_->{label} ||= 'router';
2534 5   50     13 $_->{shape} ||= 'box';
2535 5   50     13 $_->{style} ||= 'solid';
2536             }
2537              
2538 1         7 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     16 $_->{shape} ||= 'box';
      100        
2556 5   100     10 $_->{style} ||= 'solid';
2557             }
2558              
2559 1         3 my $index = 0;
2560 1         5 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         4 foreach (@edges) {
2576 5   100     11 $_->{style} ||= 'solid';
2577             }
2578 1         5 for(my $i=0; $i<@edges; $i++) {
2579 5         7 $routernodes[$i]{N} = 'linkrouter'. $index;
2580 5         10 $dstnodes [$i]{N} = 'linkdst'. $index;
2581 5         8 $edges [$i]{S} = 'linkrouter'. $index;
2582 5         6 $edges [$i]{D} = 'linkdst'. $index;
2583 5         8 $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         5 $dot .= $class->graph_edges(@edges);
2590 1         3 $dot .= "\t{ rank=same;";
2591 1         4 $dot .= join("", map { " $_->{S};" } @edges);
  5         9  
2592 1         2 $dot .= " }\n";
2593 1         10 return $dot;
2594             }
2595              
2596             # return legend summary network and router edges as dot graph
2597             sub legend_summary {
2598 1     1 0 2 my $class = shift;
2599 1         9 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     10 $_->{shape} ||= 'ellipse';
2618 4   100     9 $_->{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         2 foreach (@routernodes) {
2631 4   100     12 $_->{label} ||= 'area border\nrouter';
2632 4   50     11 $_->{shape} ||= 'box';
2633 4   100     11 $_->{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         5 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         7 $edges [$i]{S} = 'summarynetwork'. $index;
2660 4         8 $edges [$i]{D} = 'summaryrouter'. $index;
2661 4         6 $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         4 $dot .= $class->graph_edges(@edges);
2668 1         4 $dot .= "\t{ rank=same;";
2669 1         2 $dot .= join("", map { " $_->{S};" } @edges);
  4         9  
2670 1         2 $dot .= " }\n";
2671 1         11 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 5 my $class = shift;
2677 2         5 my $dot = "";
2678 2         4 $dot .= "\trouter0 -> network0 -> edgerouter0";
2679 2         5 $dot .= " [ style=invis ];\n";
2680 2         4 $dot .= "\tedgenetwork0 -> linkrouter0";
2681 2         5 $dot .= " [ style=invis ];\n";
2682 2         5 $dot .= "\tlinkdst0 -> summarynetwork0";
2683 2         12 $dot .= " [ style=invis ];\n";
2684 2         7 return $dot;
2685             }
2686              
2687             # return legend default settings
2688             sub legend_default {
2689 2     2 0 4 my $class = shift;
2690 2         5 my $dot = "";
2691 2         13 $dot .= $class->graph_default();
2692 2         5 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 4401 my $class = shift;
2709 2         6 my $dot = "digraph \"ospf legend\" {\n";
2710 2         11 $dot .= $class->legend_default();
2711 2         11 $dot .= $class->legend_rank();
2712 2         12 $dot .= $class->legend_router();
2713 2         10 $dot .= $class->legend_network();
2714 2         9 $dot .= $class->legend_edge();
2715 2         11 $dot .= $class->legend_link();
2716 2         10 $dot .= $class->legend_summary();
2717 2         5 $dot .= "}\n";
2718 2         10 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;