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