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 51897565ff32 2015/02/09 20:41:56 gomor $
3             #
4             package Net::Routing::FreeBSD;
5 5     5   18390 use strict;
  5         8  
  5         193  
6 5     5   29 use warnings;
  5         6  
  5         256  
7              
8             our $VERSION = '0.41';
9              
10 5     5   31 use base qw(Net::Routing::Linux);
  5         7  
  5         1866  
11              
12 5     5   27 use Net::CIDR;
  5         7  
  5         172  
13 5     5   26 use Net::IPv4Addr;
  5         6  
  5         135  
14 5     5   19 use Net::IPv6Addr;
  5         7  
  5         145  
15 5     5   20 use Net::Routing qw($Error :constants);
  5         7  
  5         5991  
16              
17             sub get {
18 3     3 1 6 my $self = shift;
19              
20 3         6 my $bin = '';
21 3         4 for my $path (@{$self->path}) {
  3         11  
22 3 50       81 if (-f "$path/netstat") {
23 3         5 $bin = "$path/netstat";
24 3         6 last;
25             }
26             }
27 3 50       13 if (! length($bin)) {
28 0         0 $Error = "unable to find netstat command from current PATH";
29 0         0 return;
30             }
31              
32 3         9 my $cmd4 = [ $bin, '-rnf', 'inet' ];
33 3         10 my $cmd6 = [ $bin, '-rnf', 'inet6' ];
34              
35 3         21 return $self->SUPER::get($cmd4, $cmd6);
36             }
37              
38             sub _get_inet4 {
39 3     3   405 my $self = shift;
40 3         7 my ($lines) = @_;
41              
42 3         9 my @routes = ();
43 3         10 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       151 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         7 $freebsd_version = '9.x';
66 2         5 next;
67             }
68              
69 28         87 my @toks = split(/\s+/, $line);
70              
71 28         34 my ($route, $gateway, $flags, $refs, $use, $interface, $expire);
72              
73 28 100       46 if ($freebsd_version eq '9.x') {
74 15         13 $route = $toks[0];
75 15         11 $gateway = $toks[1];
76 15         16 $flags = $toks[2];
77 15         12 $refs = $toks[3];
78 15         12 $use = $toks[4];
79 15         15 $interface = $toks[5];
80 15         14 $expire = $toks[6];
81             }
82             else { # Default to FreeBSD 10.x
83 13         12 $route = $toks[0];
84 13         13 $gateway = $toks[1];
85 13         14 $flags = $toks[2];
86 13         11 $interface = $toks[3];
87 13         14 $expire = $toks[4];
88             }
89              
90 28 100 100     204 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       33 if ($route eq 'default') {
95 3         41 $route = '0.0.0.0/0';
96             }
97 19 100       47 if ($gateway =~ /^link/) {
98 10         12 $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     111 if ($gateway !~ m{^[0-9\.]+$} || $route !~ m{^[0-9\.]+(?:/\d+)?$}) {
117 3         5 next;
118             }
119              
120             # Normalize IP addresses
121 16         59 $route = Net::CIDR::range2cidr($route); # 127.16 => 172.16/16
122 16         1280 $route = Net::CIDR::cidrvalidate($route); # 172.16/16 => 172.16.0.0/16
123              
124 16         5418 eval {
125 16         52 my ($ip1, $cidr1) = Net::IPv4Addr::ipv4_parse($route);
126 16         655 my ($ip2, $cidr2) = Net::IPv4Addr::ipv4_parse($gateway);
127             };
128 16 50       386 if ($@) {
129             #chomp($@);
130             #print "*** DEBUG[$@]\n";
131 0         0 next; # Not a valid line for us.
132             }
133              
134             # Ok, proceed.
135 16         71 my %route = (
136             route => $route,
137             gateway => $gateway,
138             interface => $interface,
139             );
140              
141             # Default route
142 16 100       38 if ($route eq '0.0.0.0/0') {
143 3         9 $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         20 $route{local} = 1;
150 10         16 $route{gateway} = NR_LOCAL_ROUTE4();
151             }
152              
153 16 50       64 if ($route{route} !~ /\/\d+$/) {
154 0         0 $route{route} .= '/32';
155             }
156              
157 16         76 my $id = $self->_to_psv(\%route);
158 16 50       36 if (! exists($cache{$id})) {
159             #print STDERR "*** DEBUG new $id\n";
160 16         20 push @routes, \%route;
161 16         63 $cache{$id}++;
162             }
163             }
164             }
165              
166 3         11 return \@routes;
167             }
168              
169             sub _get_inet6 {
170 3     3   368 my $self = shift;
171 3         6 my ($lines) = @_;
172              
173 3         5 my @routes = ();
174 3         6 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         139 my @toks = split(/\s+/, $line);
193              
194 58         63 my $route = $toks[0];
195 58         53 my $gateway = $toks[1];
196 58         37 my $flag = $toks[2];
197 58         44 my $interface = $toks[3];
198 58         50 my $expire = $toks[4];
199              
200 58 100 100     269 if (defined($route) && defined($gateway) && defined($interface)) {
      100        
201             # Convert FreeBSD strings to universal IP addresses
202 49 100 100     193 if ($gateway =~ /^link/ || $gateway eq '::1') {
203 38         68 $gateway = '::';
204             }
205 49 100       75 if ($route eq 'default') {
206 1         3 $route = '::/0';
207             }
208             # Strip interface name from route
209 49         100 $route =~ s/%[a-z]+\d+//g;
210              
211             # Special case: an entry with a MAC address means a default gateway
212 49 100       96 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         73 my %route = (
214             route => NR_DEFAULT_ROUTE6(),
215             gateway => $route,
216             interface => $interface,
217             );
218 2         20 my $id = $self->_to_psv(\%route);
219 2 50       10 if (! exists($cache{$id})) {
220 2         4 push @routes, \%route;
221 2         7 $cache{$id}++;
222             }
223             }
224              
225             # A first sanity check to help Net::IPv6Addr
226 49 100 66     231 if ($route !~ m{^[0-9a-f:/]+$}i || $gateway !~ m{^[0-9a-f:/]+$}i) {
227 10         17 next;
228             }
229              
230             #print STDERR "*** DEBUG $route $gateway $interface\n";
231              
232 39         47 eval {
233             #print "*** DEBUG $route $gateway\n";
234 39         92 my $ip1 = Net::IPv6Addr::ipv6_parse($route);
235 39         1290 my $ip2 = Net::IPv6Addr::ipv6_parse($gateway);
236             };
237 39 100       1390 if ($@) {
238             #chomp($@);
239             #print "*** DEBUG[$@]\n";
240 2         6 next; # Not a valid line for us.
241             }
242              
243             # Ok, proceed.
244 37         118 my %route = (
245             route => $route,
246             gateway => $gateway,
247             interface => $interface,
248             );
249              
250             # Default route
251 37 100       62 if ($route eq '::/0') {
252 1         2 $route{default} = 1;
253 1         3 $route{route} = NR_DEFAULT_ROUTE6();
254             }
255              
256             # Local subnet
257 37 100       60 if ($gateway eq '::') {
258 36         53 $route{local} = 1;
259 36         43 $route{gateway} = NR_LOCAL_ROUTE6();
260             }
261              
262 37 100       96 if ($route{route} !~ /\/\d+$/) {
263 14         20 $route{route} .= '/128';
264             }
265              
266 37         108 my $id = $self->_to_psv(\%route);
267 37 50       74 if (! exists($cache{$id})) {
268 37         46 push @routes, \%route;
269 37         189 $cache{$id}++;
270             }
271             }
272             }
273              
274 3         12 return \@routes;
275             }
276              
277             1;
278              
279             __END__