File Coverage

blib/lib/Net/Routing/NetBSD.pm
Criterion Covered Total %
statement 96 108 88.8
branch 28 40 70.0
condition 16 21 76.1
subroutine 9 9 100.0
pod n/a
total 149 178 83.7


line stmt bran cond sub pod time code
1             #
2             # $Id: NetBSD.pm,v 05d886dffb1a 2015/02/20 05:58:44 gomor $
3             #
4             package Net::Routing::NetBSD;
5 2     2   4753 use strict;
  2         3  
  2         57  
6 2     2   6 use warnings;
  2         3  
  2         76  
7              
8             our $VERSION = '0.43';
9              
10 2     2   10 use base qw(Net::Routing::FreeBSD);
  2         2  
  2         442  
11              
12 2     2   14 use Net::IPv4Addr;
  2         3  
  2         77  
13 2     2   10 use Net::IPv6Addr;
  2         3  
  2         60  
14 2     2   9 use Net::CIDR;
  2         2  
  2         73  
15 2     2   9 use Net::Routing qw($Error :constants);
  2         4  
  2         2267  
16              
17             sub _get_inet4 {
18 1     1   54 my $self = shift;
19 1         2 my ($lines) = @_;
20              
21 1         2 my @routes = ();
22 1         2 my %cache = ();
23              
24             # NetBSD
25             # Destination Gateway Flags Refs Use Mtu Interface
26             # default 208.44.95.1 UGS 0 330309 1500 ex0
27              
28 1         3 for my $line (@$lines) {
29 9         23 my @toks = split(/\s+/, $line);
30              
31 9         9 my ($route, $gateway, $flags, $refs, $use, $mtu, $interface);
32              
33 9         8 $route = $toks[0];
34 9         6 $gateway = $toks[1];
35 9         8 $flags = $toks[2];
36 9         6 $refs = $toks[3];
37 9         5 $use = $toks[4];
38 9         7 $mtu = $toks[5];
39 9         7 $interface = $toks[6];
40              
41 9 100 100     44 if (defined($route) && defined($gateway) && defined($interface)) {
      100        
42             #print STDERR "*** DEBUG $route $gateway $interface\n";
43              
44             # Convert NetBSD strings to "universal" IP addresses
45 6 100       10 if ($route eq 'default') {
46 1         2 $route = '0.0.0.0/0';
47             }
48 6 100       13 if ($gateway =~ /^link/) {
49 1         2 $gateway = '0.0.0.0';
50             }
51              
52             # A first sanity check to help Net::IPv4Addr
53 6 100 66     35 if ($gateway !~ m{^[0-9\.]+$} || $route !~ m{^[0-9\.]+(?:/\d+)?$}) {
54             #print STDERR "*** SKIP [$gateway] [$route]\n";
55 1         2 next;
56             }
57              
58             # Normalize IP addresses
59 5         12 $route = Net::CIDR::range2cidr($route); # 127.16 => 172.16/16
60 5         302 $route = Net::CIDR::cidrvalidate($route); # 172.16/16 => 172.16.0.0/16
61              
62 5         1675 eval {
63 5         13 my ($ip1, $cidr1) = Net::IPv4Addr::ipv4_parse($route);
64 5         163 my ($ip2, $cidr2) = Net::IPv4Addr::ipv4_parse($gateway);
65             };
66 5 50       94 if ($@) {
67             #chomp($@);
68             #print "*** DEBUG[$@]\n";
69 0         0 next; # Not a valid line for us.
70             }
71              
72             # Ok, proceed.
73 5         15 my %route = (
74             route => $route,
75             gateway => $gateway,
76             interface => $interface,
77             );
78              
79             # Default route
80 5 100       7 if ($route eq '0.0.0.0/0') {
81 1         3 $route{default} = 1;
82 1         2 $route{route} = NR_DEFAULT_ROUTE4();
83             }
84              
85             # Local subnet
86 5 100       9 if ($gateway eq '0.0.0.0') {
87 1         1 $route{local} = 1;
88 1         3 $route{gateway} = NR_LOCAL_ROUTE4();
89             }
90              
91 5 50       15 if ($route{route} !~ /\/\d+$/) {
92 0         0 $route{route} .= '/32';
93             }
94              
95 5         23 my $id = $self->_to_psv(\%route);
96 5 50       11 if (! exists($cache{$id})) {
97             #print STDERR "*** DEBUG new $id\n";
98 5         6 push @routes, \%route;
99 5         14 $cache{$id}++;
100             }
101             }
102             }
103              
104 1         15 return \@routes;
105             }
106              
107             sub _get_inet6 {
108 1     1   147 my $self = shift;
109 1         2 my ($lines) = @_;
110              
111 1         2 my @routes = ();
112 1         2 my %cache = ();
113              
114             # NetBSD
115             # Internet6:
116             # Destination Gateway Flags Refs Use Mtu Interface
117             # ::/104 ::1 UGRS 0 0 33228 lo0 =>
118             # ::/96 ::1 UGRS 0 0
119              
120 1         3 for my $line (@$lines) {
121 4         63 my @toks = split(/\s+/, $line);
122              
123 4         5 my $route = $toks[0];
124 4         4 my $gateway = $toks[1];
125 4         2 my $flags = $toks[2];
126 4         4 my $refs = $toks[3];
127 4         3 my $use = $toks[4];
128 4         6 my $mtu = $toks[5];
129 4         4 my $interface = $toks[6];
130              
131 4 100 66     20 if (defined($route) && defined($gateway) && defined($interface)) {
      66        
132             # Convert NetBSD strings to "universal" IP addresses
133 3 100 66     11 if ($gateway =~ /^link/ || $gateway eq '::1') {
134 2         1 $gateway = '::';
135             }
136 3 50       6 if ($route eq 'default') {
137 0         0 $route = '::/0';
138             }
139              
140             # Special case: an entry with a MAC address means a default gateway
141 3 50       6 if ($gateway =~ /^[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}:[a-f0-9]{2}$/) {
142 0         0 my %route = (
143             route => NR_DEFAULT_ROUTE6(),
144             gateway => $route,
145             interface => $interface,
146             );
147 0         0 my $id = $self->_to_psv(\%route);
148 0 0       0 if (! exists($cache{$id})) {
149 0         0 push @routes, \%route;
150 0         0 $cache{$id}++;
151             }
152             }
153              
154             # A first sanity check to help Net::IPv6Addr
155 3 100 66     20 if ($route !~ m{^[0-9a-f:/]+$}i || $gateway !~ m{^[0-9a-f:/]+$}i) {
156 1         2 next;
157             }
158              
159             #print STDERR "*** DEBUG $route $gateway $interface\n";
160              
161 2         2 eval {
162             #print "*** DEBUG $route $gateway\n";
163 2         7 my $ip1 = Net::IPv6Addr::ipv6_parse($route);
164 2         84 my $ip2 = Net::IPv6Addr::ipv6_parse($gateway);
165             };
166 2 50       51 if ($@) {
167             #chomp($@);
168             #print "*** DEBUG[$@]\n";
169 0         0 next; # Not a valid line for us.
170             }
171              
172             # Ok, proceed.
173 2         7 my %route = (
174             route => $route,
175             gateway => $gateway,
176             interface => $interface,
177             );
178              
179             # Default route
180 2 50       3 if ($route eq '::/0') {
181 0         0 $route{default} = 1;
182 0         0 $route{route} = NR_DEFAULT_ROUTE6();
183             }
184              
185             # Local subnet
186 2 50       5 if ($gateway eq '::') {
187 2         3 $route{local} = 1;
188 2         2 $route{gateway} = NR_LOCAL_ROUTE6();
189             }
190              
191 2 50       7 if ($route{route} !~ /\/\d+$/) {
192 0         0 $route{route} .= '/128';
193             }
194              
195 2         6 my $id = $self->_to_psv(\%route);
196 2 50       5 if (! exists($cache{$id})) {
197 2         2 push @routes, \%route;
198 2         5 $cache{$id}++;
199             }
200             }
201             }
202              
203 1         23 return \@routes;
204             }
205              
206             1;
207              
208             __END__