view release on metacpan or  search on metacpan

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

    return $rv;
}

sub hostInDomains {

    # Purpose:  Checks to see if the host occurs in the list of domains
    # Returns:  True (1) if the host occurs, False (0) otherwise
    # Usage:    $rv = hostInDomains($hostname, @domains);

    my $host    = shift;
    my @domains = @_;
    my $rv      = 0;
    my $domain;

    subPreamble( PDLEVEL1, '$@', $host, @domains );

    NETMATCH = undef;

    if ( defined $host and $host =~ /^@{[ HOSTNAME_REGEX ]}$/so ) {

        # Filter out non-domains
        @domains =
            grep { defined $_ && m/^@{[ HOSTNAME_REGEX ]}$/so } @domains;

        # Start the comparison
        if (@domains) {
            foreach $domain (@domains) {
                if ( $host =~ /^(?:[\w\-]+\.)*\Q$domain\E$/si ) {
                    NETMATCH = $domain;
                    $rv = 1;
                    last;
                }
            }
        }
    }

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

    return $rv;
}

sub extractIPs {

    # Purpose:  Extracts IPv4/IPv6 addresses from arbitrary text.
    # Returns:  List containing extracted IP addresses
    # Usage:    @ips = extractIPs($string1, $string2);

    my @strings = @_;
    my ( $string, @ips, $ip, @tmp, @rv );

    subPreamble( PDLEVEL1, '@', @strings );

    foreach $string (@strings) {
        next unless defined $string;

        # Look for IPv4 addresses
        @ips = ( $string =~ /(@{[ IPV4CIDRRGX ]}|@{[ IPV4REGEX ]})/sog );

        # Validate them by filtering through inet_aton
        foreach $ip (@ips) {
            @tmp = split m#/#s, $ip;
            push @rv, $ip if defined inet_aton( $tmp[0] );
        }

        # If Socket6 is present or we have Perl 5.14 or higher we'll check
        # for IPv6 addresses
        if ( has_ipv6() or $] >= 5.012 ) {

            @ips =
                ( $string =~ m/(@{[ IPV6CIDRRGX ]}|@{[ IPV6REGEX ]})/sogix );

            # Filter out addresses with more than one ::
            @ips = grep { scalar(m/(::)/sg) <= 1 } @ips;

            # Validate remaining addresses with inet_pton
            foreach $ip (@ips) {
                @tmp = split m#/#s, $ip;
                push @rv, $ip
                    if defined inet_pton( AF_INET6(), $tmp[0] );
            }
        }
    }

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

    return @rv;
}

sub netIntersect {

    # 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 = netIntersect( $cidr1, $cidr2 );

    my $target = shift;
    my $dest   = shift;
    my $rv     = 0;

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

    if ( defined $target and defined $dest ) {
        if ( $target =~ m/^(?:@{[ IPV4CIDRRGX ]}|@{[ IPV4REGEX ]})$/s ) {
            $rv = ipv4NetIntersect( $target, $dest );
        } elsif ( $target =~ m/^(?:@{[ IPV6CIDRRGX ]}|@{[ IPV6REGEX ]})$/si )
        {
            $rv = ipv6NetIntersect( $target, $dest )
                if has_ipv6()
                    or $] >= 5.012;
        } else {
            pdebug(
                'target string (%s) doesn\'t seem to match '
                    . 'an IP/network address',
                PDLEVEL1, $target
                );
        }
    } else {
        pdebug( 'one or both arguments are not defined', PDLEVEL1 );
    }

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

    return $rv;
}

1;

__END__

=head1 NAME

Paranoid::Network - Network functions for paranoid programs