File Coverage

blib/lib/Net/Write/Layer.pm

Criterion	Covered	Total	%
statement	65	77	84.4
branch	10	24	41.6
condition	14	53	26.4
subroutine	18	18	100.0
pod			n/a
total	107	172	62.2

#
# $Id: Layer.pm 2005 2015-01-23 06:56:13Z gomor $
#
package Net::Write::Layer;
use strict;
use warnings;

use base qw(Exporter Class::Gomor::Array);
our @AS = qw(
   dev
   dst
   protocol
   family
   _io
   _sockaddr
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

sub _setIpProtoIpConstant {
   my $val = 0;
   if (defined(&IPPROTO_IP)) {
      $val = &IPPROTO_IP;
   }
   elsif ($^O eq 'darwin'
      ||  $^O eq 'linux'
      ||  $^O eq 'freebsd'
      ||  $^O eq 'openbsd'
      ||  $^O eq 'netbsd'
      ||  $^O eq 'aix') {
      $val = 0;
   }
   eval "use constant NW_IPPROTO_IP => $val;";
}

sub _setIpProtoIpv6Constant {
   my $val = 0;
   if (defined(&IPPROTO_IPv6)) {
      $val = &IPPROTO_IPv6;
   }
   elsif ($^O eq 'linux'
      ||  $^O eq 'freebsd') {
      $val = 41;
   }
   eval "use constant NW_IPPROTO_IPv6 => $val;";
}

sub _setIpProtoRawConstant {
   my $val = 255;
   if (defined(&IPPROTO_RAW)) {
      $val = &IPPROTO_RAW;
   }
   elsif ($^O eq 'darwin'
      ||  $^O eq 'linux'
      ||  $^O eq 'freebsd'
      ||  $^O eq 'openbsd'
      ||  $^O eq 'netbsd'
      ||  $^O eq 'aix') {
      $val = 255;
   }
   eval "use constant NW_IPPROTO_RAW => $val;";
}

sub _setIpHdrInclConstant {
   my $val = 2;
   if (defined(&IP_HDRINCL)) {
      $val = &IP_HDRINCL;
   }
   elsif ($^O eq 'darwin'
      ||  $^O eq 'freebsd'
      ||  $^O eq 'openbsd'
      ||  $^O eq 'netbsd'
      ||  $^O eq 'linux'
      ||  $^O eq 'aix'
      ||  $^O eq 'cygwin') {
      $val = 2;
   }
   elsif ($^O eq 'hpux') {
      $val = 0x1002;
   }
   eval "use constant NW_IP_HDRINCL => $val;";
}

#
# ACF - This could result in NW_AF_INET6 => 0 if neither
# Socket6::AF_INET6 nor Socket::AF_INET6 is defined.  My change
# doesn't preserve that, but it isn't clear that was an intended or
# useful feature.
#
#sub _setAfinet6Constant {
#   require Socket6;
#   require Socket;
#   my $val = 0;
#   if (defined(&Socket6::AF_INET6)) {
#      $val = &Socket6::AF_INET6;
#   }
#   elsif (defined(&Socket::AF_INET6)) {
#      $val = &Socket::AF_INET6;
#   }
#   eval "use constant NW_AF_INET6  => $val;";
#}

BEGIN {
   my $osname = {
      cygwin  => \&_checkWin32,
      MSWin32 => \&_checkWin32,
   };

   {
     no strict 'refs';
     *{ __PACKAGE__ . "::_check" } = $osname->{$^O} || \&_checkOther;
   }
   _setIpProtoIpConstant();
   _setIpProtoIpv6Constant();
   _setIpProtoRawConstant();
   _setIpHdrInclConstant();
   #_setAfinet6Constant();
}

use Socket qw(:DEFAULT AF_INET);
BEGIN {
    # imports that may or may not be in Socket.
    my @imports = (qw(AF_INET6 getaddrinfo));
    my @socket6_imports;

    # This might be overkill, but I'm not certain that all these imports
    # were added to Socket at the same time.
    for my $import (@imports) {
        eval { Socket->import($import); };
        if ($@) {
            push @socket6_imports, $import;
        }
    }

    if (@socket6_imports) {

        # something we want wasn't found in Socket time to try Socket6
        eval { require Socket6 };
        die $@ if $@;
        Socket6->import(@socket6_imports);
    }
}

no strict 'vars';

use IO::Socket;
use Net::Pcap;

use constant NW_AF_INET   => AF_INET();
use constant NW_AF_INET6  => AF_INET6();
use constant NW_AF_UNSPEC => AF_UNSPEC();

use constant NW_IPPROTO_ICMPv4 => 1;
use constant NW_IPPROTO_TCP    => 6;
use constant NW_IPPROTO_UDP    => 17;
use constant NW_IPPROTO_ICMPv6 => 58;

our %EXPORT_TAGS = (
   constants => [qw(
      NW_AF_INET
      NW_AF_INET6
      NW_AF_UNSPEC
      NW_IPPROTO_IP
      NW_IPPROTO_IPv6
      NW_IPPROTO_ICMPv4
      NW_IPPROTO_TCP
      NW_IPPROTO_UDP
      NW_IPPROTO_ICMPv6
      NW_IP_HDRINCL
      NW_IPPROTO_RAW
   )],
);

our @EXPORT_OK = (
   @{$EXPORT_TAGS{constants}},
);

sub _checkWin32 {
   return 1;
}

sub _checkOther {
   if ($>) {
      print STDERR "[-] Must be EUID 0 (or equivalent) to open a device for ".
                   "writing.\n";
      return;
   }

   return 1;
}

sub new {
   my $self = shift->SUPER::new(
      @_,
   );

   _check() or return;

   return $self;
}

sub _croak {
   my ($msg) = @_;
   print STDERR "[-] $msg\n";
   return;
}

sub open {
   my $self = shift;
   my ($hdrincl) = @_;

   my @res = getaddrinfo($self->[$__dst], 0, $self->[$__family], SOCK_STREAM)
      or return _croak("@{[(caller(0))[3]]}: getaddrinfo: $!");

   my ($family, $saddr) = @res[0, 3] if @res >= 5;
   $self->[$___sockaddr] = $saddr;

   socket(my $s, $family, SOCK_RAW, $self->[$__protocol])
      or return _croak("@{[(caller(0))[3]]}: socket: $!");

   my $fd = fileno($s)
      or return _croak("@{[(caller(0))[3]]}: fileno: $!");

   if ($hdrincl) {
      $self->_setIpHdrincl($s, $self->[$__family])
         or return _croak("@{[(caller(0))[3]]}: setsockopt: $!");
   }

   my $io = IO::Socket->new;
   $io->fdopen($fd, 'w')
      or return _croak("@{[(caller(0))[3]]}: fdopen: $!");

   $self->[$___io] = $io;

   return 1;
}

sub send {
   my $self = shift;
   my ($raw) = @_;

   while (1) {
      my $ret = CORE::send($self->_io, $raw, 0, $self->_sockaddr);
      unless ($ret) {
         if ($!{ENOBUFS}) {
            $self->cgDebugPrint(2, "ENOBUFS returned, sleeping for 1 second");
            sleep 1;
            next;
         }
         elsif ($!{EHOSTDOWN}) {
            $self->cgDebugPrint(2, "host is down");
            last;
         }
         print STDERR "[!] @{[(caller(0))[3]]}: $!\n";
         return;
      }
      last;
   }

   return 1;
}

sub close { shift->_io->close }

1;

__END__