File Coverage

blib/lib/Net/Routing/FreeBSD.pm
Criterion Covered Total %
statement 128 132 96.9
branch 43 50 86.0
condition 19 21 90.4
subroutine 10 10 100.0
pod 1 1 100.0
total 201 214 93.9


line stmt bran cond sub pod time code
1             #
2             # $Id: FreeBSD.pm,v 05d886dffb1a 2015/02/20 05:58:44 gomor $
3             #
4             package Net::Routing::FreeBSD;
5 5     5   24847 use strict;
  5         8  
  5         165  
6 5     5   24 use warnings;
  5         7  
  5         210  
7              
8             our $VERSION = '0.43';
9              
10 5     5   30 use base qw(Net::Routing::Linux);
  5         8  
  5         1783  
11              
12 5     5   26 use Net::CIDR;
  5         7  
  5         178  
13 5     5   26 use Net::IPv4Addr;
  5         9  
  5         154  
14 5     5   21 use Net::IPv6Addr;
  5         6  
  5         162  
15 5     5   20 use Net::Routing qw($Error :constants);
  5         6  
  5         6123  
16              
17             sub get {
18 3     3 1 7 my $self = shift;
19              
20 3         5 my $bin = '';
21 3         7 for my $path (@{$self->path}) {
  3         12  
22 3 50       105 if (-f "$path/netstat") {
23 3         6 $bin = "$path/netstat";
24 3         7 last;
25             }
26             }
27 3 50       17 if (! length($bin)) {
28 0         0 $Error = "unable to find netstat command from current PATH";
29 0         0 return;
30             }
31              
32 3         8 my $cmd4 = [ $bin, '-rnf', 'inet' ];
33 3         12 my $cmd6 = [ $bin, '-rnf', 'inet6' ];
34              
35 3         22 return $self->SUPER::get($cmd4, $cmd6);
36             }
37              
38             sub _get_inet4 {
39 3     3   742 my $self = shift;
40 3         9 my ($lines) = @_;
41              
42 3         10 my @routes = ();
43 3         8 my %cache = ();
44              
45             # FreeBSD 9.x
46             # Destination Gateway Flags Refs Use Netif Expire
47             # default 8.8.210.254 UGS 0 14188719 em0
48             #
49             # FreeBSD 10.x
50             # Destination Gateway Flags Netif Expire
51             # default 8.8.25.254 UGS re0
52              
53 3         6 my $freebsd_version = '10.x';
54              
55 3         10 for my $line (@$lines) {
56             # FreeBSD 10.1-RELEASE
57 31 100       153 if ($line =~ /^\s*destination\s+gateway\s+flags\s+netif\s+expire\s*$/i) {
    100          
58             #print STDERR "*** DEBUG FreeBSD 10.x\n";
59 1         5 $freebsd_version = '10.x';
60 1         2 next;
61             }
62             # FreeBSD 9.3-RELEASE
63             elsif ($line =~ /^\s*destination\s+gateway\s+flags\s+refs\s+use\s+netif\s+expire\s*$/i) {
64             #print STDERR "*** DEBUG FreeBSD 9.x\n";
65 2         5 $freebsd_version = '9.x';
66 2         4 next;
67             }
68              
69 28         77 my @toks = split(/\s+/, $line);
70              
71 28         32 my ($route, $gateway, $flags, $refs, $use, $interface, $expire);
72              
73 28 100       42 if ($freebsd_version eq '9.x') {
74 15         15 $route = $toks[0];
75 15         12 $gateway = $toks[1];
76 15         17 $flags = $toks[2];
77 15         12 $refs = $toks[3];
78 15         12 $use = $toks[4];
79 15         11 $interface = $toks[5];
80 15         13 $expire = $toks[6];
81             }
82             else { # Default to FreeBSD 10.x
83 13         18 $route = $toks[0];
84 13         12 $gateway = $toks[1];
85 13         12 $flags = $toks[2];
86 13         15 $interface = $toks[3];
87 13         9 $expire = $toks[4];
88             }
89              
90 28 100 100     190 if (defined($route) && defined($gateway) && defined($interface)) {
      100        
91             #print STDERR "*** DEBUG $route $gateway $interface\n";
92              
93             # Convert FreeBSD strings to universal IP addresses
94 19 100       35 if ($route eq 'default') {
95 3         38 $route = '0.0.0.0/0';
96             }
97 19 100       46 if ($gateway =~ /^link/) {
98 10         11 $gateway = '0.0.0.0';
99             }
100              
101             # Special case: an entry with a MAC address means a direct route
102             #if ($gateway =~ /^[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}$/i) {
103             #my %route = (
104             #route => "$route/32",
105             #gateway => '0.0.0.0',
106             #interface => $interface,
107             #);
108             #my $id = $self->_to_psv(\%route);
109             #if (! exists($cache{$id})) {
110             #push @routes, \%route;
111             #$cache{$id}++;
112             #}
113             #}
114              
115             # A first sanity check to help Net::IPv4Addr
116 19 100 66     106 if ($gateway !~ m{^[0-9\.]+$} || $route !~ m{^[0-9\.]+(?:/\d+)?$}) {
117 3         6 next;
118             }
119              
120             # Normalize IP addresses
121 16         51 $route = Net::CIDR::range2cidr($route); # 127.16 => 172.16/16
122 16         1211 $route = Net::CIDR::cidrvalidate($route); # 172.16/16 => 172.16.0.0/16
123              
124 16         5723 eval {
125 16         53 my ($ip1, $cidr1) = Net::IPv4Addr::ipv4_parse($route);
126 16         683 my ($ip2, $cidr2) = Net::IPv4Addr::ipv4_parse($gateway);
127             };
128 16 50       350 if ($@) {
129             #chomp($@);
130             #print "*** DEBUG[$@]\n";
131 0         0 next; # Not a valid line for us.
132             }
133              
134             # Ok, proceed.
135 16         77 my %route = (
136             route => $route,
137             gateway => $gateway,
138             interface => $interface,
139             );
140              
141             # Default route
142 16 100       29 if ($route eq '0.0.0.0/0') {
143 3         12 $route{default} = 1;
144 3         8 $route{route} = NR_DEFAULT_ROUTE4();
145             }
146              
147             # Local subnet
148 16 100       30 if ($gateway eq '0.0.0.0') {
149 10         22 $route{local} = 1;
150 10         18 $route{gateway} = NR_LOCAL_ROUTE4();
151             }
152              
153 16 50       69 if ($route{route} !~ /\/\d+$/) {
154 0         0 $route{route} .= '/32';
155             }
156              
157 16         77 my $id = $self->_to_psv(\%route);
158 16 50       36 if (! exists($cache{$id})) {
159             #print STDERR "*** DEBUG new $id\n";
160 16         29 push @routes, \%route;
161 16         64 $cache{$id}++;
162             }
163             }
164             }
165              
166 3         11 return \@routes;
167             }
168              
169             sub _get_inet6 {
170 3     3   511 my $self = shift;
171 3         6 my ($lines) = @_;
172              
173 3         5 my @routes = ();
174 3         8 my %cache = ();
175              
176             # FreeBSD 9.3-RELEASE
177             # Internet6:
178             # Destination Gateway Flags Netif Expire
179             # ::/96 ::1 UGRS lo0 =>
180             # default 2003:1122:1:ffff:ff:ff:ff:ff UGS em0
181             # ::1 link#5 UH lo0
182              
183             # FreeBSD 10.1-RELEASE
184             # Internet6:
185             # Destination Gateway Flags Netif Expire
186             # ::/96 ::1 UGRS lo0
187             # ::1 link#2 UH lo0
188             # ::ffff:0.0.0.0/96 ::1 UGRS lo0
189             # 2003:1122:2:1a00::/56 link#1 U re0
190              
191 3         8 for my $line (@$lines) {
192 58         135 my @toks = split(/\s+/, $line);
193              
194 58         60 my $route = $toks[0];
195 58         47 my $gateway = $toks[1];
196 58         40 my $flag = $toks[2];
197 58         41 my $interface = $toks[3];
198 58         53 my $expire = $toks[4];
199              
200 58 100 100     266 if (defined($route) && defined($gateway) && defined($interface)) {
      100        
201             # Convert FreeBSD strings to universal IP addresses
202 49 100 100     175 if ($gateway =~ /^link/ || $gateway eq '::1') {
203 38         42 $gateway = '::';
204             }
205 49 100       66 if ($route eq 'default') {
206 1         2 $route = '::/0';
207             }
208             # Strip interface name from route
209 49         129 $route =~ s/%[a-z]+\d+//g;
210              
211             # Special case: an entry with a MAC address means a default gateway
212 49 100       81 if ($gateway =~ /^[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}:[a-f0-9]{1,2}$/i) {
213 2         9 my %route = (
214             route => NR_DEFAULT_ROUTE6(),
215             gateway => $route,
216             interface => $interface,
217             );
218 2         8 my $id = $self->_to_psv(\%route);
219 2 50       8 if (! exists($cache{$id})) {
220 2         4 push @routes, \%route;
221 2         6 $cache{$id}++;
222             }
223             }
224              
225             # A first sanity check to help Net::IPv6Addr
226 49 100 66     215 if ($route !~ m{^[0-9a-f:/]+$}i || $gateway !~ m{^[0-9a-f:/]+$}i) {
227 10         22 next;
228             }
229              
230             #print STDERR "*** DEBUG $route $gateway $interface\n";
231              
232 39         38 eval {
233             #print "*** DEBUG $route $gateway\n";
234 39         93 my $ip1 = Net::IPv6Addr::ipv6_parse($route);
235 39         1797 my $ip2 = Net::IPv6Addr::ipv6_parse($gateway);
236             };
237 39 100       1810 if ($@) {
238             #chomp($@);
239             #print "*** DEBUG[$@]\n";
240 2         7 next; # Not a valid line for us.
241             }
242              
243             # Ok, proceed.
244 37         109 my %route = (
245             route => $route,
246             gateway => $gateway,
247             interface => $interface,
248             );
249              
250             # Default route
251 37 100       60 if ($route eq '::/0') {
252 1         3 $route{default} = 1;
253 1         3 $route{route} = NR_DEFAULT_ROUTE6();
254             }
255              
256             # Local subnet
257 37 100       63 if ($gateway eq '::') {
258 36         50 $route{local} = 1;
259 36         47 $route{gateway} = NR_LOCAL_ROUTE6();
260             }
261              
262 37 100       96 if ($route{route} !~ /\/\d+$/) {
263 14         19 $route{route} .= '/128';
264             }
265              
266 37         104 my $id = $self->_to_psv(\%route);
267 37 50       86 if (! exists($cache{$id})) {
268 37         67 push @routes, \%route;
269 37         127 $cache{$id}++;
270             }
271             }
272             }
273              
274 3         15 return \@routes;
275             }
276              
277             1;
278              
279             __END__