File Coverage

blib/lib/Paranoid/Network/IPv4.pm

Criterion	Covered	Total	%
statement	107	109	98.1
branch	28	34	82.3
condition	13	21	61.9
subroutine	21	21	100.0
pod	5	5	100.0
total	174	190	91.5

# Paranoid::Network::IPv4 -- IPv4-specific network functions
#
# $Id: lib/Paranoid/Network/IPv4.pm, 2.10 2022/03/08 00:01:04 acorliss Exp $
#
# This software is free software.  Similar to Perl, you can redistribute it
# and/or modify it under the terms of either:
#
#   a)     the GNU General Public License
#           as published by the
#          Free Software Foundation ; either version 1
#          , or any later version
#          , or
#   b)     the Artistic License 2.0
#          ,
#
# subject to the following additional term:  No trademark rights to
# "Paranoid" have been or are conveyed under any of the above licenses.
# However, "Paranoid" may be used fairly to describe this unmodified
# software, in good faith, but not as a trademark.
#
# (c) 2005 - 2020, Arthur Corliss ([e-mail])
# (tm) 2008 - 2020, Paranoid Inc. (www.paranoid.com)
#
#####################################################################

#####################################################################
#
# Environment definitions
#
#####################################################################

package Paranoid::Network::IPv4;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
use Paranoid;
use Paranoid::Debug qw(:all);
use Paranoid::Network::Socket;

my @base      = qw(ipv4NetConvert ipv4NetIntersect);
my @constants = qw(MAXIPV4CIDR IPV4REGEX IPV4CIDRRGX IPV4BASE IPV4BRDCST
    IPV4MASK);
my @ipv4sort = qw(ipv4NumSort ipv4StrSort ipv4PackedSort);

($VERSION) = ( q$Revision: 2.10 $ =~ /(\d+(?:\.\d+)+)/sm );
@EXPORT      = @base;
@EXPORT_OK   = ( @base, @constants, @ipv4sort );
%EXPORT_TAGS = (
    all       => [@EXPORT_OK],
    base      => [@base],
    constants => [@constants],
    ipv4Sort  => [@ipv4sort],
    );

use constant MAXIPV4CIDR => 32;
use constant IPV4REGEX =>
    qr/(?:(?:25[0-5]|2[0-4][0-9]|1?\d\d?)\.){3}(?:25[0-5]|2[0-4][0-9]|1?\d\d?)/s;
use constant IPV4CIDRRGX =>
    qr#@{[ IPV4REGEX ]}/(?:(?:3[0-2]|[12]?\d)|@{[ IPV4REGEX ]})#s;
use constant FULLMASK   => 0xffffffff;
use constant IPV4BASE   => 0;
use constant IPV4BRDCST => 1;
use constant IPV4MASK   => 2;

#####################################################################
#
# Module code follows
#
#####################################################################

