#
# $Id: Routing.pm,v 48eb2bd4e445 2015/01/31 16:56:17 gomor $
#
package Net::Routing;
use strict;
use warnings;

our $VERSION = '0.20';

use base qw(Class::Gomor::Hash);

our @AS = qw(
   path
   lc_all
   target
   family
   _target_type
   _routing_module
   _routes
);
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

use Net::CIDR;
use Net::IPv4Addr;
use Net::IPv6Addr;

our $_routing_module;
our $Error;

use constant NR_DEFAULT_ROUTE4 => '0.0.0.0/0';
use constant NR_DEFAULT_ROUTE6 => '::/0';
use constant NR_LOCAL_ROUTE4 => '0.0.0.0';
use constant NR_LOCAL_ROUTE6 => '::';

our @EXPORT_OK = qw(
   $Error
   NR_DEFAULT_ROUTE4
   NR_DEFAULT_ROUTE6
   NR_LOCAL_ROUTE4
   NR_LOCAL_ROUTE6
);

BEGIN {
   if ($^O eq 'linux') {
      return $_routing_module = "Net::Routing::Linux";
   }
   elsif ($^O eq 'freebsd' || $^O eq 'darwin' || $^O eq 'netbsd' || $^O eq 'openbsd') {
      return $_routing_module = "Net::Routing::FreeBSD";
   }

   die("[-] Net::Routing: Operating System not supported: $^O\n");
}

sub new {
   my $self = shift->SUPER::new(
      path => [ qw(/bin /sbin /usr/bin /usr/sbin /usr/local/bin /usr/local/sbin) ],
      lc_all => 'en_GB.UTF-8',
      family => 'inet',
      @_,
   );

   my @path = qw(/bin /sbin /usr/bin /usr/sbin /usr/local/bin /usr/local/sbin);

   $ENV{LC_ALL} = $self->lc_all;
   $ENV{PATH} = join(':', $self->path);

   eval("use $_routing_module;");
   if ($@) {
      chomp($@);
      $Error = "unable to load routing module [$_routing_module]: $@";
      return;
   }

   $self->_routing_module($_routing_module);

   my $routes = defined($self->target) ? $self->_target : $self->_all;

   $self->_routes($routes);

   return $self;
}

sub _all {
   my $self = shift;

   my $target = $self->target;

   my $match = 0;
   my $target_type = '';

   # First we try to see if we want the default route
   if ($target && $target eq 'default') {
      $target_type = 'default';
      # and use family as provided on on new() family attribute
      $match = 1;
   }

   # Then we try target against an IPv4 address
   if (! $match && $target && $target =~ /^[0-9\.]+$/) {
      eval {
         my ($ip, $cidr) = Net::IPv4Addr::ipv4_parse($target);
      };
      if (! $@) {
         $target_type = 'ipv4';
         $self->family('inet');
         $match = 1;
      }
   }

   # If not match, we try against an IPv6 address
   if (! $match && $target && $target =~ /^[0-9a-f:\/]+$/i) {
      eval {
         my $x = Net::IPv6Addr::ipv6_parse($target);
      };
      if (! $@) {
         $target_type = 'ipv6';
         $self->family('inet6');
         $match = 1;
      }
   }

   # If it is not an IPv4 nor IPv6 address and not the default route,
   # we consider it is an interface.
   if (! $match && $target) {
      $target_type = 'interface';
      # and use family as provided on new() family attribute
      $match = 1;
   }

   # Else, we want all routes

   $self->_target_type($target_type);

   my $routing_module = $self->_routing_module;

   my $routing;
   eval {
      $routing = $routing_module->new(
         path => $self->path,
         family => $self->family,
      );
   };
   if ($@) {
      chomp($@);
      $Error = "unable to load module [$routing_module]: $@";
      return;
   }
   if (! defined($routing)) {
      return;
   }

   my $routes = $routing->get;
   if (! defined($routes)) {
      return;
   }

   return $routes;
}

sub _target {
   my $self = shift;

   my $routes = $self->_all;
   if (! defined($routes)) {
      return;
   }

   my $target = $self->target;
   my $target_type = $self->_target_type;

   # Return only wanted routes
   my @routes = ();
   for my $route (@$routes) {
      if ($target_type eq 'interface') {
         if ($route->{interface} eq $target) {
            push @routes, $route;
         }
      }
      elsif ($target_type eq 'default') {
         if ($route->{default}) {
            push @routes, $route;
         }
      }
      elsif ($target_type eq 'ipv4' || $target_type eq 'ipv6') {
         if ($route->{subnet}
         &&  Net::CIDR::cidrlookup($target, $route->{subnet})) {
            push @routes, $route;
         }
      }
   }

   # If no route matches, we will return the default route for types 'ipv4' and 'ipv6'
   if (@routes == 0 && ($target_type eq 'ipv4' || $target_type eq 'ipv6')) {
      for my $route (@$routes) {
         if ($route->{default}) {
            push @routes, $route;
         }
      }
   }

   return \@routes;
}

sub list {
   my $self = shift;

   printf("%-33s  %-33s  %-10s\n", "Route", "Gateway", "Interface");

   my $routes = $self->_routes;
   for my $route (@$routes) {
      my $route2 = $route->{route};
      my $gateway = $route->{gateway};
      my $interface = $route->{interface};

      printf("%-33s  %-33s  %-10s\n", $route2, $gateway, $interface);
   }

   return 1;
}

1;

__END__

=head1 NAME

Net::Routing - manage route entries on Operating Systems

=head1 SYNOPSIS

=head1 AUTHOR

Patrice E<lt>GomoRE<gt> Auffret

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2015, Patrice E<lt>GomoRE<gt> Auffret

You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.

=cut
