File Coverage

blib/lib/Net/Routing.pm
Criterion Covered Total %
statement 76 155 49.0
branch 8 64 12.5
condition 0 18 0.0
subroutine 23 27 85.1
pod 3 3 100.0
total 110 267 41.2


line stmt bran cond sub pod time code
1             #
2             # $Id: Routing.pm,v 05d886dffb1a 2015/02/20 05:58:44 gomor $
3             #
4             package Net::Routing;
5 6     6   662 use strict;
  6         9  
  6         218  
6 6     6   26 use warnings;
  6         11  
  6         264  
7              
8             our $VERSION = '0.43';
9              
10 6     6   65 use base qw(Class::Gomor::Hash);
  6         6  
  6         3059  
11              
12             our @AS = qw(
13             path
14             lc_all
15             target
16             family
17             _target_type
18             _routing_module
19             _routes
20             );
21             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
22              
23 6     6   47941 use Net::CIDR;
  6         31778  
  6         402  
24 6     6   3406 use Net::IPv4Addr;
  6         18026  
  6         300  
25 6     6   3161 use Net::IPv6Addr;
  6         223175  
  6         796  
26              
27             our $_routing_module;
28             our $Error;
29              
30 6     6   64 use constant NR_TARGET_ALL => 'all';
  6         7  
  6         308  
31 6     6   29 use constant NR_TARGET_DEFAULT => 'default';
  6         9  
  6         227  
32 6     6   24 use constant NR_FAMILY_INET4 => 'inet4';
  6         8  
  6         222  
33 6     6   24 use constant NR_FAMILY_INET6 => 'inet6';
  6         7  
  6         211  
34 6     6   24 use constant NR_DEFAULT_ROUTE4 => '0.0.0.0/0';
  6         7  
  6         207  
35 6     6   25 use constant NR_DEFAULT_ROUTE6 => '::/0';
  6         7  
  6         357  
36 6     6   27 use constant NR_LOCAL_ROUTE4 => '0.0.0.0';
  6         9  
  6         300  
37 6     6   28 use constant NR_LOCAL_ROUTE6 => '::';
  6         8  
  6         287  
38              
39 6     6   30 use constant _TARGET_TYPE_ALL => 'all';
  6         9  
  6         293  
40 6     6   25 use constant _TARGET_TYPE_DEFAULT => 'default';
  6         10  
  6         236  
41 6     6   24 use constant _TARGET_TYPE_IPv4 => 'ipv4';
  6         8  
  6         273  
42 6     6   26 use constant _TARGET_TYPE_IPv6 => 'ipv6';
  6         17  
  6         250  
43 6     6   24 use constant _TARGET_TYPE_INTERFACE => 'interface';
  6         10  
  6         927  
