File Coverage

blib/lib/Net/BGP/NLRI.pm
Criterion Covered Total %
statement 129 139 92.8
branch 64 94 68.0
condition 5 6 83.3
subroutine 27 31 87.1
pod 0 14 0.0
total 225 284 79.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Net::BGP::NLRI;
4              
5 5     5   66489 use strict;
  5         23  
  5         141  
6 5     5   24 use Exporter;
  5         14  
  5         256  
7 5         472 use vars qw(
8             $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS @ORIGIN
9             @BGP_PATH_ATTR_COUNTS
10 5     5   26 );
  5         8  
11              
12             ## Inheritance and Versioning ##
13              
14             @ISA = qw( Exporter );
15             $VERSION = '0.17';
16              
17             ## Module Imports ##
18              
19 5     5   29 use Carp;
  5         9  
  5         295  
20 5     5   521 use IO::Socket;
  5         20681  
  5         28  
21             use overload
22             '<=>' => \&_compare,
23             '<' => \&_lessthen,
24             '>' => \&_greaterthen,
25             '==' => \&_equal,
26             '!=' => \&_notequal,
27             'eq' => \&_same,
28 3     3   19 'ne' => sub { return ! &_same(@_) },
29 5     5   5243 '""' => sub { return shift; }; # Do nothing! Use asstring instead!
  5     0   2141  
  5         78  
  0         0  
30 5     5   2094 use Net::BGP::ASPath;
  5         10  
  5         8231  
