view release on metacpan or  search on metacpan

lib/Net/Subnet.pm  view on Meta::CPAN

package Net::Subnet;

use strict;
use Socket;
BEGIN {
    if (defined &Socket::inet_pton) {
        Socket->import(qw(inet_pton AF_INET6));
    } else {
        require Socket6;
        Socket6->import(qw(inet_pton AF_INET6));
    }
};


use base 'Exporter';
our @EXPORT = qw(subnet_matcher subnet_classifier sort_subnets);

our $VERSION = '1.03';

sub cidr2mask_v4 {
    my ($length) = @_;
    return pack "N", 0xffffffff << (32 - $length);
}

sub cidr2mask_v6 {
    my ($length) = @_;
    return pack('B128', '1' x $length);
}

sub subnet_matcher {
    @_ > 1 and goto &multi_matcher;

    my ($net, $mask) = split m[/], shift;
    return $net =~ /:/
        ? ipv6_matcher($net, $mask)
        : ipv4_matcher($net, $mask);
}

sub ipv4_matcher {
    my ($net, $mask) = @_;

    $net = inet_aton($net);
    $mask = $mask =~ /\./ ? inet_aton($mask) : cidr2mask_v4($mask);

    my $masked_net = $net & $mask;

    return sub { ((inet_aton(shift) // return !1) & $mask) eq $masked_net };
}

sub ipv6_matcher {
    my ($net, $mask) = @_;

    $net = inet_pton(AF_INET6, $net);
    $mask = $mask =~ /:/ ? inet_pton(AF_INET6, $mask) : cidr2mask_v6($mask);

    my $masked_net = $net & $mask;

    return sub { ((inet_pton(AF_INET6,shift)//return!1) & $mask) eq $masked_net}
}

sub multi_matcher {
    my @v4 = map subnet_matcher($_), grep !/:/, @_;
    my @v6 = map subnet_matcher($_), grep  /:/, @_;

    return sub {
        $_->($_[0]) and return 1 for $_[0] =~ /:/ ? @v6 : @v4;
        return !!0;
    }
}

use constant MATCHER => 0;
use constant SUBNET  => 1;

sub subnet_classifier {
    #                    MATCHER,     SUBNET
    my @v4 = map [ subnet_matcher($_), $_ ], grep !/:/, @_;
    my @v6 = map [ subnet_matcher($_), $_ ], grep  /:/, @_;

    return sub {
        $_->[MATCHER]->($_[0]) and return $_->[SUBNET]
            for $_[0] =~ /:/ ? @v6 : @v4;
        return undef;
    }
}

sub sort_subnets {
    my @unsorted;
    for (@_) {
        my ($net, $mask) = split m[/];

        $mask = $net =~ /:/
            ? ($mask =~ /:/ ? inet_pton(AF_INET6, $mask) : cidr2mask_v6($mask))
            : ($mask =~ /\./ ? inet_aton($mask) : cidr2mask_v4($mask));

        $net = $net =~ /:/
            ? inet_pton(AF_INET6, $net)
            : inet_aton($net);

        push @unsorted, sprintf "%-16s%-16s%s", ($net & $mask), $mask, $_;
    }

    return map substr($_, 32), reverse sort @unsorted;
}

1;

__END__

=head1 NAME

Net::Subnet - Fast IP-in-subnet matcher for IPv4 and IPv6, CIDR or mask.

=head1 SYNOPSIS

    use Net::Subnet;

    # CIDR notation
    my $is_rfc1918 = subnet_matcher qw(
        10.0.0.0/8
        172.16.0.0/12
        192.168.0.0/16
    );

    # Subnet mask notation
    my $is_rfc1918 = subnet_matcher qw(
        10.0.0.0/255.0.0.0
        172.16.0.0/255.240.0.0
        192.168.0.0/255.255.0.0
    );

    print $is_rfc1918->('192.168.1.1') ? 'yes' : 'no';  # prints "yes"
    print $is_rfc1918->('8.8.8.8')     ? 'yes' : 'no';  # prints "no"

    # Mixed IPv4 and IPv6
    my $in_office_network = subnet_matcher qw(
        192.168.1.0/24
        2001:db8:1337::/48
    );

    $x = $in_office_network->('192.168.1.1');            # $x is true
    $x = $in_office_network->('2001:db8:dead:beef::5');  # $x is false

    my $classifier = subnet_classifier qw(
        192.168.1.0/24
        2001:db8:1337::/48
        10.0.0.0/255.0.0.0
    );

    $x = $classifier->('192.168.1.250');        # $x is '192.168.1.0/24'