File Coverage

blib/lib/Cisco/ShowIPRoute/Parser.pm
Criterion Covered Total %
statement 105 125 84.0
branch 27 36 75.0
condition 8 11 72.7
subroutine 11 12 91.6
pod 2 8 25.0
total 153 192 79.6


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3              
4             Cisco::ShowIPRoute::Parser - parse Cisco 'show ip route' command
5              
6             =head1 SYNOPSIS
7              
8             use Cisco::ShowIPRoute::Parser;
9              
10             # Router.log holds the output from 'show ip route'
11             my $log = 'Router.log';
12             my $r = new Cisco::ShowIPRoute::Parser($log);
13              
14             my $dest = '10.159.25.44';
15             my @routes = $r->getroutes($dest);
16              
17             print "@routes\n";
18              
19             =head1 DESCRIPTION
20              
21             This File contains the encapsulation of Raj's route parser. It will
22             parse the output from a Cisco 'show ip route' command and return all
23             the routes to a specified IP address.
24              
25             When collecting the routes please ensure it is in decimal format. This
26             can be enabled by doing the following at the router prompt:
27              
28             term len 0
29             terminal ip netmask-format decimal
30             show ip route
31              
32             =head1 Methods
33              
34             =cut
35              
36             package Cisco::ShowIPRoute::Parser;
37              
38 1     1   6864 use 5.006;
  1         3  
  1         36  
39 1     1   5 use strict;
  1         1  
  1         27  
40 1     1   5 use warnings;
  1         1  
  1         32  
41              
42             require DynaLoader;
43 1     1   827 use AutoLoader;
  1         1352  
  1         4  
