Net-Subnet-1.03/0000755000175000017500000000000012153111642012421 5ustar juerdjuerdNet-Subnet-1.03/lib/0000755000175000017500000000000012153111642013167 5ustar juerdjuerdNet-Subnet-1.03/lib/Net/0000755000175000017500000000000012153111642013715 5ustar juerdjuerdNet-Subnet-1.03/lib/Net/Subnet.pm0000644000175000017500000001607112153111606015520 0ustar juerdjuerdpackage 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' $x = $classifier->('2001:db8:1337::babe'); # $x is '2001:db8:1337::/48' $x = $classifier->('10.2.127.1'); # $x is '10.0.0.0/255.0.0.0' $x = $classifier->('8.8.8.8'); # $x is undef # More specific subnets (smaller subnets) must be listed first my @subnets = sort_subnets( '192.168.0.0/24', # second '192.168.0.1/32', # first '192.168.0.0/16', # third ); my $classifier = subnet_classifier @subnets; =head1 DESCRIPTION This is a simple but fast pure Perl module for determining whether a given IP address is in a given set of IP subnets. It's iterative, and it doesn't use any fancy tries, but because it uses simple bitwise operations on strings it's still very fast. All documented functions are exported by default. Subnets have to be given in "address/mask" or "address/length" (CIDR) format. The Socket and Socket6 modules are used to normalise addresses, which means that any of the address formats supported by inet_aton and inet_pton can be used with Net::Subnet. =head1 FUNCTIONS =head2 subnet_matcher(@subnets) Returns a reference to a function that returns true if the given IP address is in @subnets, false it it's not. =head2 subnet_classifier(@subnets) Returns a reference to a function that returns the element from @subnets that matches the given IP address, or undef if none matched. =head2 sort_subnets(@subnets) Returns @subnets in reverse order of prefix length and prefix; use this with subnet_matcher or subnet_classifier if your subnet list has overlapping ranges and it's not already sorted most-specific-first. =head1 TRICKS =head2 Generating PTR records for IPv6 If you need to classify an IP address, but want some other value than the original subnet string, just use a hash. You could even use code references; here's an example of how to generate dynamic reverse DNS records for IPv6 addresses: my %ptr = ( '2001:db8:1337:d00d::/64' => sub { my $hostname = get_machine_name(shift); return $hostname =~ /\.$/ ? $hostname : "$hostname.example.org."; }, '2001:db8:1337:babe::/64' => sub { my $hostname = get_machine_name(shift); return $hostname =~ /\.$/ ? $hostname : "$hostname.example.net."; }, '::/0' => sub { (my $ip = shift) =~ s/:/x/g; return "$ip.unknown.example.com."; }, ); my $classifier = subnet_classifier sort_subnets keys %ptr; while (my $ip = readline) { # We get IP adresses from STDIN and return the hostnames on STDOUT print $ptr{ $classifier->($ip) }->($ip), "\n"; } =head2 Matching ::ffff:192.168.1.200 IPv4 subnets only match IPv4 addresses. If you need to match IPv4-mapped IPv6 addresses, i.e. IPv4 addresses with C<::ffff:> stuck in front of them, simply remove that part before matching: my $matcher = subnet_matcher qw(192.168.1.0/22); $ip =~ s/^::ffff://; my $boolean = $matcher->($ip); Alternatively, translate the subnet definition to IPv6 notation: C<1.2.3.0/24> becomes C<::ffff:1.2.3.0/120>. If you do this, hexadecimal addresses such as C<::ffff:102:304> will also match, but IPv4 addresses without C<::ffff:> will no longer match unless you include C<1.2.3.0/24> as well. my $matcher = subnet_matcher qw(::ffff:192.168.1.0/118 192.168.1.0/22); my $boolean = $matcher->($ip); =head1 CAVEATS No argument verification is done; garbage in, garbage out. If you give it hostnames, DNS may be used to resolve them, courtesy of the Socket and Socket6 modules. =head1 AUTHOR Juerd Waalboer =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-Subnet-1.03/Makefile.PL0000644000175000017500000000046311625774556014424 0ustar juerdjuerduse 5.008003; # For no particular reason use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Net::Subnet', VERSION_FROM => 'lib/Net/Subnet.pm', PREREQ_PM => { 'Socket6' => '0.23' }, ABSTRACT_FROM => 'lib/Net/Subnet.pm', AUTHOR => 'Juerd Waalboer <#####@juerd.nl>' ); Net-Subnet-1.03/META.yml0000644000175000017500000000110112153111642013663 0ustar juerdjuerd--- #YAML:1.0 name: Net-Subnet version: 1.03 abstract: Fast IP-in-subnet matcher for IPv4 and IPv6, CIDR or mask. author: - Juerd Waalboer <#####@juerd.nl> license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Socket6: 0.23 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Net-Subnet-1.03/t/0000755000175000017500000000000012153111642012664 5ustar juerdjuerdNet-Subnet-1.03/t/02subnet.t0000644000175000017500000000311012153110207014502 0ustar juerdjuerduse Test::More; use Net::Subnet; my @subnets = qw( 2001:db8:10::/48 2001:db8:10:5::/64 ::1/128 192.168.0.0/22 2001:db8:8000::/34 ); my %matches = qw( 2001:db8:10::123:123:123:1234 2001:db8:10::/48 2001:db8:10:: 2001:db8:10::/48 2001:db8:10:ffff:ffff:ffff:ffff:ffff 2001:db8:10::/48 2001:db8:10:5::1 2001:db8:10:5::/64 2001:db8:8000::1 2001:db8:8000::/34 ::1 ::1/128 192.168.0.5 192.168.0.0/22 192.168.1.5 192.168.0.0/22 192.168.2.5 192.168.0.0/22 192.168.3.5 192.168.0.0/22 ); my @nonmatches = qw( ::2 ::0 0.0.0.0 ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff 255.255.255.255 192.168.4.5 2001:db8:11::1 2001:db8:8:: 2001:db8:8::2 ); my @sorted_subnets = sort_subnets(@subnets); my %seen; for (@sorted_subnets) { if ($_ eq '2001:db8:10::/48') { ok($seen{'2001:db8:10:5::/64'}, "/64 sorts before /48"); } $seen{$_}++; } my $matcher = subnet_matcher(@subnets); my $classifier = subnet_classifier(@sorted_subnets); for (keys %matches) { ok($matcher->($_), "Matcher matches $_"); is($classifier->($_), $matches{$_}, "Classifier identifies $_ as belonging to $matches{$_}"); } for (@nonmatches) { ok(!$matcher->($_), "Matcher returns false for $_"); ok(!defined($classifier->($_)), "Classifier returns undef for $_"); } done_testing; Net-Subnet-1.03/t/01use.t0000644000175000017500000000006211625775453014027 0ustar juerdjuerduse Test::More tests => 1; use_ok('Net::Subnet'); Net-Subnet-1.03/README0000644000175000017500000000031111626004741013301 0ustar juerdjuerdNet::Subnet INSTALLATION To install this module type the following: perl Makefile.PL make make test make install Or use cpan(1) to automate the process. PREREQUISITES Socket6 Net-Subnet-1.03/Changes0000644000175000017500000000126512153110404013713 0ustar juerdjuerdRevision history for Perl extension Net::Subnet. Incompatible changes are marked with "!!". Incompatibility with and changes in "undocumented features" are not always specifically mentioned here. 1.03 Mon Jun 3 14:48 2013 - Fix IPv6 matching for CIDR lengths that aren't a multiple of 8 (Reported and patched by .) 1.02 Sun Aug 28 1:58 2011 - Fix undef warnings for single subnet matcher that gets an address from another family, or other unparsable input. - Added some usage examples to the documentation. 1.01 Fri Aug 26 23:41 2011 - Minor documentation fixes. 1.00 Fri Aug 26 23:01 2011 - CPAN release. Net-Subnet-1.03/MANIFEST0000644000175000017500000000023412153111642013551 0ustar juerdjuerdChanges Makefile.PL MANIFEST README t/01use.t t/02subnet.t lib/Net/Subnet.pm META.yml Module meta-data (added by MakeMaker)