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