31              
32             ## BGP Path Attribute Count Vector ##
33              
34             @BGP_PATH_ATTR_COUNTS = ( 0, 0, 0, 0, 0, 0, 0, 0, 0 );
35              
36             ## BGP ORIGIN Path Attribute Type Enumerations ##
37              
38 21     21 0 161 sub IGP { 0 }
39 1     1 0 289 sub EGP { 1 }
40 0     0 0 0 sub INCOMPLETE { 2 }
41              
42             my @ORIGINSTR = (
43             'i', # IGP
44             'e', # EGP
45             '?' # INCOMPLETE
46             );
47              
48             ## Export Tag Definitions ##
49              
50             @ORIGIN = qw( IGP EGP INCOMPLETE );
51             @EXPORT = ();
52             @EXPORT_OK = ( @ORIGIN );
53             %EXPORT_TAGS = (
54             origin => [ @ORIGIN ],
55             ALL => [ @EXPORT, @EXPORT_OK ]
56             );
57              
58             ## Public Class Methods ##
59              
60             sub new
61             {
62 21     21 0 1094 my $class = shift();
63 21         39 my ($arg, $value);
64              
65 21         84 my $this = {
66             _as_path => Net::BGP::ASPath->new,
67             _origin => IGP,
68             _next_hop => undef,
69             _med => undef,
70             _local_pref => undef,
71             _atomic_agg => undef,
72             _aggregator => [],
73             _as4_aggregator => [],
74             _communities => [],
75             _attr_mask => [ @BGP_PATH_ATTR_COUNTS ]
76             };
77              
78 21         44 bless($this, $class);
79              
80 21         59 while ( defined($arg = shift()) ) {
81 10         24 $value = shift();
82              
83 10 100       54 if ( $arg =~ /aspath/i ) {
    100          
    100          
    100          
    100          
    100          
    100          
    50          
84 3 50       15 $this->{_as_path} = ref $value eq 'Net::BGP::ASPath' ? $value : Net::BGP::ASPath->new($value);
85             }
86             elsif ( $arg =~ /origin/i ) {
87 1         3 $this->{_origin} = $value;
88             }
89             elsif ( $arg =~ /nexthop/i ) {
90 1         3 $this->{_next_hop} = $value;
91             }
92             elsif ( $arg =~ /med/i ) {
93 1         3 $this->{_med} = $value;
94             }
95             elsif ( $arg =~ /localpref/i ) {
96 1         3 $this->{_local_pref} = $value;
97             }
98             elsif ( $arg =~ /atomicaggregate/i ) {
99 1         4 $this->{_atomic_agg} = $value;
100             }
101             elsif ( $arg =~ /aggregator/i ) {
102 1         37 $this->{_aggregator} = $value;
103             }
104             elsif ( $arg =~ /communities/i ) {
105 1         4 $this->{_communities} = $value;
106             }
107             else {
108 0         0 croak("unrecognized argument $arg\n");
109             }
110             }
111              
112 21         81 return ( $this );
113             }
114              
115             sub clone
116             {
117 9     9 0 643 my $proto = shift;
118 9   66     34 my $class = ref $proto || $proto;
119 9 100       23 $proto = shift unless ref $proto;
120              
121 9         15 my $clone = {};
122              
123 9         19 foreach my $key (qw(_origin _next_hop _med _local_pref _atomic_agg ))
124             {
125 45         85 $clone->{$key} = $proto->{$key};
126             }
127              
128 9         20 foreach my $key (qw(_aggregator _communities _attr_mask _as4_aggregator))
129             {
130 36         43 $clone->{$key} = [ @{$proto->{$key}}];
  36         88  
131             }
132              
133 9 50       37 $clone->{_as_path} = defined $proto->{_as_path} ? $proto->{_as_path}->clone : undef;
134              
135 9         21 return ( bless($clone, $class) );
136             }
137              
138             ## Public Object Methods ##
139              
140             sub aggregator
141             {
142 4     4 0 298 my $this = shift();
143              
144 4 100       12 $this->{_aggregator} = @_ ? shift() : $this->{_aggregator};
145 4         13 return ( $this->{_aggregator} );
146             }
147              
148             sub as_path
149             {
150 18     18 0 338 my $this = shift();
151              
152 18 50       58 $this->{_as_path} = @_ ? (ref $_[0] eq 'Net::BGP::ASPath' ? shift : Net::BGP::ASPath->new(shift)) : $this->{_as_path};
    100          
153 18         60 return $this->{_as_path};
154             }
155              
156             sub atomic_aggregate
157             {
158 3     3 0 6 my $this = shift();
159              
160 3 100       10 $this->{_atomic_agg} = @_ ? shift() : $this->{_atomic_agg};
161 3         8 return ( $this->{_atomic_agg} );
162             }
163              
164             sub communities
165             {
166 5     5 0 11 my $this = shift();
167              
168 5 100       13 $this->{_communities} = @_ ? shift() : $this->{_communities};
169 5         28 return ( $this->{_communities} );
170             }
171              
172             sub local_pref
173             {
174 3     3 0 6 my $this = shift();
175              
176 3 100       9 $this->{_local_pref} = @_ ? shift() : $this->{_local_pref};
177 3         9 return ( $this->{_local_pref} );
178             }
179              
180             sub med
181             {
182 3     3 0 7 my $this = shift();
183              
184 3 100       8 $this->{_med} = @_ ? shift() : $this->{_med};
185 3         9 return ( $this->{_med} );
186             }
187              
188             sub next_hop
189             {
190 3     3 0 5 my $this = shift();
191              
192 3 100       9 $this->{_next_hop} = @_ ? shift() : $this->{_next_hop};
193 3         9 return ( $this->{_next_hop} );
194             }
195              
196             sub origin
197             {
198 0     0 0 0 my $this = shift();
199              
200 0 0       0 $this->{_origin} = @_ ? shift() : $this->{_origin};
201 0         0 return ( $this->{_origin} );
202             }
203              
204             sub asstring
205             {
206 0     0 0 0 my $this = shift();
207 0 0       0 return join("\t", map { defined $_ ? $_ : 'n/a'; }
  0 0       0  
    0          
208             $this->next_hop, $this->med, $this->local_pref,
209             ((defined $this->as_path) ? $this->as_path : '') .
210             ' ' .
211             ((defined $this->origin) ? $ORIGINSTR[$this->origin] : 'n/a')
212             );
213             }
214              
215             ## Private Object Methods ##
216              
217             sub _same
218             {
219 6     6   16 my ($this,$other) = @_;
220              
221 6 50       16 return 0 unless defined $other;
222 6 50       34 return 0 unless $other->isa('Net::BGP::NLRI');
223              
224 6         13 my %union;
225 6         8 @{\%union}{keys %{$this}} = 1;
  6         28  
  6         32  
226 6         13 @{\%union}{keys %{$other}} = 1;
  6         13  
  6         17  
227 6         21 foreach my $key (keys %union)
228             {
229 50 100       102 return 0 unless $this->_same_field($other,$key);
230             };
231              
232 3         17 return 1;
233             }
234              
235             sub _same_field
236             {
237 50     50   83 my ($this,$other,$key) = @_;
238 50         69 my $x = $this->{$key};
239 50         64 my $y = $other->{$key};
240 50 50       91 return 0 if defined $x != defined $y;
241 50 50       91 return 0 if ref $x ne ref $y;
242 50 100       87 return 1 unless defined $x; # Both undefined - Equal!
243 36 100 100     129 if ((! ref $x)
    50          
244             || (ref $x eq 'Net::BGP::ASPath'))
245             {
246 14 100       50 return 0 unless $x eq $y;
247             }
248             elsif (ref $x eq 'ARRAY')
249             {
250 22 100       26 return 0 unless scalar @{$x} == scalar @{$y};
  22         36  
  22         49  
251 21         29 my @x = sort @{$x};
  21         77  
252 21         38 my @y = sort @{$y};
  21         51  
253 21         32 foreach my $i (0 .. (scalar @{$x} - 1))
  21         47  
254             {
255 56 50       111 return 0 unless $x[$i] eq $y[$i];
256             }
257             }
258             else
259             {
260 0         0 croak 'Object contains unknown value type (' . (ref $x) . ") in áttribute ($key) in comparison";
261             };
262 33         76 return 1;
263             }
264              
265             sub _equal
266             {
267 1     1   3 my ($this,$other) = @_;
268 1 50       4 return 0 unless defined($other);
269 1 50       3 return ($this->_compare($other) == 0) ? 1 : 0;
270             }
271              
272             sub _notequal
273             {
274 1     1   3 my ($this,$other) = @_;
275 1 50       4 return 1 unless defined($other);
276 1 50       3 return ($this->_compare($other) == 0) ? 0 : 1;
277             }
278              
279             sub _lessthen
280             {
281 1     1   4 my ($this,$other) = @_;
282 1 50       3 return ($this->_compare($other) == -1) ? 1 : 0;
283             }
284              
285             sub _greaterthen
286             {
287 1     1   4 my ($this,$other) = @_;
288 1 50       3 return ($this->_compare($other) == 1) ? 1 : 0;
289             }
290              
291             sub _ifundef
292             {
293 10     10   18 my ($this,$field,$default) = @_;
294 10 50       30 return defined($this->{$field}) ? $this->{$field} : $default;
295             }
296              
297             sub _compare
298             {
299 4     4   7 my ($this,$other) = @_;
300 4         7 my $res;
301              
302 4 50       8 confess "compare with undef not possible" unless defined($other);
303 4 50       18 confess "compare with invalidt object type" unless $other->isa('Net::BGP::NLRI');
304              
305             # If the path specifies a next hop that is inaccessible, drop the update.
306             # - NOT IMPLEMENTED
307              
308             # Prefer the path with the largest weight.
309             # - LOCAL ATTRIBUTE - Not part of BGP - PRODUCT SPECIFIC
310             # $res = $this->{'_weight'} <=> $other->{'_weight'};
311             # return $res unless $res == 0;
312              
313             # Prefer the path with the largest local preference.
314 4         10 $res = $other->_ifundef('_local_pref',100) <=> $this->_ifundef('_local_pref',100);
315 4 100       38 return $res unless $res == 0;
316              
317             # Prefer the path that was originated by BGP running on this router.
318             # - NOT IMPLEMENTED
319              
320             # Prefer the route that has the shortest AS_path.
321 1         4 $res = $this->{_as_path} <=> $other->{_as_path};
322 1 50       4 return $res unless $res == 0;
323              
324             # Prefer the path with the lowest origin type (where IGP is lower than EGP,
325             # and EGP is lower than Incomplete).
326 1         9 $res = $this->{'_origin'} <=> $other->{'_origin'};
327 1 50       5 return $res unless $res == 0;
328              
329             # Prefer the path with the lowest MED attribute.
330 1         4 $res = $this->_ifundef('_med',0) <=> $other->_ifundef('_med',0);
331 1 50       3 return $res unless $res == 0;
332              
333             # Prefer the external path over the internal path.
334             # - NOT IMPLEMENTED
335              
336             # If the paths are still the same, prefer the path through the closest IGP
337             # neighbor.
338             # - NOT IMPLEMENTED
339              
340 1         6 return 0;
341             }
342              
343              
344             ## POD ##
345              
346             =pod
347              
348             =head1 NAME
349              
350             Net::BGP::NLRI - Class encapsulating BGP-4 NLRI information
351              
352             =head1 SYNOPSIS
353              
354             use Net::BGP::NLRI qw( :origin );
355              
356             # Constructor
357             $nlri = Net::BGP::NLRI->new(
358             Aggregator => [ 64512, '10.0.0.1' ],
359             AtomicAggregate => 1,
360             AsPath => Net::BGP::ASPath->new("64512 64513 64514"),
361             Communities => [ qw( 64512:10000 64512:10001 ) ],
362             LocalPref => 100,
363             MED => 200,
364             NextHop => '10.0.0.1',
365             Origin => INCOMPLETE,
366             );
367              
368             # Object Copy
369             $clone = $nlri->clone();
370              
371             # Accessor Methods
372             $aggregator_ref = $nlri->aggregator($aggregator_ref);
373             $atomic_aggregate = $nlri->atomic_aggregate($atomic_aggregate);
374             $as_path = $nlri->as_path($as_path);
375             $communities_ref = $nlri->communities($communities_ref);
376             $local_pref = $nlri->local_pref($local_pref);
377             $med = $nlri->med($med);
378             $next_hop = $nlri->next_hop($next_hop);
379             $origin = $nlri->origin($origin);
380             $string = $nlri->asstring;
381              
382             # Preference comparisons
383             if ($nlri1 < $nlri2) { ... };
384             if ($nlri1 > $nlri2) { ... };
385             if ($nlri1 == $nlri2) { ... };
386             if ($nlri1 != $nlri2) { ... };
387             @sorted = sort { $a <=> $b } ($nlri1, $nlri2, $nlri3, ... );
388              
389             # Comparison
390             if ($nlri1 eq $nlri2) { ... };
391             if ($nlri1 ne $nlri2) { ... };
392              
393             =head1 DESCRIPTION
394              
395             This module encapsulates the data used by BGP-4 to represent network
396             reachability information. It provides a constructor, and accessor
397             methods for each of the well-known path attributes. An BGP-4 UPDATE
398             message includes this information along with a list of networks for
399             which the information should be used (and a list of network no longer
400             accessible). See B for more infomration.
401              
402             =head1 CONSTRUCTOR
403              
404             I - create a new Net::BGP::NLRI object
405              
406             $nlri = Net::BGP::NLRI->new(
407             Aggregator => [ 64512, '10.0.0.1' ],
408             AsPath => Net::BGP::ASPath->new("64512 64513 64514"),
409             AtomicAggregate => 1,
410             Communities => [ qw( 64512:10000 64512:10001 ) ],
411             LocalPref => 100,
412             MED => 200,
413             NextHop => '10.0.0.1',
414             Origin => INCOMPLETE,
415             );
416              
417             This is the constructor for Net::BGP::NLRI objects. It returns a
418             reference to the newly created object. The following named parameters may
419             be passed to the constructor. See RFC 1771 for the semantics of each
420             path attribute.
421              
422             =head2 Aggregator
423              
424             This parameter corresponds to the AGGREGATOR path attribute. It is expressed
425             as an array reference, the first element of which is the AS number (in the
426             range of an 16-bit unsigned integer) of the route aggregator, and the second
427             element is the aggregator's IP address expressed in dotted-decimal notation
428             as a string. It may be omitted, in which case no AGGREGATOR path attribute
429             will be attached to the UPDATE message.
430              
431             =head2 AsPath
432              
433             This parameter corresponds to the AS_PATH path attribute. The AS_PATH is
434             expressed as an B object. If expressed otherwise, a
435             Net::BGP::ASPath object is tried constructed using the argument.
436              
437             =head2 AtomicAggregate
438              
439             This parameter corresponds to the ATOMIC_AGGREGATE path attribute. It is
440             a boolean value so any value which perl interprets as true/false may be
441             used. It may be omitted, in which case no ATOMIC_AGGREGATE path attribute
442             will be attached to the UPDATE message.
443              
444             =head2 Communities
445              
446             This parameter corresponds to the COMMUNITIES attribute defined in RFC 1997.
447             It is expressed as an array reference of communities which apply to the
448             route(s). The communities are encoded in a special format: AAAA:CCCC, where
449             AAAA corresponds to the 16-bit unsigned integer AS number, and CCCC is
450             a 16-bit unsigned integer of arbitrary value. But see RFC 1997 for the
451             semantics of several reserved community values. This attribute may be
452             omitted, in which case no COMMUNITIES attribute will be attached to the
453             UPDATE message.
454              
455             =head2 LocalPref
456              
457             This parameter corresponds to the LOCAL_PREF path attribute. It is expressed
458             as a 32-bit unsigned integer scalar value. It may be omitted, in which case
459             no LOCAL_PREF path attribute will be attached to the UPDATE message.
460              
461             =head2 MED
462              
463             This parameter corresponds to the MULTI_EXIT_DISC path attribute. It is expressed
464             as a 32-bit unsigned integer scalar value. It may be omitted, in which case
465             no MULTI_EXIT_DISC path attribute will be attached to the UPDATE message.
466              
467             =head2 NextHop
468              
469             This parameter corresponds to the NEXT_HOP path attribute. It is expressed as a
470             dotted-decimal IP address as a perl string. This path attribute is mandatory and
471             the parameter must always be provided to the constructor.
472              
473             =head2 Origin
474              
475             This parameter corresponds to the ORIGIN path attribute. It is expressed as an
476             integer scalar value, which can take the following enumerated values: IGP, EGP,
477             or INCOMPLETE. The preceding symbols can be imported into the program namespace
478             individually or by the :origin export tag. This path attribute is mandatory and
479             the parameter must always be provided to the constructor.
480              
481             =head1 OBJECT COPY
482              
483             I - clone a Net::BGP::NLRI object
484              
485             $clone = $nlri->clone();
486              
487             This method creates an exact copy of the Net::BGP::NLRI object with Path
488             Attributes fields matching those of the original object.
489              
490             =head1 ACCESSOR METHODS
491              
492             I
493              
494             I
495              
496             I
497              
498             I
499              
500             I
501              
502             I
503              
504             I
505              
506             I
507              
508             These accessor methods return the value(s) of the associated path attribute fields
509             if called with no arguments. If called with arguments, they set
510             the associated field. The representation of parameters and return values is the
511             same as described for the corresponding named constructor parameters above.
512              
513             I
514              
515             This accessor method returns a print-friendly string with some, but not all,
516             of the information containted in the object.
517              
518             =head1 EXPORTS
519              
520             The module exports the following symbols according to the rules and
521             conventions of the B module.
522              
523             :origin
524             IGP, EGP, INCOMPLETE
525              
526             =head1 SEE ALSO
527              
528             B, B, B, B, B,
529             B, B, B
530              
531             =head1 AUTHOR
532              
533             Stephen J. Scheck
534              
535             =cut
536              
537             ## End Package Net::BGP::NLRI ##
538              
539             1;