44              
45             our $VERSION = 1.02;
46             our @ISA = qw(DynaLoader);
47             bootstrap Cisco::ShowIPRoute::Parser $VERSION;
48              
49              
50             =head2 new()
51              
52             =over 4
53              
54             =item Args:
55              
56             the log file as a string
57              
58             =item Rtns:
59              
60             Handle to our object.
61              
62             =item Description:
63              
64              
65             Define some initial states and open the log file that is to be used
66             when parsing routes
67            
68             =back
69              
70             =cut
71              
72             our %netmask_table = (
73             '0' => '0.0.0.0',
74             '1' => '128.0.0.0',
75             '2' => '192.0.0.0',
76             '3' => '224.0.0.0',
77             '4' => '240.0.0.0',
78             '5' => '248.0.0.0',
79             '6' => '252.0.0.0',
80             '7' => '254.0.0.0',
81             '8' => '255.0.0.0',
82             '9' => '255.128.0.0',
83             '10' => '255.192.0.0',
84             '11' => '255.224.0.0',
85             '12' => '255.240.0.0',
86             '13' => '255.248.0.0',
87             '14' => '255.252.0.0',
88             '15' => '255.254.0.0',
89             '16' => '255.255.0.0',
90             '17' => '255.255.128.0',
91             '18' => '255.255.192.0',
92             '19' => '255.255.224.0',
93             '20' => '255.255.240.0',
94             '21' => '255.255.248.0',
95             '22' => '255.255.252.0',
96             '23' => '255.255.254.0',
97             '24' => '255.255.255.0',
98             '25' => '255.255.255.128',
99             '26' => '255.255.255.192',
100             '27' => '255.255.255.224',
101             '28' => '255.255.255.240',
102             '29' => '255.255.255.248',
103             '30' => '255.255.255.252',
104             '31' => '255.255.255.254',
105             '32' => '255.255.255.255',
106             );
107              
108             sub new
109             {
110 4     4 1 416 my $class = shift;
111 4   33     23 $class = ref($class) || $class;
112 4         38 my $self = {
113             'log' => $_[0],
114             'bestRoute' => [],
115             'realRoutes' => [],
116             'connInterface' => [],
117             'bestMask' => 0
118             };
119              
120             # This came from Damian Conway
121 4         10 my $digit = q/(?:25[0-5]|2[0-4]\d|[0-1]??\d{1,2})/;
122 4         22 $self->{'re'} = "$digit\\.$digit\\.$digit\\.$digit";
123              
124             # We reduced the RE to this as it is safe to assume we have valid IPs
125             # coming back from the router. If your paranoid then just comment out
126             # this line. The code will run much slower though! You have been
127             # warned!
128 4         9 $self->{'re'} = '\d+\.\d+\.\d+\.\d+';
129              
130 4         7 my $log = $self->{'log'};
131 4 100       2317 open(L, "< $log") || die "Can't open $log for read";
132 3         13136 @{$self->{'lines'}} = ;
  3         2936  
133 3         681 close L;
134              
135             # Fix the problem with non decimal netmasks. This is a real hach XXX
136             # 20.3/24 becomes 20.3 255.255.255.0
137 3         7 grep {s%(\d+\.\d+)/(\d+) %$1 $netmask_table{$2} %} @{$self->{'lines'}};
  18354         98071  
  3         75  
138              
139 3         34 bless($self,$class);
140 3         28 return $self;
141             }
142              
143             =head2 getroutes()
144              
145             =over 4
146              
147             =item Args:
148              
149             the IP address to get the routes for as a string
150              
151             =item Rtns:
152              
153             An array of IP addresses, or "directly connected..." messages.
154              
155             Or a null list if no routes found
156              
157             =item Description:
158              
159              
160             We call ipRouteCheck() and routeIterate() to find all the routes. This is
161             the main interface. You shouldn't need any other methods.
162            
163             =back
164              
165             =cut
166              
167             sub getroutes
168             {
169 3     3 1 35 my $self = shift;
170 3   50     60 $self->{'ip'} = shift || die;
171              
172 3         14 $self->{'bestRoute'} = [];
173 3         12 $self->{'realRoutes'} = [];
174 3         10 $self->{'connInterface'} = [];
175 3         7 $self->{'bestMask'} = 0;
176              
177 3         19 $self->ipRouteCheck($self->{'ip'},1,$self->{'lines'});
178 3         15 $self->routeIterate();
179              
180 3 50       10 if($self->{'realRoutes'}[0])
181             {
182 3         6 return @{$self->{'realRoutes'}};
  3         22  
183             }
184             else
185             {
186 0         0 return();
187             }
188             }
189              
190             # Slow unused code to do a network check. You can use this if you like.
191             # If you don't have C compiler just find netCheck further down and
192             # uncomment it. Make sure you comment out the call to NetCheck.
193             sub netCheck {
194 0     0 0 0 my $network = $_[1];
195 0         0 my @mask = split(/\./,$_[2]);
196 0         0 my @destination = split(/\./,$_[3]);
197              
198 0         0 my $logicalAnd = sprintf("%d.%d.%d.%d",
199             ($destination[0] + 0 )&($mask[0] + 0),
200             ($destination[1] + 0 )&($mask[1] + 0),
201             ($destination[2] + 0 )&($mask[2] + 0),
202             ($destination[3] + 0 )&($mask[3] + 0));
203              
204             # MATCH
205 0 0       0 if ($network eq $logicalAnd) {
206 0         0 return 1;
207             }
208             else {
209 0         0 return 0;
210             }
211             }
212              
213             #converts from decimal to bitcount.
214             sub decimalToBitcount {
215              
216 20     20 0 28 my $mask = $_[1]; # eg 255.255.255.0
217 20         110 my @octect = split(/\./,$mask);
218              
219 20         103 return ($octect[0] + $octect[1] + $octect[2] + $octect[3]) ;
220             }
221              
222             #Due to the classless nature, we follow the longest match rule
223             #return TRUE, if the proposed route has a higher mask than current
224             sub bestMaskProc {
225 20     20 0 37 my $self = shift;
226 20         61 my $tmpMask = $self->decimalToBitcount($_[0]);
227            
228 20 100       105 if ($self->{'bestMask'} == 0 ) {
    100          
    100          
229 6         12 $self->{'bestMask'} = $tmpMask;
230 6         22 return 1;
231             }
232             elsif ($self->{'bestMask'} < $tmpMask) {
233 3         10 $self->{'bestRoute'} = [];
234 3         13 $self->{'bestMask'} = $tmpMask;
235 3         13 return 1;
236             }
237             elsif ($self->{'bestMask'} == $tmpMask) {
238 4         12 return 1; #means more than 1 nexthop for destination
239             }
240             else {
241 7         29 return 0;
242             }
243             }
244              
245             #Insert the best routes(so far) into the array
246             sub insertRoute {
247 13     13 0 15 my $self = shift;
248 13         17 push(@{$self->{'bestRoute'}}, @_);
  13         50  
249             }
250              
251             #The following subroutine looks through the lines and finds the best route
252             #Best routes are stored in bestRoutes and highest bitmask is found
253             #in reference bitMask.
254             sub ipRouteCheck {
255              
256 6     6 0 11 my $self = shift;
257 6         13 my $destination = shift;
258 6         9 my $getConnected = shift;
259 6         10 my $lines = shift;
260 6         8 my $mask = 0;
261 6         9 my $network = "0.0.0.0";
262 6         11 my $re = $self->{'re'};
263 6         11 my $conCheck = "";
264 6         8 my $nextHop = "";
265            
266 6         17 for (@$lines) {
267 18425         23451 my $line = $_ ;
268              
269 18425 100       96689 if ($line =~ m/($re) ($re )?/o) {
270 6192         9005 $network = $1;
271 6192 100       13515 if ($2) {
272 6099         7768 $mask = $2;
273 6099         7265 chop($mask);
274             }
275             }
276              
277             # First RE is for dynamic route, 2nd for obvious, 3rd for
278             # static routes
279 18425 100 100     95815 if ( ($line =~ m/via ($re),\s+.*$/o) ||
      100        
280             ($line =~ m/(is directly connected.*)$/o) ||
281             ($line =~ m/via ($re)$/o) )
282             {
283 15673         23052 $nextHop = $1;
284             #pushes Connected interfaces into another
285             #array to simplify searches
286 15673 100       26677 if ($getConnected == 1) {
287 15602 100       37199 push (@{$self->{'connInterface'}},"$network $mask $nextHop") if ((substr $nextHop, 0, 2) eq "is");
  51         255  
288             }
289              
290             # We use fast C code now. Use the line below if you can't
291             # compile netCheck module up
292             #if ($self->netCheck($network, $mask, $destination)) {
293 15673 100       59381 if (&NetCheck($network, $mask, $destination)) {
294             #print "Net: $network, Mask: $mask, Dest: $destination\n";
295 20 100       83 if ($self->bestMaskProc($mask)) {
296 13         47 $self->insertRoute($nextHop);
297             }
298             }
299             }
300             }
301             }
302              
303             sub routeIterate {
304              
305 3     3 0 5 my $self = shift;
306 3         4 my @validRoutes = @{$self->{'bestRoute'}};
  3         16  
307 3         4 my @output = ();
308 3         6 my $length = 0;
309 3         5 my $route = '';
310              
311 3         5 my $count = 0;
312              
313              
314 3         14 while ($route = shift(@validRoutes) ) {
315              
316 4 100       15 if ($route =~ m/is directly connected.*$/) {
317 1         4 push (@{$self->{'realRoutes'}}, $route);
  1         3  
318 1         7 next;
319             }
320              
321 3         5 for (;;) {
322 3         4 @{$self->{'bestRoute'}} = ();
  3         8  
323 3         7 $self->{'bestMask'} = 0;
324 3         12 $self->ipRouteCheck($route,0,$self->{'connInterface'});
325 3         5 @output = @{$self->{'bestRoute'}};
  3         9  
326 3         7 $length = @output;
327              
328 3 50       21 if (!grep (/is directly connected.*$/,@output)) {
329 0         0 $self->ipRouteCheck($route,0,$self->{'lines'}) ;
330 0         0 @output = @{$self->{'bestRoute'}};
  0         0  
331 0         0 $length = @output;
332             }
333              
334 3 50       15 if (grep (/is directly connected.*$/,@output)) {
    0          
335 3         6 last;
336             }
337             elsif ($length > 1) {
338 0         0 $route = shift (@output);
339 0         0 push(@{$self->{'validRoutes'}},@output);
  0         0  
340             }
341             else {
342 0         0 $route = $output[0] ;
343             }
344              
345 0         0 $count++;
346 0 0       0 if ($count == 8) {
347 0         0 print $self->{'log'},": loop was executed at least 8 times. Bailing out!\n";
348 0         0 last;
349             }
350             }
351 3         5 push (@{$self->{'realRoutes'}}, $route);
  3         6  
352 3         12 $count = 0;
353             }
354             }
355              
356             =head1 BUGS
357              
358             It is highly possible there are bugs. But we don't think so. We have
359             tested this over 4000 routers and pulled routes across this network
360             often. Whenever we think the code is wrong we invariably find we have a
361             network routing problems.
362              
363             =head1 AUTHORS
364              
365             Mark Pfeiffer
366              
367             Rajiv Santiago
368              
369             =head1 COPYRIGHT
370            
371             Copyright (c) 2003 Rajiv Santiago and Mark Pfeiffer. All rights
372             reserved. This program is free software; you can redistribute it and/or
373             modify it under the same terms as Perl itself.
374              
375             Cisco is a registered trade mark of Cisco Systems, Inc.
376              
377             This code is in no way associated with Cisco Systems, Inc.
378              
379             All other trademarks mentioned in this document are the property of
380             their respective owners.
381              
382             =head DISCLAIMER
383              
384             We make no warranties, implied or otherwise, about the suitability
385             of this software. We shall not in any case be liable for special,
386             incidental, consequential, indirect or other similar damages arising
387             from the transfer, storage, or use of this code.
388              
389             This code is offered in good faith and in the hope that it may be of use.
390              
391              
392             =cut
393              
394             1;
395              
396             __END__