view release on metacpan or  search on metacpan

lib/Paranoid/Network/IPv6.pm  view on Meta::CPAN

my @base      = qw(ipv6NetConvert ipv6NetPacked ipv6NetIntersect);
my @constants = qw(MAXIPV6CIDR IPV6REGEX IPV6CIDRRGX IPV6BASE IPV6BRDCST
    IPV6MASK);
my @ipv6sort = qw(ipv6StrSort ipv6PackedSort ipv6NumSort);

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

use constant MAXIPV6CIDR => 128;
use constant IPV6REGEX   => qr/
                            :(?::[abcdef\d]{1,4}){1,7}                   | 
                            \b[abcdef\d]{1,4}(?:::?[abcdef\d]{1,4}){1,7} | 
                            (?:\b[abcdef\d]{1,4}:){1,7}: 
                            /six;
use constant IPV6CIDRRGX =>
    qr#@{[ IPV6REGEX ]}/(?:1(?:[01]\d|2[0-8])|\d\d?)#s;
use constant IPV6BASE   => 0;
use constant IPV6BRDCST => 1;
use constant IPV6MASK   => 2;
use constant CHUNKMASK  => 0xffffffff;
use constant CHUNK      => 32;
use constant IPV6CHUNKS => 4;
use constant IPV6LENGTH => 16;

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

sub ipv6NetConvert {

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

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

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

    if ( has_ipv6() or $] >= 5.012 ) {

        # Extract net address, mask
        if ( defined $netAddr ) {
            ($t) =
                ( $netAddr =~ m#^(@{[ IPV6CIDRRGX ]}|@{[ IPV6REGEX ]})$#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 'NNNN', inet_pton( AF_INET6(), $bnet ) ];

            if ( defined $bnet and length $bnet ) {

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

                if ( defined $bmask and length $bmask ) {

                    # Convert netmask
                    if ( $bmask <= MAXIPV6CIDR ) {

                        # Add the mask in 32-bit chunks
                        @tmp = ();
                        while ( $bmask >= CHUNK ) {
                            push @tmp, CHUNKMASK;
                            $bmask -= CHUNK;
                        }

                        # Push the final segment if there's a remainder
                        if ($bmask) {
                            push @tmp,
                                CHUNKMASK - ( ( 2**( CHUNK - $bmask ) ) - 1 );
                        }

                        # Add zero'd chunks to fill it out
                        while ( @tmp < IPV6CHUNKS ) {
                            push @tmp, 0x0;
                        }

                        # Finally, save the chunks
                        $bmask = [@tmp];

                    } else {
                        $bmask = undef;
                    }

                    if ( defined $bmask ) {

                        # Apply the mask to the base address
                        foreach ( 0 .. ( IPV6CHUNKS - 1 ) ) {
                            $$bnet[$_] &= $$bmask[$_];
                        }

                        # Calculate and save our broadcast address
                        @tmp = ();
                        foreach ( 0 .. ( IPV6CHUNKS - 1 ) ) {
                            $tmp[$_] =
                                $$bnet[$_] | ( $$bmask[$_] ^ CHUNKMASK );
                        }
                        push @rv, [@tmp];

                        # Save our mask
                        push @rv, $bmask;