view release on metacpan or  search on metacpan

lib/Net/Libdnet6.pm  view on Meta::CPAN

   my $buf = `$_pathIfconfig $dev 2> /dev/null`;
   return unless $buf;

   my @ip6 = ();
   for (split('\n', $buf)) {
      my $prefixLenFound;
      my $lastIp6;
      for (split(/\s+/)) {
         s/(?:%[a-z0-9]+)$//; # This removes %lnc0 on BSD systems

         # Some Linux systems do not put the prefix with /number
         if (/^[0-9a-f:]+$/i && Net::IPv6Addr::is_ipv6($_)) {
            $lastIp6 = lc($_);
         }
         # Some newer Linux systems do it
         elsif (/^[0-9a-f:]+\/(\d+)$/i && Net::IPv6Addr::is_ipv6($_)) {
            $lastIp6 = lc($_);
         }

         # Gather prefixlen on *BSD systems
         if (/^\d+$/ && $prefixLenFound) {
            $lastIp6 .= '/'.$_;
            --$prefixLenFound;
         }
         ++$prefixLenFound if /^prefixlen$/i;
      }
      push @ip6, $lastIp6 if $lastIp6;
   }

   # We return the first IP as the main address, others as aliases
   if (@ip6 > 1) {
      return $ip6[0], [ @ip6[1..$#ip6] ];
   }
   elsif (@ip6 == 1) {
      return $ip6[0];
   }
   return;
}

sub intf_get6 {
   my $dev = shift;

   confess('Usage: intf_get6($networkInterface)'."\n")
      unless $dev;

   my $dnet = intf_get($dev) or return;
   my ($ip, $aliases) = _get_ip6($dev);
   $dnet->{addr6}    = $ip      if $ip;
   $dnet->{aliases6} = $aliases if $aliases;

   return $dnet;
}

# XXX: not supported yet
sub _get_routes_other { return; }

sub _get_routes_linux {
   return unless $_pathNetstat;

   my $buf = `$_pathNetstat -rnA inet6 2> /dev/null`;
   return unless $buf;

   my @ifRoutes = ();
   my %devIps;
   for (split('\n', $buf)) {
      my @elts = split(/\s+/);
      if ($elts[0]) {
         if ($elts[0] eq '::/0') { # Default route
            my $route = {
               destination => 'default',
               interface   => $elts[-1],
            };
            if (Net::IPv6Addr::is_ipv6($elts[1])) {
               $route->{nextHop} = $elts[1];
            }
            push @ifRoutes, $route;
         }
         elsif (Net::IPv6Addr::is_ipv6($elts[0])) {
            my $route = {
               destination => $elts[0],
               interface   => $elts[-1],
            };
            if (Net::IPv6Addr::is_ipv6($elts[1])) {
               $route->{nextHop} = $elts[1];
            }
            push @ifRoutes, $route;
         }
      }
   }

   if (@ifRoutes > 1) {
      return \@ifRoutes;
   }

   return;
}

sub _get_routes_bsd {
   return unless $_pathNetstat;

   my $buf = `$_pathNetstat -rnf inet6 2> /dev/null`;
   return unless $buf;

   my @ifRoutes = ();
   my %devIps;
   for (split('\n', $buf)) {
      my @elts = split(/\s+/);

      my $destination = $elts[0] || undef;
      my $gateway = $elts[1] || undef;
      my $flags = $elts[2] || undef;
      my $if = $elts[3] || undef;

      if (defined($destination)) {
         $destination =~ s/%[a-z]+[0-9]+//;
      }
      if (defined($gateway)) {
         $gateway =~ s/%[a-z]+[0-9]+//;
      }

      next if ! defined($destination);

      # FreeBSD > 9.x has a new scheme for default routes:
      # it uses the MAC address of default interface
      if ($gateway
      &&  $gateway =~ /^[a-z0-9]{2}:[a-z0-9]{2}:[a-z0-9]{2}:[a-z0-9]{2}:[a-z0-9]{2}:[a-z0-9]{2}$/i) {
         my $route = {
            destination => 'default',
            interface => $if,
         };
         if (Net::IPv6Addr::is_ipv6($elts[1])) {
            $route->{nextHop} = $destination;
         }
         push @ifRoutes, $route;
      }
      elsif (Net::IPv6Addr::is_ipv6($destination)) {
         my $route = {
            destination => $destination,
            interface   => $if,
         };
         if (Net::IPv6Addr::is_ipv6($gateway)) {
            $route->{nextHop} = $gateway;
         }
         push @ifRoutes, $route;
      }
      elsif ($destination eq 'default') {
         my $route = {
            destination => $destination,
            interface => $if,
         };
         if (Net::IPv6Addr::is_ipv6($gateway)) {
            $route->{nextHop} = $gateway;
         }
         push @ifRoutes, $route;
      }
   }

   if (@ifRoutes > 1) {
      return \@ifRoutes;
   }