File Coverage

blib/lib/OSPF/LSDB/ospf6d.pm
Criterion Covered Total %
statement 245 247 99.1
branch 230 236 97.4
condition 9 9 100.0
subroutine 17 17 100.0
pod 2 10 20.0
total 503 519 96.9


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 11     11   464308 use strict;
  11         80  
  11         265  
18 11     11   53 use warnings;
  11         17  
  11         424  
19              
20             =pod
21              
22             =head1 NAME
23              
24             OSPF::LSDB::ospf6d - parse OpenBSD B link state database
25              
26             =head1 SYNOPSIS
27              
28             use OSPF::LSDB::ospf6d;
29              
30             my $ospf6d = OSPF::LSDB::ospf6d-Enew();
31              
32             my $ospf6d = OSPF::LSDB::ospf6d-Enew(ssh => "user@host");
33              
34             $ospf6d-Eparse(%files);
35              
36             =head1 DESCRIPTION
37              
38             The OSPF::LSDB::ospf6d module parses the output of OpenBSD
39             B and fills the L base object.
40             The output of
41             C,
42             C,
43             C,
44             C,
45             C,
46             C
47             C
48             C
49             is needed.
50             It can be given as separate files or obtained dynamically.
51             In the latter case B is invoked if permissions are not
52             sufficient to run B.
53             If the object has been created with the C argument, the specified
54             user and host are used to login and run B there.
55              
56             There is only one public method:
57              
58             =cut
59              
60             package OSPF::LSDB::ospf6d;
61 11     11   50 use base 'OSPF::LSDB::ospfd';
  11         14  
  11         3204  
62 11     11   78 use File::Slurp;
  11         19  
  11         729  
63 11     11   66 use Regexp::Common;
  11         21  
  11         73  
64 11     11   10312 use Regexp::IPv6;
  11         7593  
  11         499  
65 11         137 use fields qw(
66             link intra
67 11     11   61 );
  11         20  