sub ipv4NetConvert {

    # Purpose:  Takes a string representation of an IPv4 network
    #           address and returns a list containing the binary
    #           network address, broadcast address, and netmask.
    #           Also allows for a plain IP being passed, in which
    #           case it only returns the binary IP.
    # Returns:  Array, empty on errors
    # Usage:    @network = ipv4NetConvert($netAddr);

    my $netAddr = shift;
    my ( $bnet, $bmask, $t, @rv );

    subPreamble( PDLEVEL1, '$', $netAddr );

    # Extract net address, mask
    if ( defined $netAddr ) {
        ($t) = ( $netAddr =~ m#^(@{[ IPV4CIDRRGX ]}|@{[ IPV4REGEX ]})$#s )[0];
        ( $bnet, $bmask ) = split m#/#s, $t if defined $t;
    }

    if ( defined $bnet and length $bnet ) {

        # First, convert $bnet to see if we have a valid IP address
        $bnet = unpack 'N', inet_aton($bnet);

        if ( defined $bnet and length $bnet ) {

            # Save our network address
            push @rv, $bnet;

            if ( defined $bmask and length $bmask ) {

                # Convert netmask
                $bmask =
                      $bmask !~ /^\d+$/s ? unpack 'N', inet_aton($bmask)
                    : $bmask <= MAXIPV4CIDR
                    ? FULLMASK - ( ( 2**( MAXIPV4CIDR - $bmask ) ) - 1 )
                    : undef;

                if ( defined $bmask and length $bmask ) {

                    # Apply the mask to the base address
                    $rv[IPV4BASE] = $rv[IPV4BASE] & $bmask;

                    # Calculate and save our broadcast address
                    push @rv, $bnet | ( $bmask ^ FULLMASK );

                    # Save our mask
                    push @rv, $bmask;

                } else {
                    pdebug( 'invalid netmask passed', PDLEVEL1 );
                }
            }
        } else {
            pdebug( 'failed to convert IPv4 address', PDLEVEL1 );
        }
    } else {
        pdebug( 'failed to extract an IPv4 address', PDLEVEL1 );
    }

    subPostamble( PDLEVEL1, '@', @rv );

    return @rv;
}

sub ipv4NetIntersect {

    # Purpose:  Tests whether network address ranges intersect
    # Returns:  Integer, denoting whether an intersection exists, and what
    #           kind:
    #
    #              -1: destination range encompasses target range
    #               0: both ranges do not intersect at all
    #               1: target range encompasses destination range
    #
    # Usage:    $rv = ipv4NetIntersect($net1, $net2);

    my $tgt  = shift;
    my $dest = shift;
    my $rv   = 0;
    my ( @tnet, @dnet );

    subPreamble( PDLEVEL1, '$$', $tgt, $dest );

    # Bypas if one or both isn't defined -- obviously no intersection
    unless ( !defined $tgt or !defined $dest ) {

        # Convert addresses (also allows for raw IPs (32bit integers) to be
        # passed)
        @tnet = $tgt  =~ /^\d+$/s ? ($tgt)  : ipv4NetConvert($tgt);
        @dnet = $dest =~ /^\d+$/s ? ($dest) : ipv4NetConvert($dest);

        # insert bogus numbers for non IP-address info
        @tnet = (-1) unless scalar @tnet;
        @dnet = (-2) unless scalar @dnet;

        # Dummy up broadcast address for those single IPs passed (in lieu of
        # network ranges)
        $tnet[IPV4BRDCST] = $tnet[IPV4BASE] if $#tnet == 0;
        $dnet[IPV4BRDCST] = $dnet[IPV4BASE] if $#dnet == 0;

        if (    $tnet[IPV4BASE] <= $dnet[IPV4BASE]
            and $tnet[IPV4BRDCST] >= $dnet[IPV4BRDCST] ) {

            # Target fully encapsulates dest
            $rv = 1;

        } elsif ( $tnet[IPV4BASE] >= $dnet[IPV4BASE]
            and $tnet[IPV4BRDCST] <= $dnet[IPV4BRDCST] ) {

            # Dest fully encapsulates target
            $rv = -1;

        }
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

{

    no strict 'refs';

    sub ipv4NumSort {

        # Purpose:  Sorts IPv4 addresses represented in numeric form
        # Returns:  -1, 0, 1
        # Usage:    @sorted = sort &ipv4NumSort @ipv4;

        my ($pkg) = caller;

        return ${"${pkg}::a"} <=> ${"${pkg}::b"};
    }

    sub ipv4PackedSort {

        # Purpose:  Sorts IPv4 addresses represented in packed strings
        # Returns:  -1, 0, 1
        # Usage:    @sorted = sort &ipv4PackedSort @ipv4;

        my ($pkg) = caller;

        my $a1 = unpack 'N', ${"${pkg}::a"};
        my $b1 = unpack 'N', ${"${pkg}::b"};

        return $a1 <=> $b1;
    }

    sub ipv4StrSort {

        # Purpose:  Sorts IPv4 addresses represented in string form
        # Returns:  -1, 0, 1
        # Usage:    @sorted = sort &ipv4StrSort @ipv4;

        my ($pkg) = caller;

        my $a1 = ${"${pkg}::a"};
        my $b1 = ${"${pkg}::b"};

        $a1 =~ s#/.+##s;
        $a1 = unpack 'N', inet_aton($a1);
        $b1 =~ s#/.+##s;
        $b1 = unpack 'N', inet_aton($b1);

        return $a1 <=> $b1;
    }
}

1;

__END__