44              
45             our %EXPORT_TAGS = (
46             constants => [qw(
47             NR_TARGET_ALL
48             NR_TARGET_DEFAULT
49             NR_FAMILY_INET4
50             NR_FAMILY_INET6
51             NR_DEFAULT_ROUTE4
52             NR_DEFAULT_ROUTE6
53             NR_LOCAL_ROUTE4
54             NR_LOCAL_ROUTE6
55             )],
56             );
57              
58             our @EXPORT_OK = (
59             '$Error',
60             @{$EXPORT_TAGS{constants}},
61             );
62              
63             BEGIN {
64 6 50   6   47 if ($^O eq 'linux') {
    0          
    0          
    0          
65 6         6007 return $_routing_module = "Net::Routing::Linux";
66             }
67             elsif ($^O eq 'freebsd') {
68 0         0 return $_routing_module = "Net::Routing::FreeBSD";
69             }
70             elsif ($^O eq 'netbsd') {
71 0         0 return $_routing_module = "Net::Routing::NetBSD";
72             }
73             elsif ($^O eq 'darwin') {
74 0         0 return $_routing_module = "Net::Routing::Darwin";
75             }
76             #elsif ($^O eq 'MSWin32') {
77             # return $_routing_module = "Net::Routing::MSWin32";
78             #}
79             #elsif ($^O eq 'openbsd') {
80             # return $_routing_module = "Net::Routing::OpenBSD";
81             #}
82              
83 0         0 die("[-] Net::Routing: Operating System not supported: $^O\n");
84             }
85              
86             sub new {
87 4     4 1 61 my $self = shift->SUPER::new(
88             path => [ qw(/bin /sbin /usr/bin /usr/sbin /usr/local/bin /usr/local/sbin) ],
89             lc_all => 'en_GB.UTF-8',
90             target => NR_TARGET_ALL(),
91             family => NR_FAMILY_INET4(),
92             @_,
93             );
94              
95 4         820 my @path = qw(/bin /sbin /usr/bin /usr/sbin /usr/local/bin /usr/local/sbin);
96              
97 4         24 $ENV{LC_ALL} = $self->lc_all;
98 4         135 $ENV{PATH} = join(':', $self->path);
99              
100 4     4   317 eval("use $_routing_module;");
  4         25  
  4         5  
  4         134  
101 4 50       16 if ($@) {
102 0         0 chomp($@);
103 0         0 $Error = "unable to load routing module [$_routing_module]: $@";
104 0         0 return;
105             }
106              
107 4         30 $self->_routing_module($_routing_module);
108              
109 4 100       47 my $routes = $self->get or return;
110              
111 1         11 $self->_routes($routes);
112              
113 1         31 return $self;
114             }
115              
116             sub _get_target_type {
117 0     0   0 my $self = shift;
118 0         0 my ($target) = @_;
119              
120 0         0 my $target_type = '';
121              
122 0 0       0 if ($target eq NR_TARGET_ALL()) {
    0          
    0          
    0          
123 0         0 $target_type = _TARGET_TYPE_ALL();
124             }
125             elsif ($target eq NR_TARGET_DEFAULT()) {
126 0         0 $target_type = _TARGET_TYPE_DEFAULT();
127             }
128             elsif ($target =~ /^[0-9\.]+$/) {
129 0         0 eval {
130 0         0 my ($ip, $cidr) = Net::IPv4Addr::ipv4_parse($target);
131             };
132 0 0       0 if (! $@) {
133 0         0 $target_type = _TARGET_TYPE_IPv4();
134             }
135             }
136             elsif ($target =~ /^[0-9a-f:\/]+$/i) {
137 0         0 eval {
138 0         0 my $x = Net::IPv6Addr::ipv6_parse($target);
139             };
140 0 0       0 if (! $@) {
141 0         0 $target_type = _TARGET_TYPE_IPv6();
142             }
143             }
144             # If it is not an IPv4 nor IPv6 address or default nor all routes,
145             # we consider it is an interface.
146             else {
147 0         0 $target_type = _TARGET_TYPE_INTERFACE();
148             }
149              
150 0         0 return $target_type;
151             }
152              
153             sub get {
154 0     0 1 0 my $self = shift;
155              
156 0         0 my $target = $self->target;
157 0         0 my $family = $self->family;
158 0         0 my $target_type = $self->_get_target_type($target);
159              
160 0 0       0 if ($target_type eq _TARGET_TYPE_IPv4()) {
    0          
161 0         0 $family = NR_FAMILY_INET4();
162             }
163             elsif ($target_type eq _TARGET_TYPE_IPv6()) {
164 0         0 $family = NR_FAMILY_INET6();
165             }
166              
167 0 0       0 my $routes = $self->_routing_module_get or return;
168 0 0       0 if ($target_type eq _TARGET_TYPE_ALL()) {
169 0         0 return $routes;
170             }
171              
172             # Return only wanted routes
173 0         0 my @routes = ();
174 0         0 for my $route (@$routes) {
175             # Will return default route only.
176 0 0 0     0 if ($target_type eq _TARGET_TYPE_DEFAULT()) {
    0          
    0          
177 0 0       0 if ($route->{default}) {
178 0         0 push @routes, $route;
179             }
180             }
181             # Will return routes on interface only.
182             elsif ($target_type eq _TARGET_TYPE_INTERFACE()) {
183 0 0       0 if ($route->{interface} eq $target) {
184 0         0 push @routes, $route;
185             }
186             }
187             # Will return local route only.
188             elsif ($target_type eq _TARGET_TYPE_IPv4() || $target_type eq _TARGET_TYPE_IPv6()) {
189 0 0 0     0 if ($route->{route}
      0        
190             && $route->{route} ne NR_DEFAULT_ROUTE4()
191             && $route->{route} ne NR_DEFAULT_ROUTE6()) {
192 0         0 my $r;
193 0         0 eval {
194 0         0 $r = Net::CIDR::cidrlookup($target, $route->{route});
195             };
196 0 0 0     0 if (! $@ && $r) {
197 0         0 push @routes, $route;
198             }
199             }
200             }
201             }
202              
203             # If no route matches, we will return the default route for types 'ipv4' and 'ipv6'
204 0 0 0     0 if (@routes == 0
      0        
205             && ($target_type eq _TARGET_TYPE_IPv4() || $target_type eq _TARGET_TYPE_IPv6())
206             ) {
207 0         0 for my $route (@$routes) {
208 0 0       0 if ($route->{default}) {
209 0         0 push @routes, $route;
210             }
211             }
212             }
213              
214 0         0 return \@routes;
215             }
216              
217             sub _routing_module_get {
218 0     0   0 my $self = shift;
219              
220 0         0 my $routing_module = $self->_routing_module;
221              
222 0         0 my $routing;
223 0         0 eval {
224 0         0 $routing = $routing_module->new(
225             path => $self->path,
226             family => $self->family,
227             );
228             };
229 0 0       0 if ($@) {
230 0         0 chomp($@);
231 0         0 $Error = "unable to load module [$routing_module]: $@";
232 0         0 return;
233             }
234 0 0       0 if (! defined($routing)) {
235 0         0 return;
236             }
237              
238 0         0 my $routes = $routing->get;
239 0 0       0 if (! defined($routes)) {
240 0         0 return;
241             }
242              
243 0         0 return $routes;
244             }
245              
246             sub list {
247 0     0 1 0 my $self = shift;
248              
249 0         0 printf("%-33s %-33s %-10s\n", "Route", "Gateway", "Interface");
250              
251 0         0 my $routes = $self->_routes;
252 0         0 for my $route (@$routes) {
253 0         0 my $route2 = $route->{route};
254 0         0 my $gateway = $route->{gateway};
255 0         0 my $interface = $route->{interface};
256              
257 0         0 printf("%-33s %-33s %-10s", $route2, $gateway, $interface);
258 0 0       0 if ($route->{local}) {
    0          
259 0         0 print "[local]";
260             }
261             elsif ($route->{default}) {
262 0         0 print "[default]";
263             }
264              
265 0         0 print "\n";
266             }
267              
268 0         0 return 1;
269             }
270              
271             sub _to_psv {
272 72     72   76 my $self = shift;
273 72         71 my ($route) = @_;
274              
275 72 100       272 my $psv = $route->{route}.'|'.$route->{gateway}.'|'.$route->{interface}.'|'.
    100          
276             (exists($route->{default})?'1':'0').'|'.(exists($route->{local})?'1':'0');
277              
278 72         141 return $psv;
279             }
280              
281             1;
282              
283             __END__