File Coverage

blib/lib/Net/Routing/FreeBSD.pm
Criterion Covered Total %
statement 130 134 97.0
branch 43 50 86.0
condition 19 21 90.4
subroutine 10 10 100.0
pod 1 1 100.0
total 203 216 93.9


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