File Coverage

blib/lib/Net/Routing/Linux.pm
Criterion Covered Total %
statement 121 138 87.6
branch 30 44 68.1
condition 22 37 59.4
subroutine 11 11 100.0
pod 2 2 100.0
total 186 232 80.1


line stmt bran cond sub pod time code
1             #
2             # $Id: Linux.pm,v 05d886dffb1a 2015/02/20 05:58:44 gomor $
3             #
4             package Net::Routing::Linux;
5 6     6   12398 use strict;
  6         10  
  6         249  
6 6     6   28 use warnings;
  6         8  
  6         252  
7              
8             our $VERSION = '0.43';
9              
10 6     6   26 use base qw(Net::Routing);
  6         8  
  6         1999  
11              
12 6     6   3785 use IPC::Run3;
  6         157178  
  6         374  
13 6     6   50 use Net::IPv4Addr;
  6         7  
  6         225  
14 6     6   57 use Net::IPv6Addr;
  6         10  
  6         187  
15 6     6   27 use Net::Routing qw($Error :constants);
  6         8  
  6         7596  
16              
17             sub new {
18 4 100   4 1 658 my $self = shift->SUPER::new(
19             @_,
20             ) or return;
21              
22 1 50       6 if (! defined($self->path)) {
23 0         0 $Error = "you must give a `path' attribute";
24 0         0 return;
25             }
26              
27 1         16 my $family = $self->family;
28 1 50       13 if (! defined($family)) {
29 0         0 $Error = "you must give a `family' attribute";
30 0         0 return;
31             }
32             else {
33 1 50 33     6 if ($family ne NR_FAMILY_INET4() && $family ne NR_FAMILY_INET6()) {
34 0         0 $Error = "family not supported [$family]: use either NR_FAMILY_INET4() or NR_FAMILY_INET6()";
35 0         0 return;
36             }
37             }
38              
39 1         31 return $self;
40             }
41              
42             sub get {
43 4     4 1 16 my $self = shift;
44 4         8 my ($cmd4, $cmd6) = @_;
45              
46 4         12 my $path = $self->path;
47 4         41 my $family = $self->family;
48              
49 4         22 my $bin = '';
50 4         11 for my $path (@{$self->path}) {
  4         13  
51 4 50       78 if (-f "$path/netstat") {
52 4         8 $bin = "$path/netstat";
53 4         25 last;
54             }
55             }
56 4 50       15 if (! length($bin)) {
57 0         0 $Error = "unable to find netstat command from current PATH";
58 0         0 return;
59             }
60              
61 4   100     16 $cmd4 ||= [ $bin, '-rnA', 'inet' ];
62 4   100     16 $cmd6 ||= [ $bin, '-rnA', 'inet6' ];
63              
64 4         9 my $cmd = [];
65 4 50       12 if ($family eq NR_FAMILY_INET4()) {
66 4         13 $cmd = $cmd4;
67             }
68             # If not NR_FAMILY_INET4(), it must be NR_FAMILY_INET6() because we validated family at new()
69             else {
70 0         0 $cmd = $cmd6;
71             }
72              
73 4         7 my $out;
74             my $err;
75 4         6 eval {
76 4         22 run3($cmd, undef, \$out, \$err);
77             };
78             # Error in executing run3()
79 4 50       17376 if ($@) {
    100          
80 0         0 chomp($@);
81 0         0 $Error = "unable to execute command [".join(' ', @$cmd)."]: $@";
82 0         0 return;
83             }
84             # Error in command execution
85             elsif ($?) {
86 3         15 chomp($err);
87 3         124 $Error = "command execution failed [".join(' ', @$cmd)."]: $err";
88 3         264 return;
89             }
90              
91 1         5 my $routes = [];
92              
93 1         10 my @lines = split(/\n/, $out);
94 1 50       7 if ($family eq NR_FAMILY_INET4()) {
95 1         9 $routes = $self->_get_inet4(\@lines);
96             }
97             # If not NR_FAMILY_INET4(), it must be NR_FAMILY_INET6() because we validated family at new()
98             else {
99 0         0 $routes = $self->_get_inet6(\@lines);
100             }
101              
102 1         13 return $routes;
103             }
104              
105             sub _get_inet4 {
106 2     2   146 my $self = shift;
107 2         5 my ($lines) = @_;
108              
109 2         2 my @routes = ();
110 2         5 my %cache = ();
111              
112 2         5 for my $line (@$lines) {
113 8         32 my @toks = split(/\s+/, $line);
114 8         12 my $route = $toks[0];
115 8         8 my $gateway = $toks[1];
116 8         7 my $netmask = $toks[2];
117 8         9 my $flags = $toks[3];
118 8         9 my $mss = $toks[4];
119 8         8 my $window = $toks[5];
120 8         7 my $irtt = $toks[6];
121 8         8 my $interface = $toks[7];
122              
123 8 100 33     73 if (defined($route) && defined($gateway) && defined($interface)
      66        
      66        
124             && defined($netmask)) {
125             # A first sanity check to help Net::IPv4Addr
126 6 50 66     59 if ($route !~ /^[0-9\.]+$/ || $gateway !~ /^[0-9\.]+$/
      33        
127             || $netmask !~ /^[0-9\.]+$/) {
128 2         6 next;
129             }
130              
131 4         6 eval {
132 4         19 my ($ip1, $cidr1) = Net::IPv4Addr::ipv4_parse($route);
133 4         179 my ($ip2, $cidr2) = Net::IPv4Addr::ipv4_parse($gateway);
134 4         98 my ($ip3, $cidr3) = Net::IPv4Addr::ipv4_parse($netmask);
135             };
136 4 50       101 if ($@) {
137             #chomp($@);
138             #print "*** DEBUG[$@]\n";
139 0         0 next; # Not a valid line for us.
140             }
141              
142             # Ok, proceed.
143 4         22 my %route = (
144             route => $route,
145             gateway => $gateway,
146             interface => $interface,
147             );
148              
149             # Default route
150 4 100 66     22 if ($route eq '0.0.0.0' && $netmask eq '0.0.0.0') {
151 2         7 $route{default} = 1;
152 2         8 $route{route} = NR_DEFAULT_ROUTE4();
153             }
154             else {
155 2         8 my ($ip, $cidr) = Net::IPv4Addr::ipv4_parse("$route / $netmask");
156 2         164 $route{route} = "$ip/$cidr";
157             }
158              
159             # Local subnet
160 4 100       17 if ($gateway eq '0.0.0.0') {
161 2         3 $route{local} = 1;
162 2         6 $route{gateway} = NR_LOCAL_ROUTE4();
163             }
164              
165 4         42 my $id = $self->_to_psv(\%route);
166 4 50       10 if (! exists($cache{$id})) {
167 4         6 push @routes, \%route;
168 4         23 $cache{$id}++;
169             }
170             }
171             }
172              
173 2         6 return \@routes;
174             }
175              
176             sub _get_inet6 {
177 1     1   72 my $self = shift;
178 1         1 my ($lines) = @_;
179              
180 1         3 my @routes = ();
181 1         2 my %cache = ();
182              
183 1         3 for my $line (@$lines) {
184 8         24 my @toks = split(/\s+/, $line);
185 8         8 my $route = $toks[0];
186 8         8 my $gateway = $toks[1];
187 8         6 my $flag = $toks[2];
188 8         9 my $met = $toks[3];
189 8         5 my $ref = $toks[4];
190 8         47 my $use = $toks[5];
191 8         7 my $interface = $toks[6];
192              
193 8 100 33     45 if (defined($route) && defined($gateway) && defined($interface)) {
      66        
194             # A first sanity check to help Net::IPv6Addr
195 7 100 66     39 if ($route !~ /^[0-9a-f:\/]+$/i || $gateway !~ /^[0-9a-f:\/]+$/i) {
196 1         2 next;
197             }
198              
199 6         7 eval {
200             #print "*** DEBUG $route $gateway\n";
201 6         50 my $ip1 = Net::IPv6Addr::ipv6_parse($route);
202 6         362 my $ip2 = Net::IPv6Addr::ipv6_parse($gateway);
203             };
204 6 50       225 if ($@) {
205             #chomp($@);
206             #print "*** DEBUG[$@]\n";
207 0         0 next; # Not a valid line for us.
208             }
209              
210             # Ok, proceed.
211 6         16 my %route = (
212             route => $route,
213             gateway => $gateway,
214             interface => $interface,
215             );
216              
217             # Default route
218 6 50 66     18 if ($route eq '::/0' && $interface ne 'lo') {
219 0         0 $route{default} = 1;
220 0         0 $route{route} = NR_DEFAULT_ROUTE6();
221             }
222              
223             # Local subnet
224 6 50       9 if ($gateway eq '::') {
225 6         6 $route{local} = 1;
226 6         9 $route{gateway} = NR_LOCAL_ROUTE6();
227             }
228              
229 6         15 my $id = $self->_to_psv(\%route);
230 6 100       14 if (! exists($cache{$id})) {
231 5         6 push @routes, \%route;
232 5         16 $cache{$id}++;
233             }
234             }
235             }
236              
237 1         5 return \@routes;
238             }
239              
240             1;
241              
242             __END__