File Coverage

blib/lib/Net/BGP/RIBEntry.pm
Criterion Covered Total %
statement 37 100 37.0
branch 6 38 15.7
condition 2 24 8.3
subroutine 7 17 41.1
pod 13 13 100.0
total 65 192 33.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             # $Id: RIBEntry.pm,v 1.5 2003/06/02 11:50:12 unimlo Exp $
4              
5             package Net::BGP::RIBEntry;
6              
7 2     2   2698 use strict;
  2         6  
  2         78  
8 2     2   9 use vars qw( $VERSION @ISA );
  2         4  
  2         130  
9              
10             ## Inheritance and Versioning ##
11              
12             @ISA = qw ( );
13             $VERSION = '0.04';
14              
15             ## Module Imports ##
16              
17 2     2   9 use Carp;
  2         5  
  2         115  
18 2     2   11 use Scalar::Util qw(blessed);
  2         10  
  2         2580  
19              
20             ## Public Class Methods ##
21              
22             sub new
23             {
24 2     2 1 1382 my $class = shift();
25 2         5 my ($arg, $value);
26              
27 2         20 my $this = {
28             _prefix => undef,
29             _in => {},
30             _local => undef,
31             _out => {},
32             _peers => {},
33             _force => 0
34             };
35              
36 2         11 bless($this, $class);
37              
38 2         10 while ( defined($arg = shift()) )
39             {
40 1         3 $value = shift();
41              
42 1 50       11 if ( $arg =~ /prefix/i )
43             {
44 1         11 $this->{_prefix} = $value;
45             }
46             else
47             {
48 0         0 confess("unrecognized argument $arg\n");
49             }
50             }
51 2         9 return $this;
52             }
53              
54             sub clone
55             {
56 2     2 1 1875 my $proto = shift;
57 2   66     13 my $class = ref $proto || $proto;
58 2 100       11 $proto = shift unless ref $proto;
59              
60 2         5 my $clone = {};
61              
62 2         8 $clone->{_prefix} = $proto->{_prefix};
63 2         104 foreach my $key (qw( _in _out ))
64             {
65 4 0       24 @{$clone->{$key}}{keys %{$proto->{$key}}} =
  4         91  
  0         0  
66 4         15 map { defined $_ ? $_->clone : undef; }
67 4         8 values(%{$proto->{$key}});
68             };
69 2 50       11 $clone->{_local} = defined $proto->{_local} ? $proto->{_local}->clone : undef;
70              
71 2         6 $clone->{_peers} = $proto->{_peers}; # No reason to copy!
72              
73 2         52 return ( bless($clone, $class) );
74             }
75              
76             ## Public Object Methods ##
77              
78             sub add_peer
79             {
80 0     0 1 0 my ($this,$peer,$dir) = @_;
81 0 0       0 $dir = $dir =~ /in/i ? '_in' : '_out';
82 0         0 $this->{$dir}->{$peer} = undef;
83 0 0       0 $this->{_force} = 1 if $dir eq '_out';
84             }
85              
86             sub remove_peer
87             {
88 0     0 1 0 my ($this,$peer,$dir) = @_;
89 0 0       0 $dir = $dir =~ /in/i ? '_in' : '_out';
90 0         0 delete $this->{$dir}->{$peer};
91             }
92              
93             sub prefix
94             {
95 3     3 1 1246 my $this = shift;
96              
97 3 100       12 $this->{_prefix} = @_ ? shift : $this->{_prefix};
98              
99 3         14 return ( $this->{_prefix} );
100             }
101              
102             sub local
103             {
104 0     0 1   return shift->{_local};
105             };
106              
107             sub in
108             {
109 0     0 1   return shift->{_in};
110             };
111              
112             sub out
113             {
114 0     0 1   return shift->{_out};
115             };
116              
117             sub update_in
118             {
119 0     0 1   my ($this,$peer,$nlri) = @_;
120 0           $this->{_in}->{$peer} = $nlri;
121 0           return $this;
122             }
123              
124             sub update_local
125             {
126 0     0 1   my ($this,$policy) = @_;
127              
128 0 0 0       croak "argument should be a Net::BGP::Policy"
      0        
129             unless (! defined $policy) || ((blessed $policy) && $policy->isa('Net::BGP::Policy'));
130              
131 0           my @nlris = defined $policy
132 0           ? @{$policy->in($this->{_prefix},$this->{_in})}
133 0 0         : grep { $_; } values %{$this->{_in}}; # grep removes undef!
  0            
134              
135              
136 0           my $old = $this->{_local};
137              
138 0           ($this->{_local}) = sort { $a <=> $b } @nlris;
  0            
139              
140 0 0         return ($old eq $this->{_local}) ? 0 : 1;
141             }
142              
143             sub update_out
144             {
145 0     0 1   my ($this,$policy) = @_;
146              
147 0           my $newout_hr;
148 0 0         if (defined $policy)
149             {
150 0 0 0       croak "argument should be a Net::BGP::Policy"
151             unless blessed $policy && $policy->isa('Net::BGP::Policy');
152 0           $newout_hr = $policy->out($this->{_prefix},$this->{_local});
153             }
154             else
155             {
156 0           foreach my $peer (keys %{$this->{_out}})
  0            
157             {
158 0           $newout_hr->{$peer} = $this->{_local};
159             };
160             };
161              
162 0           my $changes_hr;
163              
164             # Peers not returned are not changed! Thats a feature - not a bug!
165              
166             # Look for changes!
167 0           foreach my $peer (keys %{$newout_hr})
  0            
168             {
169             # Was not and is not!
170 0 0 0       next if ((! defined $this->{_out}->{$peer})
171             && (! defined $newout_hr->{$peer}));
172              
173             # Are both there - and they are the same!
174 0 0 0       next if ((defined $this->{_out}->{$peer})
      0        
175             && (defined $newout_hr->{$peer})
176             && ($this->{_out}->{$peer} eq $newout_hr->{$peer}));
177              
178             # We got a change!
179 0           $changes_hr->{$peer} = $newout_hr->{$peer};
180 0           $this->{_out}->{$peer} = $newout_hr->{$peer};
181             };
182              
183 0           return $changes_hr;
184             }
185              
186             sub handle_changes
187             {
188 0     0 1   my ($this,$policy) = @_;
189 0 0 0       return -1 unless $this->update_local($policy) || $this->{_force};
190 0           $this->{_force} = 0;
191 0           my $changes_hr = $this->update_out($policy);
192 0           my $changes = 0;
193 0           foreach my $to_peer (keys %{$changes_hr})
  0            
194             {
195 0 0         my $update = defined $changes_hr->{$to_peer}
196             ? new Net::BGP::Update($changes_hr->{$to_peer},[$this->{_prefix}],undef)
197             : new Net::BGP::Update(Withdraw => [$this->{_prefix}]);
198 0           renew Net::BGP::Peer($to_peer)->update($update);
199 0           $changes += 1;
200             };
201 0           return $changes;
202             }
203              
204             sub asstring
205             {
206 0     0 1   my $this = shift;
207 0           my $res = $this->{_prefix} . ":\tLocal:\t" . $this->{_local}->asstring . "\n";
208 0           foreach my $peer (keys %{$this->{_in}})
  0            
209             {
210 0           my $n = $this->{_in}->{$peer};
211 0 0         $res .= "\tIN:\t" . renew Net::BGP::Peer($peer)->asstring . ': ' .
212             (defined $n ? $n->asstring : 'n/a') . "\n";
213             };
214 0           foreach my $peer (keys %{$this->{_out}})
  0            
215             {
216 0           my $n = $this->{_out}->{$peer};
217 0 0         $res .= "\tOUT:\t" . renew Net::BGP::Peer($peer)->asstring . ': ' .
218             (defined $n ? $n->asstring : 'n/a') . "\n";
219             };
220 0           return $res;
221             }
222              
223             =pod
224              
225             =head1 NAME
226              
227             Net::BGP::RIBEntry - Class representing an entry in a BGP RIB
228              
229             =head1 SYNOPSIS
230              
231             use Net::BGP::RIBEntry;
232              
233             # Constructor
234             $entry = new Net::BGP::RIBEntry(
235             Prefix => '10.0.0.1'
236             );
237              
238             # Object Copy
239             $clone = $entry->clone();
240              
241             # Accessor Methods
242             $entry->add_peer($peer,$dir);
243             $entry->remove_peer($peer,$dir);
244              
245             $entry = $entry->update_in($peer,$nlri);
246             $has_changed = $entry->update_local($policy);
247             $changes_hashref = $entry->update_out($policy);
248              
249             $has_changed = $entry->handle_changes($policy)
250              
251             $prefix = $entry->prefix($prefix);
252              
253             $nlri = $entry->local;
254             $nlri_hashref = $entry->in;
255             $nlri_hashref = $entry->out;
256              
257             $string = $entry->asstring;
258              
259              
260             =head1 DESCRIPTION
261              
262             This module implement a class representing an entry in a BGP Routing
263             Information Base.
264             It stores the prefix that the entry represents as well as 3 categories of
265             network layer reachability information (NLRI). Each NLRI is represented as
266             an L object:
267              
268             =over 4
269              
270             =item IN - An NLRI object for each peer that has sent an UPDATE regarding this prefix.
271              
272             =item Local - The preferred of the policy processed available NLRIs from the I RIB.
273              
274             =item OUT - An NLRI object for each outgoing peer representing the processed I NLRI.
275              
276             =back
277              
278             =head1 CONSTRUCTOR
279              
280             =over 4
281              
282             =item new() - create a new Net::BGP::RIBEntry object
283              
284             $entry = new Net::BGP::RIBEntry(
285             Prefix => '10.0.0.1'
286             );
287              
288             This is the constructor for Net::BGP::RIBEntry object. It returns a
289             reference to the newly created object. The following named parameter may
290             be passed to the constructor:
291              
292             =over 4
293              
294             =item Prefix
295              
296             This parameter corresponds to the prefix the RIB Entry represents.
297              
298             =back
299              
300             =back
301              
302             =head1 OBJECT COPY
303              
304             =over 4
305              
306             =item clone() - clone a Net::BGP::RIBEntry object
307              
308             $clone = $nlri->clone();
309              
310             This method creates an exact copy of the Net::BGP::RIBEntry object.
311              
312             =back
313              
314             =head1 ACCESSOR METHODS
315              
316             =over 4
317              
318             =item add_peer()
319              
320             =item remove_peer()
321              
322             Both add_peer() and remove_peer() takes two arguments: The peer object and
323             the direction of the peer (C or C).
324              
325             =item update_in()
326              
327             This method updates the RIB IN part of the object. The first argument is the
328             peer object that received the BGP UPDATE message and the second argument is
329             an NLRI object corresponding the received UPDATE message.
330              
331             The method returns the RIBEntry object.
332              
333             =item update_local()
334              
335             This method applies the incoming policy and executes the route selection
336             process of BGP. If no arguments (or a undefined value), no policy will be
337             used. Otherwise the argument should be a Net::BGP::Policy object - or
338             something inherited from that.
339              
340             After applying the given policy, the selection process updates the Local RIB
341             with the best available NLRI.
342              
343             The return value is true if the Local RIB is changed, otherwise false.
344              
345             =item update_out()
346              
347             This method applies the outgoing policy to the Local RIB and updates the
348             OUT RIB accordingly. If no arguments (or a undefined value), no policy will be
349             used. Otherwise the argument should be a Net::BGP::Policy object - or
350             something inherited from that.
351              
352             =item handle_changes()
353              
354             This method combines the update_local() and update_out() methods and generates
355             UPDATE messages for each change and sends them to the peers. It takes a
356             optional policy as first argument which are used in the calls to
357             update_local() and update_out().
358              
359             It returns -1 if no changes has happend. Otherwise it returns the number of
360             changes send.
361              
362             =item prefix()
363              
364             This mothod returns the prefix the RIB Entry represent. It an argument is
365             given, the prefix will be replaced with that value.
366              
367             =item local()
368              
369             This method returns the currently selected NLRI or undefined if no NLRIs are
370             available.
371              
372             =item in()
373              
374             =item out()
375              
376             Both the in() and out() method returns a reference to a hash indexed on peers
377             containing Net::BGP::NLRI objects coresponding the the incoming or outgoing
378             UPDATE message data.
379              
380             =item asstring()
381              
382             This method returns a print-friendly string describing the RIB entry.
383              
384             =back
385              
386             =head1 SEE ALSO
387              
388             Net::BGP, Net::BGP::RIB, Net::BGP::NLRI, Net::BGP::Update, Net::BGP::Policy
389              
390             =head1 AUTHOR
391              
392             Martin Lorensen
393              
394             =cut
395              
396             ## End Package Net::BGP::RIBEntry ##
397              
398             1;