68              
69             sub new {
70 8     8 1 696 my OSPF::LSDB::ospf6d $self = OSPF::LSDB::ospfd::new(@_);
71 8         25 $self->{ospfd} = "ospf6d";
72 8         19 $self->{ospfctl} = "ospf6ctl";
73             # XXX hard coded routing domain 0
74 8         19 $self->{ospfsock} = "/var/run/ospf6d.sock.0";
75 8         13 %{$self->{showdb}} = (%{$self->{showdb}}, (
  8         40  
  8         31  
76             link => "link",
77             intra => "intra",
78             ));
79 8         27 return $self;
80             }
81              
82             # shortcut
83             my $IP = qr/$RE{net}{IPv4}{-keep}/;
84             my $IP6 = qr/($Regexp::IPv6::IPv6_re|::)/;
85             my $PREFIX = qr,($Regexp::IPv6::IPv6_re|::)/$RE{num}{int}{-keep},;
86              
87             sub parse_router {
88 16     16 0 12969 my OSPF::LSDB::ospf6d $self = shift;
89 16         41 my($area, $router, $link) = ("", "", "");
90 16         35 my(@routers, $lnum, $type, $r, $l);
91 16         18 foreach (@{$self->{router}}) {
  16         34  
92 327 100 100     20893 if (/^ +Router Link States \(Area $IP\)$/) {
    100 100        
    100          
    100          
93 18 100       49 die "$_ Link $link of router $router in area $area not finished.\n"
94             if $l;
95 17 100       35 die "$_ Too few links at router $router in area $area.\n" if $lnum;
96 16 100       31 die "$_ Router $router in area $area not finished.\n" if $r;
97 15         29 $area = $1;
98 15         23 next;
99             } elsif (/^$/) {
100 62 100       116 if ($l) {
101 14 100       37 die "Link $link of router $router in area $area without type.\n"
102             if ! $type;
103 13         14 push @{$r->{$type.'s'}}, $l;
  13         36  
104 13         18 undef $type;
105 13         16 undef $l;
106             }
107 61 100       89 if (! $lnum) {
108 41         46 undef $r;
109             }
110 61         104 next;
111             } elsif (! $r && /^\w/) {
112 21 100       43 die "$_ No area for router defined.\n" if ! $area;
113 20         25 $router = "";
114 20         43 $r = { area => $area };
115 20         32 push @routers, $r;
116             } elsif (! $l && /^ {4}\w/) {
117 19 100       50 die "$_ Too many links at router $router in area $area.\n"
118             if ! $lnum;
119 18         82 $lnum--;
120 18         24 $link = "";
121 18         24 $l = {};
122             }
123 245 100       773 if (/^LS age: $RE{num}{int}{-keep}$/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
124 20         2441 $r->{age} = $1;
125             } elsif (/^LS Type: ([\w ()]+)$/) {
126 20 100       1965 die "$_ Type of router-LSA is $1 and not Router in area $area.\n"
127             if $1 ne "Router";
128             } elsif (/^Link State ID: $IP$/) {
129 19         2101 $r->{router} = $1;
130             } elsif (/^Advertising Router: $IP$/) {
131 19         2040 $r->{routerid} = $1;
132 19         105 $router = $1;
133             } elsif (/^LS Seq Number: (0x$RE{num}{hex})$/) {
134 19         4084 $r->{sequence} = $1;
135             } elsif (/^Flags: ([-*|\w]*)$/) {
136 16         2900 my $flags = $1;
137 16         29 foreach (qw(W V E B)) {
138 64 100       570 $r->{bits}{$_} = $flags =~ /\b$_\b/ ? 1 : 0;
139             }
140             } elsif (/^Number of Links: $RE{num}{int}{-keep}$/) {
141 16         4343 $lnum = $1;
142             } elsif (/^ Link \([ .\w]*\) connected to: ([\w -]+)$/) {
143 17 50       4725 if ($1 eq "Point-to-Point") {
    100          
    50          
144 0         0 $type = "pointtopoint";
145             } elsif ($1 eq "Transit Network") {
146 16         26 $type = "transit";
147             } elsif ($1 eq "Virtual Link") {
148 0         0 $type = "virtual";
149             } else {
150 1         10 die "$_ Unknown link type $1 at router $router ".
151             "in area $area.\n";
152             }
153 16 50       273 if (/\(Interface ID $IP\)/) {
154 16         176 $l->{interface} = $1;
155             }
156             } elsif (/^ (?:Designated )?Router ID: $IP$/) {
157 17         4764 $l->{routerid} = $1;
158 17         162 $link = $1;
159             } elsif (/^ (?:DR )?Interface ID: $IP$/) {
160 17         4656 $l->{address} = $1;
161 17         165 $link = "$1\@$link";
162             } elsif (/^ Metric: $RE{num}{int}{-keep}$/) {
163 14         5542 $l->{metric} = $1;
164             } elsif (/^ {4}\w/) {
165 1         396 die "$_ Unknown line at link $link of router $router ".
166             "in area $area.\n";
167             } elsif (! /^(Options|Checksum|Length):/) {
168 1         375 die "$_ Unknown line at router $router in area $area.\n";
169             }
170             }
171 6 100       22 die "Link $link of router $router in area $area not finished.\n" if $l;
172 5 100       22 die "Too few links at router $router in area $area.\n" if $lnum;
173 4 100       20 die "Router $router in area $area not finished.\n" if $r;
174 3         59 $self->{ospf}{database}{routers} = \@routers;
175             }
176              
177             sub parse_network {
178 11     11 0 8770 my OSPF::LSDB::ospf6d $self = shift;
179 11         37 my($area, $network) = ("", "");
180 11         21 my(@networks, $attachments, $rnum, $n);
181 11         13 foreach (@{$self->{network}}) {
  11         25  
182 122 100       6456 if (/^ +Net Link States \(Area $IP\)$/) {
    100          
    100          
183 12 100       37 die "$_ Attached routers of network $network in area $area ".
184             "not finished.\n" if $attachments;
185 11 100       28 die "$_ Network $network in area $area not finished.\n" if $n;
186 10         40 $area = $1;
187 10         16 next;
188             } elsif (/^$/) {
189 26 100       58 die "$_ Too few attached routers at network $network ".
190             "in area $area.\n" if $rnum;
191 25         28 undef $attachments;
192 25         25 undef $n;
193 25         45 next;
194             } elsif (! $n) {
195 11 100       29 die "$_ No area for network defined.\n" if ! $area;
196 10         15 $network = "";
197 10         21 $n = { area => $area };
198 10         28 push @networks, $n;
199             }
200 83 100       275 if (/^LS age: $RE{num}{int}{-keep}$/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
201 10         1274 $n->{age} = $1;
202             } elsif (/^LS Type: ([\w ()]+)$/) {
203 10 100       1000 die "$_ Type of network-LSA is $1 and not Network in area $area.\n"
204             if $1 ne "Network";
205             } elsif (/^Link State ID: $IP \(Interface ID of Designated Router\)$/) {
206 9         1073 $n->{address} = $1;
207 9         53 $network = $1;
208             } elsif (/^Advertising Router: $IP$/) {
209 9         1042 $n->{routerid} = $1;
210 9         61 $network .= "\@$1";
211             } elsif (/^LS Seq Number: (0x$RE{num}{hex})$/) {
212 9         2067 $n->{sequence} = $1;
213             } elsif (/^Number of Routers: $RE{num}{int}{-keep}$/) {
214 6         1644 $rnum = $1;
215             } elsif (/^ Attached Router: $IP$/) {
216 10 100       2729 if (! $attachments) {
217 6         12 $attachments = [];
218 6         13 $n->{attachments} = $attachments;
219             }
220 10 50       26 $rnum-- if defined $rnum ;
221 10         111 push @$attachments, { routerid => $1 };
222             } elsif (! /^(Options|Checksum|Length):/) {
223 1         279 die "$_ Unknown line at network $network in area $area.\n";
224             }
225             }
226 5 100       23 die "Attached routers of network $network in area $area not finished.\n"
227             if $attachments;
228 4 100       17 die "Network $network in area $area not finished.\n" if $n;
229 3         17 $self->{ospf}{database}{networks} = \@networks;
230             }
231              
232             sub parse_summary {
233 2     2 0 4 my OSPF::LSDB::ospf6d $self = shift;
234             # XXX not yet
235 2         6 $self->{ospf}{database}{summarys} = [];
236             }
237              
238             sub parse_boundary {
239 2     2 0 5 my OSPF::LSDB::ospf6d $self = shift;
240             # XXX not yet
241 2         4 $self->{ospf}{database}{boundarys} = [];
242             }
243              
244             sub parse_external {
245 8     8 0 4219 my OSPF::LSDB::ospf6d $self = shift;
246 8         14 my $external = "";
247 8         11 my(@externals, $e);
248 8         12 foreach (@{$self->{external}}) {
  8         19  
249 331 100       24560 if (/^ +Type-5 AS External Link States$/) {
    100          
    100          
250 10 100       26 die "$_ External $external not finished.\n" if $e;
251 9 100       21 die "$_ Too many external sections.\n", if @externals;
252 8         10 next;
253             } elsif (/^$/) {
254 42         50 undef $e;
255 42         74 next;
256             } elsif (! $e) {
257 30         41 $external = "";
258 30         46 $e = {};
259 30         84 push @externals, $e;
260             }
261 279 100       776 if (/^LS age: $RE{num}{int}{-keep}$/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
262 30         3106 $e->{age} = $1;
263             } elsif (/^LS Type: ([\w ()]+)$/) {
264 30 100       2834 die "$_ Type of external-LSA is $1 and not AS External.\n"
265             if $1 ne "AS External";
266             } elsif (/^Link State ID: $IP$/) {
267 29         2877 $e->{address} = $1;
268 29         145 $external = $1;
269             } elsif (/^Advertising Router: $IP$/) {
270 29         2928 $e->{routerid} = $1;
271 29         152 $external .= "\@$1";
272             } elsif (/^LS Seq Number: (0x$RE{num}{hex})$/) {
273 29         5618 $e->{sequence} = $1;
274             } elsif (/^ Metric: $RE{num}{int}{-keep} Type: ([1-2])$/) {
275 26         7021 $e->{metric} = $1;
276 26         278 $e->{type} = $4;
277             } elsif (/^ Prefix: $PREFIX$/) {
278 26         7208 $e->{prefixaddress} = $1;
279 26         287 $e->{prefixlength} = $2;
280             } elsif (! /^(Checksum|Length| Flags):/) {
281 1         272 die "$_ Unknown line at external $external.\n";
282             }
283             }
284 4 100       17 die "External $external not finished.\n" if $e;
285 3         16 $self->{ospf}{database}{externals} = \@externals;
286             }
287              
288             sub parse_link {
289 11     11 0 10417 my OSPF::LSDB::ospf6d $self = shift;
290 11         32 my($area, $link) = ("", "");
291 11         22 my(@links, $prefixes, $pnum, $l);
292 11         18 foreach (@{$self->{link}}) {
  11         36  
293 397 100       26036 if (/^ +Link \(Type-8\) Link States \(Area $IP Interface \w+\)$/) {
    100          
    100          
294 19 100       71 die "$_ Prefixes of link $link in area $area not finished.\n"
295             if $prefixes;
296 18 100       51 die "$_ Link $link in area $area not finished.\n" if $l;
297 17         42 $area = $1;
298 17         32 next;
299             } elsif (/^$/) {
300 59 100       145 die "$_ Too few prefixes at link $link in area $area.\n" if $pnum;
301 58         79 undef $prefixes;
302 58         66 undef $l;
303 58         109 next;
304             } elsif (! $l) {
305 30 100       82 die "$_ No area for link defined.\n" if ! $area;
306 29         46 $link = "";
307 29         71 $l = { area => $area };
308 29         68 push @links, $l;
309             }
310 318 100       979 if (/^LS age: $RE{num}{int}{-keep}$/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
311 29         3341 $l->{age} = $1;
312             } elsif (/^LS Type: ([\w ()]+)$/) {
313 29 100       3196 die "$_ Type of link-LSA is $1 and not Link in area $area.\n"
314             if $1 ne "Link";
315             } elsif (/^Link State ID: $IP \(Interface ID of Advertising Router\)$/) {
316 28         2983 $l->{interface} = $1;
317 28         151 $link = $1;
318             } elsif (/^Advertising Router: $IP$/) {
319 28         3051 $l->{routerid} = $1;
320 28         167 $link .= "\@$1";
321             } elsif (/^LS Seq Number: (0x$RE{num}{hex})$/) {
322 28         5777 $l->{sequence} = $1;
323             } elsif (/^Link Local Address: ($IP6)$/) {
324 25         4886 $l->{linklocal} = $1;
325             } elsif (/^Number of Prefixes: $RE{num}{int}{-keep}$/) {
326 25         6946 $pnum = $1;
327             } elsif (/^ Prefix: $PREFIX$/) {
328 49 100       13631 if (! $prefixes) {
329 10         25 $prefixes = [];
330 10         66 $l->{prefixes} = $prefixes;
331             }
332 49 50       101 $pnum-- if defined $pnum ;
333 49         571 push @$prefixes, { prefixaddress => $1, prefixlength => $2 };
334             } elsif (! /^(Options|Checksum|Length):/) {
335 1         339 die "$_ Unknown line at link $link in area $area.\n";
336             }
337             }
338 5 100       34 die "Prefixes of link $link in area $area not finished.\n" if $prefixes;
339 4 100       26 die "Link $link in area $area not finished.\n" if $l;
340 3         20 $self->{ospf}{database}{links} = \@links;
341             }
342              
343             sub parse_intra {
344 14     14 0 13594 my OSPF::LSDB::ospf6d $self = shift;
345 14         29 my($area, $intra) = ("", "");
346 14         24 my(@intranetworks, @intrarouters, $type, $prefixes, $pnum, $i);
347 14         18 foreach (@{$self->{intra}}) {
  14         29  
348 435 100       24342 if (/^ +Intra Area Prefix Link States \(Area $IP\)$/) {
    100          
    100          
349 15 100       41 die "$_ Prefixes of intra-area-prefix $intra in area $area ".
350             "not finished.\n" if $prefixes;
351 14 100       28 die "$_ Intra-area-prefix $intra in area $area not finished.\n"
352             if $i;
353 13         27 $area = $1;
354 13         20 next;
355             } elsif (/^$/) {
356 50 100       94 die "$_ Too few prefixes at intra-area-prefix $intra ".
357             "in area $area.\n" if $pnum;
358 49 100 100     122 die "$_ Intra-area-prefix $intra in area $area has no ".
359             "referenced LS type.\n" if $i && ! $type;
360 48         55 undef $type;
361 48         50 undef $prefixes;
362 48         49 undef $i;
363 48         77 next;
364             } elsif (! $i) {
365 31 100       56 die "$_ No area for intra-area-prefix defined.\n" if ! $area;
366 30         37 $intra = "";
367 30         50 $i = { area => $area };
368             }
369 369 100       1127 if (/^LS age: $RE{num}{int}{-keep}$/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
370 30         3370 $i->{age} = $1;
371             } elsif (/^LS Type: ([\w ()]+)$/) {
372 30 100       3021 die "$_ Type of intra-area-prefix-LSA is $1 and not Intra Area ".
373             "(Prefix) in area $area.\n" if $1 ne "Intra Area (Prefix)";
374             } elsif (/^Link State ID: $IP$/) {
375 29         2922 $i->{address} = $1;
376 29         169 $intra = $1;
377             } elsif (/^Advertising Router: $IP$/) {
378 29         3163 $i->{routerid} = $1;
379 29         163 $intra .= "\@$1";
380             } elsif (/^LS Seq Number: (0x$RE{num}{hex})$/) {
381 29         5813 $i->{sequence} = $1;
382             } elsif (/^Referenced LS Type: (\w+)$/) {
383 26 100       4735 die "$_ Referenced LS type given more than once ".
384             "at intra-area-prefix $intra in area $area.\n" if $type;
385 25         48 $type = $1;
386 25 100       59 if ($type eq "Router") {
    100          
387 13         135 push @intrarouters, $i
388             } elsif ($type eq "Network") {
389 11         77 push @intranetworks, $i
390             } else {
391 1         9 die "$_ Unknown referenced LS type $type ".
392             "at intra-area-prefix $intra in area $area.\n";
393             }
394             } elsif (/^Referenced Link State ID: $IP$/) {
395 23         4362 $i->{interface} = $1;
396             } elsif (/^Referenced Advertising Router: $IP$/) {
397 23         4437 $i->{router} = $1;
398             } elsif (/^Number of Prefixes: $RE{num}{int}{-keep}$/) {
399 23         6441 $pnum = $1;
400             } elsif (/^ Prefix: $PREFIX(?: Options: \S+)?(?: Metric: $RE{num}{int}{-keep})?$/) {
401 73 100       26908 if (! $prefixes) {
402 20         29 $prefixes = [];
403 20         52 $i->{prefixes} = $prefixes;
404             }
405 73 50       125 $pnum-- if defined $pnum ;
406 73         222 my %pfx = (prefixaddress => $1, prefixlength => $2);
407 73 100       142 $pfx{metric} = $5 if defined $5;
408 73         864 push @$prefixes, \%pfx;
409             } elsif (! /^(Checksum|Length):/) {
410 1         395 die "$_ Unknown line at intra-area-prefix $intra in area $area.\n";
411             }
412             }
413 5 100       30 die "Prefixes of intra-area-prefix $intra in area $area not finished.\n"
414             if $prefixes;
415 4 100       27 die "Intra-area-prefix $intra in area $area not finished.\n" if $i;
416 3         15 $self->{ospf}{database}{intranetworks} = \@intranetworks;
417 3         17 $self->{ospf}{database}{intrarouters} = \@intrarouters;
418             }
419              
420             sub parse_lsdb {
421 2     2 0 6 my OSPF::LSDB::ospf6d $self = shift;
422 2         13 $self->SUPER::parse_lsdb(@_);
423 2         11 $self->parse_link();
424 2         9 $self->parse_intra();
425             }
426              
427             =pod
428              
429             =over 4
430              
431             =item $self-Eparse(%files)
432              
433             This function takes a hash with file names as value containing the
434             B output data.
435             The hash keys are named C, C, C, C,
436             C, C, C, C.
437             If a hash entry is missing, B is run instead to obtain the
438             information dynamically.
439              
440             The complete OSPF link state database is stored in the B field
441             of the base class.
442              
443             =back
444              
445             =cut
446              
447             sub parse {
448 2     2 1 12 my OSPF::LSDB::ospf6d $self = shift;
449 2         16 $self->SUPER::parse(@_);
450 2         8 $self->{ospf}{ipv6} = 1;
451             }
452              
453             =pod
454              
455             This module has been tested with OpenBSD 5.1.
456             If it works with other versions is unknown.
457              
458             =head1 ERRORS
459              
460             The methods die if any error occurs.
461              
462             =head1 SEE ALSO
463              
464             L,
465             L
466              
467             L
468              
469             =head1 AUTHORS
470              
471             Alexander Bluhm
472              
473             =cut
474              
475             1;