Net-Netmask-1.9016/0000755000175000017500000000000011522010766012452 5ustar muirmuirNet-Netmask-1.9016/README0000644000175000017500000004333511522005367013343 0ustar muirmuirNAME Net::Netmask - parse, manipulate and lookup IP network blocks SYNOPSIS use Net::Netmask; $block = new Net::Netmask (network block) $block = new Net::Netmask (network block, netmask) $block = new2 Net::Netmask (network block) $block = new2 Net::Netmask (network block, netmask) print $block; # a.b.c.d/bits print $block->base() print $block->mask() print $block->hostmask() print $block->bits() print $block->size() print $block->maxblock() print $block->broadcast() print $block->next() print $block->match($ip); print $block->nth(1, [$bitstep]); if ($block->sameblock("network block")) ... if ($block->cmpblocks("network block")) ... $newblock = $block->nextblock([count]); for $ip ($block->enumerate([$bitstep])) { } for $zone ($block->inaddr()) { } my $table = {}; $block->storeNetblock([$table]) $block->deleteNetblock([$table]) @missingblocks = $block->cidrs2inverse(@blocks) $block = findNetblock(ip, [$table]) $block = findOuterNetblock(ip, [$table]) @blocks = findAllNetblock(ip, [$table]) if ($block->checkNetblock([$table]) ... $block2 = $block1->findOuterNetblock([$table]) @blocks = dumpNetworkTable([$table]) @blocks = range2cidrlist($beginip, $endip); @blocks = cidrs2cidrs(@blocks_with_dups) @listofblocks = cidrs2contiglists(@blocks); @blocks = sort @blocks @blocks = sort_network_blocks(@blocks) @sorted_ip_addrs = sort_by_ip_address(@unsorted_ip_addrs) DESCRIPTION Net::Netmask parses and understands IPv4 CIDR blocks. It's built with an object-oriented interface. Nearly all functions are methods that operate on a Net::Netmask object. There are methods that provide the nearly all bits of information about a network block that you might want. There are also functions to put a network block into a table and then later lookup network blocks by IP address in that table. There are functions to turn a IP address range into a list of CIDR blocks. There are functions to turn a list of CIDR blocks into a list of IP addresses. There is a function for sorting by text IP address. CONSTRUCTING Net::Netmask objects are created with an IP address and optionally a mask. There are many forms that are recognized: '216.240.32.0/24' The preferred form. '216.240.32.0:255.255.255.0' '216.240.32.0-255.255.255.0' '216.240.32.0', '255.255.255.0' '216.240.32.0', '0xffffff00' '216.240.32.0 - 216.240.32.255' '216.240.32.4' A /32 block. '216.240.32' Always a /24 block. '216.240' Always a /16 block. '140' Always a /8 block. '216.240.32/24' '216.240/16' 'default' or 'any' 0.0.0.0/0 (the default route) '216.240.32.0#0.0.31.255' A hostmask (as used by Cisco access-lists). There are two constructor methods: "new" and "new2". The difference is that "new2" will return undef for invalid netmasks and "new" will return a netmask object even if the constructor could not figure out what the network block should be. With "new", the error string can be found as $block->{'ERROR'}. With "new2" the error can be found as Net::Netmask::errstr or $Net::Netmask::error. METHODS ->desc() Returns a description of the network block. Eg: 216.240.32.0/19. This is also available as overloaded stringification. ->base() Returns base address of the network block as a string. Eg: 216.240.32.0. Base does not give an indication of the size of the network block. ->mask() Returns the netmask as a string. Eg: 255.255.255.0. ->hostmask() Returns the host mask which is the opposite of the netmask. Eg: 0.0.0.255. ->bits() Returns the netmask as a number of bits in the network portion of the address for this block. Eg: 24. ->size() Returns the number of IP addresses in a block. Eg: 256. ->broadcast() The blocks broadcast address. (The last IP address inside the block.) Eg: 192.168.1.0/24 => 192.168.1.255 ->next() The first IP address following the block. (The IP address following the broadcast address.) Eg: 192.168.1.0/24 => 192.168.2.0 ->first() & ->last() Synonyms for ->base() and ->broadcast() ->match($ip) Returns a true if the IP number $ip matches the given network. That is, a true value is returned if $ip is between base() amd broadcast(). For example, if we have the network 192.168.1.0/24, then 192.168.0.255 => 0 192.168.1.0 => "0 " 192.168.1.1 => 1 ... 192.168.1.255 => 255 $ip should be a dotted-quad (eg: "192.168.66.3") It just happens that the return value is the position within the block. Since zero is a legal position, the true string "0 " is returned in it's place. "0 " is numerically zero though. When wanting to know the position inside the block, a good idiom is: $pos = $block->match($ip) or die; $pos += 0; ->maxblock() Much of the time, it is not possible to determine the size of a network block just from it's base address. For example, with the network block '216.240.32.0/27', if you only had the '216.240.32.0' portion you wouldn't be able to tell for certain the size of the block. '216.240.32.0' could be anything from a '/23' to a '/32'. The maxblock() method gives the size of the largest block that the current block's address would allow it to be. The size is given in bits. Eg: 23. ->enumerate([$bitstep) Returns a list of all the IP addresses in the block. Be very careful not to use this function of large blocks. The IP addresses are returned as strings. Eg: '216.240.32.0', '216.240.32.1', ... '216.240.32.255'. If the optional argument is given, step through the block in increments of a given network size. To step by 4, use a bitstep of 30 (as in a /30 network). ->nth($index, [$bitstep]) Returns the nth element of the array that enumerate would return if it were called. So, to get the first usable address in a block, use nth(1). To get the broadcast address, use nth(-1). To get the last usable adress, use nth(-2). ->inaddr() Returns an inline list of tuples. There is a tuple for each DNS zone name in the block. If the block is smaller than a /24, then the zone of the enclosing /24 is returned. Each tuple contains: the DNS zone name, the last component of the first IP address in the block in that zone, the last component of the last IP address in the block in that zone. Examples: the list returned for the block '216.240.32.0/23' would be: '32.240.216.in-addr.arpa', 0, 255, '33.240.216.in-addr.arpa', 0, 255. The list returned for the block '216.240.32.64/27' would be: '32.240.216.in-addr.arpa', 64, 95. ->nextblock([$count]) Without a $count, return the next block of the same size after the current one. With a count, return the Nth block after the current one. A count of -1 returns the previous block. Undef will be returned if out of legal address space. ->sameblock($block) Compares two blocks. The second block will be auto-converted from a string if it isn't already a Net::Netmask object. Returns 1 if they are identical. ->cmpblocks($block) Compares two blocks. The second block will be auto-converted from a string if it isn't already a Net::Netmask object. Returns -1, 0, or 1 depending on which one has the lower base address or which one is larger if they have the same base address. ->contains($block) Compares two blocks. The second block will be auto-converted from a string if it isn't already a Net::Netmask object. Returns 1 if the second block fits inside the first block. Returns 0 otherwise. ->storeNetblock([$t]) Adds the current block to an table of network blocks. The table can be used to query which network block a given IP address is in. The optional argument allows there to be more than one table. By default, an internal table is used. If more than one table is needed, then supply a reference to a HASH to store the data in. ->deleteNetblock([$t]) Deletes the current block from a table of network blocks. The optional argument allows there to be more than one table. By default, an internal table is used. If more than one table is needed, then supply a reference to a HASH to store the data in. ->checkNetblock([$t]) Returns true of the netblock is already in the network table. ->tag($name [, $value]) Tag network blocks with your own data. The first argument is the name of your tag (hash key) and the second argument (if present) is the new value. The old value is returned. METHOD/FUNCTION COMBOS findOuterNetblock(ip, [$t]) Search the table of network blocks (created with storeNetBlock) to find if any of them contain the given IP address. The IP address can either be a string or a Net::Netmask object (method invocation). If more than one block in the table contains the IP address or block, the largest network block will be the one returned. The return value is either a Net::Netmask object or undef. cidrs2inverse(block, @listOfBlocks) Given a block and a list of blocks, cidrs2inverse() will return a list of blocks representing the IP addresses that are in the block but not in the list of blocks. It finds the gaps. The block will be auto-converted from a string if it isn't already a Net::Netmask object. The list of blocks should be Net::Netmask objects. The return value is a list of Net::Netmask objects. OVERLOADING Overloading doesn't seem to work completeley on perl before version 5.6.1. The test suite doesn't test overloading before that. At least for sort. "" Strinification is overloaded to be the ->desc() method. cmp Numerical and string comparisions have been overloaded to the ->cmpblocks() method. This allows blocks to be sorted without specifying a sort function. FUNCTIONS sort_by_ip_address This function is included in "Net::Netmask" simply because there doesn't seem to be a better place to put it on CPAN. It turns out that there is one method for sorting dotted-quads ("a.b.c.d") that is faster than all the rest. This is that way. Use it as "sort_by_ip_address(@list_of_ips)". That was the theory anyway. Someone sent a faster version ... sort_network_blocks This function is a function to sort Net::Netmask objects. It's faster than the simpler "sort @blocks" that also works. findNetblock(ip, [$t]) Search the table of network blocks (created with storeNetBlock) to find if any of them contain the given IP address. The IP address is expected to be a string. If more than one block in the table contains the IP address, the smallest network block will be the one returned. The return value is either a Net::Netmask object or undef. findAllNetblock(ip, [$t]) Search the table of network blocks (created with storeNetBlock) to find if any of them contain the given IP address. The IP address is expected to be a string. All network blocks in the table that contain the IP address will be returned. The return value is a list of Net::Netmask objects. dumpNetworkTable([$t]) Returns a list of the networks in a network table (as created by ->storeNetblock()). range2cidrlist($startip, $endip) Given a range of IP addresses, return a list of blocks that span that range. For example, range2cidrlist('216.240.32.128', '216.240.36.127'), will return a list of Net::Netmask objects that corrospond to: 216.240.32.128/25 216.240.33.0/24 216.240.34.0/23 216.240.36.0/25 cidrs2contiglists(@listOfBlocks) "cidrs2contiglists" will rearrange a list of Net::Netmask objects such that contiguous sets are in sublists and each sublist is discontigeous with the next. For example, given a list of Net::Netmask objects corresponding to the following blocks: 216.240.32.128/25 216.240.33.0/24 216.240.36.0/25 "cidrs2contiglists" will return a list with two sublists: 216.240.32.128/25 216.240.33.0/24 216.240.36.0/25 Overlapping blocks will be placed in the same sublist. cidrs2cidrs(@listOfBlocks) "cidrs2cidrs" will collapse a list of Net::Netmask objects by combining adjacent blocks into larger blocks. It returns a list of blocks that covers exactly the same IP space. Overlapping blocks will be collapsed. LICENSE Copyright (C) 1998-2006 David Muir Sharnoff. Copyright (C) 2011 Google, Inc. This module may be used, modified and redistributed on the same terms as Perl itself. Net-Netmask-1.9016/META.yml0000644000175000017500000000104111522010766013717 0ustar muirmuir--- #YAML:1.0 name: Net-Netmask version: 1.9016 abstract: Understand and manipulate IP netmaks author: - David Muir Sharnoff license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Net-Netmask-1.9016/Netmask.pod0000644000175000017500000003064311522004746014567 0ustar muirmuir=head1 NAME Net::Netmask - parse, manipulate and lookup IP network blocks =head1 SYNOPSIS use Net::Netmask; $block = new Net::Netmask (network block) $block = new Net::Netmask (network block, netmask) $block = new2 Net::Netmask (network block) $block = new2 Net::Netmask (network block, netmask) print $block; # a.b.c.d/bits print $block->base() print $block->mask() print $block->hostmask() print $block->bits() print $block->size() print $block->maxblock() print $block->broadcast() print $block->next() print $block->match($ip); print $block->nth(1, [$bitstep]); if ($block->sameblock("network block")) ... if ($block->cmpblocks("network block")) ... $newblock = $block->nextblock([count]); for $ip ($block->enumerate([$bitstep])) { } for $zone ($block->inaddr()) { } my $table = {}; $block->storeNetblock([$table]) $block->deleteNetblock([$table]) @missingblocks = $block->cidrs2inverse(@blocks) $block = findNetblock(ip, [$table]) $block = findOuterNetblock(ip, [$table]) @blocks = findAllNetblock(ip, [$table]) if ($block->checkNetblock([$table]) ... $block2 = $block1->findOuterNetblock([$table]) @blocks = dumpNetworkTable([$table]) @blocks = range2cidrlist($beginip, $endip); @blocks = cidrs2cidrs(@blocks_with_dups) @listofblocks = cidrs2contiglists(@blocks); @blocks = sort @blocks @blocks = sort_network_blocks(@blocks) @sorted_ip_addrs = sort_by_ip_address(@unsorted_ip_addrs) =head1 DESCRIPTION Net::Netmask parses and understands IPv4 CIDR blocks. It's built with an object-oriented interface. Nearly all functions are methods that operate on a Net::Netmask object. There are methods that provide the nearly all bits of information about a network block that you might want. There are also functions to put a network block into a table and then later lookup network blocks by IP address in that table. There are functions to turn a IP address range into a list of CIDR blocks. There are functions to turn a list of CIDR blocks into a list of IP addresses. There is a function for sorting by text IP address. =head1 CONSTRUCTING Net::Netmask objects are created with an IP address and optionally a mask. There are many forms that are recognized: =over 32 =item '216.240.32.0/24' The preferred form. =item '216.240.32.0:255.255.255.0' =item '216.240.32.0-255.255.255.0' =item '216.240.32.0', '255.255.255.0' =item '216.240.32.0', '0xffffff00' =item '216.240.32.0 - 216.240.32.255' =item '216.240.32.4' A /32 block. =item '216.240.32' Always a /24 block. =item '216.240' Always a /16 block. =item '140' Always a /8 block. =item '216.240.32/24' =item '216.240/16' =item 'default' or 'any' 0.0.0.0/0 (the default route) =item '216.240.32.0#0.0.31.255' A hostmask (as used by Cisco access-lists). =back There are two constructor methods: C and C. The difference is that C will return undef for invalid netmasks and C will return a netmask object even if the constructor could not figure out what the network block should be. With C, the error string can be found as $block->{'ERROR'}. With C the error can be found as Net::Netmask::errstr or $Net::Netmask::error. =head1 METHODS =over 25 =item ->B() Returns a description of the network block. Eg: 216.240.32.0/19. This is also available as overloaded stringification. =item ->B() Returns base address of the network block as a string. Eg: 216.240.32.0. B does not give an indication of the size of the network block. =item ->B() Returns the netmask as a string. Eg: 255.255.255.0. =item ->B() Returns the host mask which is the opposite of the netmask. Eg: 0.0.0.255. =item ->B() Returns the netmask as a number of bits in the network portion of the address for this block. Eg: 24. =item ->B() Returns the number of IP addresses in a block. Eg: 256. =item ->B() The blocks broadcast address. (The last IP address inside the block.) Eg: 192.168.1.0/24 => 192.168.1.255 =item ->B() The first IP address following the block. (The IP address following the broadcast address.) Eg: 192.168.1.0/24 => 192.168.2.0 =item ->B() & ->B() Synonyms for ->B() and ->B() =item ->B($ip) Returns a true if the IP number $ip matches the given network. That is, a true value is returned if $ip is between base() amd broadcast(). For example, if we have the network 192.168.1.0/24, then 192.168.0.255 => 0 192.168.1.0 => "0 " 192.168.1.1 => 1 ... 192.168.1.255 => 255 $ip should be a dotted-quad (eg: "192.168.66.3") It just happens that the return value is the position within the block. Since zero is a legal position, the true string "0 " is returned in it's place. "0 " is numerically zero though. When wanting to know the position inside the block, a good idiom is: $pos = $block->match($ip) or die; $pos += 0; =item ->B() Much of the time, it is not possible to determine the size of a network block just from it's base address. For example, with the network block '216.240.32.0/27', if you only had the '216.240.32.0' portion you wouldn't be able to tell for certain the size of the block. '216.240.32.0' could be anything from a '/23' to a '/32'. The B() method gives the size of the largest block that the current block's address would allow it to be. The size is given in bits. Eg: 23. =item ->B([$bitstep) Returns a list of all the IP addresses in the block. Be very careful not to use this function of large blocks. The IP addresses are returned as strings. Eg: '216.240.32.0', '216.240.32.1', ... '216.240.32.255'. If the optional argument is given, step through the block in increments of a given network size. To step by 4, use a bitstep of 30 (as in a /30 network). =item ->B($index, [$bitstep]) Returns the nth element of the array that B would return if it were called. So, to get the first usable address in a block, use B(1). To get the broadcast address, use B(-1). To get the last usable adress, use B(-2). =item ->B() Returns an inline list of tuples. There is a tuple for each DNS zone name in the block. If the block is smaller than a /24, then the zone of the enclosing /24 is returned. Each tuple contains: the DNS zone name, the last component of the first IP address in the block in that zone, the last component of the last IP address in the block in that zone. Examples: the list returned for the block '216.240.32.0/23' would be: '32.240.216.in-addr.arpa', 0, 255, '33.240.216.in-addr.arpa', 0, 255. The list returned for the block '216.240.32.64/27' would be: '32.240.216.in-addr.arpa', 64, 95. =item ->B([$count]) Without a $count, return the next block of the same size after the current one. With a count, return the Nth block after the current one. A count of -1 returns the previous block. Undef will be returned if out of legal address space. =item ->B($block) Compares two blocks. The second block will be auto-converted from a string if it isn't already a Net::Netmask object. Returns 1 if they are identical. =item ->B($block) Compares two blocks. The second block will be auto-converted from a string if it isn't already a Net::Netmask object. Returns -1, 0, or 1 depending on which one has the lower base address or which one is larger if they have the same base address. =item ->B($block) Compares two blocks. The second block will be auto-converted from a string if it isn't already a Net::Netmask object. Returns 1 if the second block fits inside the first block. Returns 0 otherwise. =item ->B([$t]) Adds the current block to an table of network blocks. The table can be used to query which network block a given IP address is in. The optional argument allows there to be more than one table. By default, an internal table is used. If more than one table is needed, then supply a reference to a HASH to store the data in. =item ->B([$t]) Deletes the current block from a table of network blocks. The optional argument allows there to be more than one table. By default, an internal table is used. If more than one table is needed, then supply a reference to a HASH to store the data in. =item ->B([$t]) Returns true of the netblock is already in the network table. =item ->B($name [, $value]) Tag network blocks with your own data. The first argument is the name of your tag (hash key) and the second argument (if present) is the new value. The old value is returned. =back =head1 METHOD/FUNCTION COMBOS =over 25 =item B(ip, [$t]) Search the table of network blocks (created with B) to find if any of them contain the given IP address. The IP address can either be a string or a Net::Netmask object (method invocation). If more than one block in the table contains the IP address or block, the largest network block will be the one returned. The return value is either a Net::Netmask object or undef. =item B(block, @listOfBlocks) Given a block and a list of blocks, B() will return a list of blocks representing the IP addresses that are in the block but not in the list of blocks. It finds the gaps. The block will be auto-converted from a string if it isn't already a Net::Netmask object. The list of blocks should be Net::Netmask objects. The return value is a list of Net::Netmask objects. =back =head1 OVERLOADING Overloading doesn't seem to work completeley on perl before version 5.6.1. The test suite doesn't test overloading before that. At least for sort. =over 25 =item B<""> Strinification is overloaded to be the ->B() method. =item B Numerical and string comparisions have been overloaded to the ->B() method. This allows blocks to be sorted without specifying a sort function. =back =head1 FUNCTIONS =over 25 =item B This function is included in C simply because there doesn't seem to be a better place to put it on CPAN. It turns out that there is one method for sorting dotted-quads ("a.b.c.d") that is faster than all the rest. This is that way. Use it as C. That was the theory anyway. Someone sent a faster version ... =item B This function is a function to sort Net::Netmask objects. It's faster than the simpler C that also works. =item B(ip, [$t]) Search the table of network blocks (created with B) to find if any of them contain the given IP address. The IP address is expected to be a string. If more than one block in the table contains the IP address, the smallest network block will be the one returned. The return value is either a Net::Netmask object or undef. =item B(ip, [$t]) Search the table of network blocks (created with B) to find if any of them contain the given IP address. The IP address is expected to be a string. All network blocks in the table that contain the IP address will be returned. The return value is a list of Net::Netmask objects. =item B([$t]) Returns a list of the networks in a network table (as created by ->B()). =item B($startip, $endip) Given a range of IP addresses, return a list of blocks that span that range. For example, range2cidrlist('216.240.32.128', '216.240.36.127'), will return a list of Net::Netmask objects that corrospond to: 216.240.32.128/25 216.240.33.0/24 216.240.34.0/23 216.240.36.0/25 =item B(@listOfBlocks) C will rearrange a list of Net::Netmask objects such that contiguous sets are in sublists and each sublist is discontigeous with the next. For example, given a list of Net::Netmask objects corresponding to the following blocks: 216.240.32.128/25 216.240.33.0/24 216.240.36.0/25 C will return a list with two sublists: 216.240.32.128/25 216.240.33.0/24 216.240.36.0/25 Overlapping blocks will be placed in the same sublist. =item B(@listOfBlocks) C will collapse a list of Net::Netmask objects by combining adjacent blocks into larger blocks. It returns a list of blocks that covers exactly the same IP space. Overlapping blocks will be collapsed. =back =head1 LICENSE Copyright (C) 1998-2006 David Muir Sharnoff. Copyright (C) 2011 Google, Inc. This module may be used, modified and redistributed on the same terms as Perl itself. Net-Netmask-1.9016/Netmask.pm0000644000175000017500000003052411522010102014376 0ustar muirmuir# Copyright (C) 1998-2006, David Muir Sharnoff package Net::Netmask; use vars qw($VERSION); $VERSION = 1.9016; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(findNetblock findOuterNetblock findAllNetblock cidrs2contiglists range2cidrlist sort_by_ip_address dumpNetworkTable sort_network_blocks cidrs2cidrs cidrs2inverse); @EXPORT_OK = (@EXPORT, qw(int2quad quad2int %quadmask2bits %quadhostmask2bits imask sameblock cmpblocks contains)); my $remembered = {}; my %imask2bits; my %size2bits; my @imask; # our %quadmask2bits; # our %quadhostmask2bits; use vars qw($error $debug %quadmask2bits %quadhostmask2bits); $debug = 1; use strict; use warnings; use Carp; use POSIX qw(floor); use overload '""' => \&desc, '<=>' => \&cmp_net_netmask_block, 'cmp' => \&cmp_net_netmask_block, 'fallback' => 1; sub new { my ($package, $net, $mask) = @_; $mask = '' unless defined $mask; my $base; my $bits; my $ibase; undef $error; if ($net =~ m,^(\d+\.\d+\.\d+\.\d+)/(\d+)$,) { ($base, $bits) = ($1, $2); } elsif ($net =~ m,^(\d+\.\d+\.\d+\.\d+)[:/](\d+\.\d+\.\d+\.\d+)$,) { $base = $1; my $quadmask = $2; if (exists $quadmask2bits{$quadmask}) { $bits = $quadmask2bits{$quadmask}; } else { $error = "illegal netmask: $quadmask"; } } elsif ($net =~ m,^(\d+\.\d+\.\d+\.\d+)[#](\d+\.\d+\.\d+\.\d+)$,) { $base = $1; my $hostmask = $2; if (exists $quadhostmask2bits{$hostmask}) { $bits = $quadhostmask2bits{$hostmask}; } else { $error = "illegal hostmask: $hostmask"; } } elsif (($net =~ m,^\d+\.\d+\.\d+\.\d+$,) && ($mask =~ m,\d+\.\d+\.\d+\.\d+$,)) { $base = $net; if (exists $quadmask2bits{$mask}) { $bits = $quadmask2bits{$mask}; } else { $error = "illegal netmask: $mask"; } } elsif (($net =~ m,^\d+\.\d+\.\d+\.\d+$,) && ($mask =~ m,0x[a-z0-9]+,i)) { $base = $net; my $imask = hex($mask); if (exists $imask2bits{$imask}) { $bits = $imask2bits{$imask}; } else { $error = "illegal netmask: $mask ($imask)"; } } elsif ($net =~ /^\d+\.\d+\.\d+\.\d+$/ && ! $mask) { ($base, $bits) = ($net, 32); } elsif ($net =~ /^\d+\.\d+\.\d+$/ && ! $mask) { ($base, $bits) = ("$net.0", 24); } elsif ($net =~ /^\d+\.\d+$/ && ! $mask) { ($base, $bits) = ("$net.0.0", 16); } elsif ($net =~ /^\d+$/ && ! $mask) { ($base, $bits) = ("$net.0.0.0", 8); } elsif ($net =~ m,^(\d+\.\d+\.\d+)/(\d+)$,) { ($base, $bits) = ("$1.0", $2); } elsif ($net =~ m,^(\d+\.\d+)/(\d+)$,) { ($base, $bits) = ("$1.0.0", $2); } elsif ($net =~ m,^(\d+)/(\d+)$,) { ($base, $bits) = ("$1.0.0.0", $2); } elsif ($net eq 'default' || $net eq 'any') { ($base, $bits) = ("0.0.0.0", 0); } elsif ($net =~ m,^(\d+\.\d+\.\d+\.\d+)\s*-\s*(\d+\.\d+\.\d+\.\d+)$,) { # whois format $ibase = quad2int($1); my $end = quad2int($2); $error = "illegal dotted quad: $net" unless defined($ibase) && defined($end); my $diff = ($end || 0) - ($ibase || 0) + 1; $bits = $size2bits{$diff}; $error = "could not find exact fit for $net" if ! defined $error && ( ! defined $bits || ($ibase & ~$imask[$bits])); } else { $error = "could not parse $net"; $error .= " $mask" if $mask; } carp $error if $error && $debug; $ibase = quad2int($base || 0) unless defined $ibase; unless (defined($ibase) || defined($error)) { $error = "could not parse $net"; $error .= " $mask" if $mask; } $ibase &= $imask[$bits] if defined $ibase && defined $bits; $bits = 0 unless $bits; if ($bits > 32) { $error = "illegal number of bits: $bits" unless $error; $bits = 32; } return bless { 'IBASE' => $ibase, 'BITS' => $bits, ( $error ? ( 'ERROR' => $error ) : () ), }; } sub new2 { local($debug) = 0; my $net = new(@_); return undef if $error; return $net; } sub errstr { return $error; } sub debug { my $this = shift; return (@_ ? $debug = shift : $debug) } sub base { my ($this) = @_; return int2quad($this->{'IBASE'}); } sub bits { my ($this) = @_; return $this->{'BITS'}; } sub size { my ($this) = @_; return 2**(32- $this->{'BITS'}); } sub next { my ($this) = @_; int2quad($this->{'IBASE'} + $this->size()); } sub broadcast { my($this) = @_; int2quad($this->{'IBASE'} + $this->size() - 1); } *first = \&base; *last = \&broadcast; sub desc { return int2quad($_[0]->{'IBASE'}).'/'.$_[0]->{'BITS'}; } sub imask { return (2**32 -(2** (32- $_[0]))); } sub mask { my ($this) = @_; return int2quad ( $imask[$this->{'BITS'}]); } sub hostmask { my ($this) = @_; return int2quad ( ~ $imask[$this->{'BITS'}]); } sub nth { my ($this, $index, $bitstep) = @_; my $size = $this->size(); my $ibase = $this->{'IBASE'}; $bitstep = 32 unless $bitstep; my $increment = 2**(32-$bitstep); $index *= $increment; $index += $size if $index < 0; return undef if $index < 0; return undef if $index >= $size; return int2quad($ibase+$index); } sub enumerate { my ($this, $bitstep) = @_; $bitstep = 32 unless $bitstep; my $size = $this->size(); my $increment = 2**(32-$bitstep); my @ary; my $ibase = $this->{'IBASE'}; for (my $i = 0; $i < $size; $i += $increment) { push(@ary, int2quad($ibase+$i)); } return @ary; } sub inaddr { my ($this) = @_; my $ibase = $this->{'IBASE'}; my $blocks = floor($this->size()/256); return (join('.',unpack('xC3', pack('V', $ibase))).".in-addr.arpa", $ibase%256, $ibase%256+$this->size()-1) if $blocks == 0; my @ary; for (my $i = 0; $i < $blocks; $i++) { push(@ary, join('.',unpack('xC3', pack('V', $ibase+$i*256))) .".in-addr.arpa", 0, 255); } return @ary; } sub tag { my $this = shift; my $tag = shift; my $val = $this->{'T'.$tag}; $this->{'T'.$tag} = $_[0] if @_; return $val; } sub quad2int { my @bytes = split(/\./,$_[0]); return undef unless @bytes == 4 && ! grep {!(/\d+$/ && $_<256)} @bytes; return unpack("N",pack("C4",@bytes)); } sub int2quad { return join('.',unpack('C4', pack("N", $_[0]))); } sub storeNetblock { my ($this, $t) = @_; $t = $remembered unless $t; my $base = $this->{'IBASE'}; $t->{$base} = [] unless exists $t->{$base}; my $mb = maxblock($this); my $b = $this->{'BITS'}; my $i = $b - $mb; $t->{$base}->[$i] = $this; } sub deleteNetblock { my ($this, $t) = @_; $t = $remembered unless $t; my $base = $this->{'IBASE'}; my $mb = maxblock($this); my $b = $this->{'BITS'}; my $i = $b - $mb; return unless defined $t->{$base}; undef $t->{$base}->[$i]; for my $x (@{$t->{$base}}) { return if $x; } delete $t->{$base}; } sub findNetblock { my ($ipquad, $t) = @_; $t = $remembered unless $t; my $ip = quad2int($ipquad); return unless defined $ip; my %done; for (my $b = 32; $b >= 0; $b--) { my $nb = $ip & $imask[$b]; next unless exists $t->{$nb}; my $mb = imaxblock($nb, 32); next if $done{$mb}++; my $i = $b - $mb; confess "$mb, $b, $ipquad, $nb" if ($i < 0 or $i > 32); while ($i >= 0) { return $t->{$nb}->[$i] if defined $t->{$nb}->[$i]; $i--; } } return undef; } sub findOuterNetblock { my ($ipquad, $t) = @_; $t = $remembered unless $t; my $ip; my $mask; if (ref($ipquad)) { $ip = $ipquad->{IBASE}; $mask = $ipquad->{BITS}; } else { $ip = quad2int($ipquad); $mask = 32; } for (my $b = 0; $b <= $mask; $b++) { my $nb = $ip & $imask[$b];; next unless exists $t->{$nb}; my $mb = imaxblock($nb, $mask); my $i = $b - $mb; confess "$mb, $b, $ipquad, $nb" if $i < 0; confess "$mb, $b, $ipquad, $nb" if $i > 32; while ($i >= 0) { return $t->{$nb}->[$i] if defined $t->{$nb}->[$i]; $i--; } } return undef; } sub findAllNetblock { my ($ipquad, $t) = @_; $t = $remembered unless $t; my @ary ; my $ip = quad2int($ipquad); my %done; for (my $b = 32; $b >= 0; $b--) { my $nb = $ip & $imask[$b]; next unless exists $t->{$nb}; my $mb = imaxblock($nb, 32); next if $done{$mb}++; my $i = $b - $mb; confess "$mb, $b, $ipquad, $nb" if $i < 0; confess "$mb, $b, $ipquad, $nb" if $i > 32; while ($i >= 0) { push(@ary, $t->{$nb}->[$i]) if defined $t->{$nb}->[$i]; $i--; } } return @ary; } sub dumpNetworkTable { my ($t) = @_; $t = $remembered unless $t; my @ary; foreach my $base (keys %$t) { push(@ary, grep (defined($_), @{$t->{base}})); for my $x (@{$t->{$base}}) { push(@ary, $x) if defined $x; } } return sort @ary; } sub checkNetblock { my ($this, $t) = @_; $t = $remembered unless $t; my $base = $this->{'IBASE'}; my $mb = maxblock($this); my $b = $this->{'BITS'}; my $i = $b - $mb; return defined $t->{$base}->[$i]; } sub match { my ($this, $ip) = @_; my $i = quad2int($ip); my $imask = $imask[$this->{BITS}]; if (($i & $imask) == $this->{IBASE}) { return (($i & ~ $imask) || "0 "); } else { return 0; } } sub maxblock { my ($this) = @_; return imaxblock($this->{'IBASE'}, $this->{'BITS'}); } sub nextblock { my ($this, $index) = @_; $index = 1 unless defined $index; my $newblock = bless { IBASE => $this->{IBASE} + $index * (2**(32- $this->{BITS})), BITS => $this->{BITS}, }; return undef if $newblock->{IBASE} >= 2**32; return undef if $newblock->{IBASE} < 0; return $newblock; } sub imaxblock { my ($ibase, $tbit) = @_; confess unless defined $ibase; while ($tbit > 0) { my $im = $imask[$tbit-1]; last if (($ibase & $im) != $ibase); $tbit--; } return $tbit; } sub range2cidrlist { my ($startip, $endip) = @_; my $start = quad2int($startip); my $end = quad2int($endip); ($start, $end) = ($end, $start) if $start > $end; return irange2cidrlist($start, $end); } sub irange2cidrlist { my ($start, $end) = @_; my @result; while ($end >= $start) { my $maxsize = imaxblock($start, 32); my $maxdiff = 32 - floor(log($end - $start + 1)/log(2)); $maxsize = $maxdiff if $maxsize < $maxdiff; push (@result, bless { 'IBASE' => $start, 'BITS' => $maxsize }); $start += 2**(32-$maxsize); } return @result; } sub cidrs2contiglists { my (@cidrs) = sort_network_blocks(@_); my @result; while (@cidrs) { my (@r) = shift(@cidrs); my $max = $r[0]->{IBASE} + $r[0]->size; while ($cidrs[0] && $cidrs[0]->{IBASE} <= $max) { my $nm = $cidrs[0]->{IBASE} + $cidrs[0]->size; $max = $nm if $nm > $max; push(@r, shift(@cidrs)); } push(@result, [@r]); } return @result; } sub cidrs2cidrs { my (@cidrs) = sort_network_blocks(@_); my @result; while (@cidrs) { my (@r) = shift(@cidrs); my $max = $r[0]->{IBASE} + $r[0]->size; while ($cidrs[0] && $cidrs[0]->{IBASE} <= $max) { my $nm = $cidrs[0]->{IBASE} + $cidrs[0]->size; $max = $nm if $nm > $max; push(@r, shift(@cidrs)); } my $start = $r[0]->{IBASE}; my $end = $max - 1; push(@result, irange2cidrlist($start, $end)); } return @result; } sub cidrs2inverse { my $outer = shift; $outer = __PACKAGE__->new2($outer) || croak($error) unless ref($outer); my (@cidrs) = cidrs2cidrs(@_); my $first = $outer->{IBASE}; my $last = $first + $outer->size() -1; shift(@cidrs) while $cidrs[0] && $cidrs[0]->{IBASE} + $cidrs[0]->size < $first; my @r; while (@cidrs && $first <= $last) { if ($first < $cidrs[0]->{IBASE}) { if ($last <= $cidrs[0]->{IBASE}-1) { return (@r, irange2cidrlist($first, $last)); } push(@r, irange2cidrlist($first, $cidrs[0]->{IBASE}-1)); } last if $cidrs[0]->{IBASE} > $last; $first = $cidrs[0]->{IBASE} + $cidrs[0]->size; shift(@cidrs); } if ($first <= $last) { push(@r, irange2cidrlist($first, $last)); } return @r; } sub by_net_netmask_block { $a->{'IBASE'} <=> $b->{'IBASE'} || $a->{'BITS'} <=> $b->{'BITS'}; } sub sameblock { return ! cmpblocks(@_); } sub cmpblocks { my $this = shift; my $class = ref $this; my $other = (ref $_[0]) ? shift : $class->new(@_); return cmp_net_netmask_block($this, $other); } sub contains { my $this = shift; my $class = ref $this; my $other = (ref $_[0]) ? shift : $class->new(@_); return 0 if $this->{IBASE} > $other->{IBASE}; return 0 if $this->{BITS} > $other->{BITS}; return 0 if $other->{IBASE} > $this->{IBASE} + $this->size -1; return 1; } sub cmp_net_netmask_block { return ($_[0]->{IBASE} <=> $_[1]->{IBASE} || $_[0]->{BITS} <=> $_[1]->{BITS}); } sub sort_network_blocks { return map $_->[0], sort { $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] } map [ $_, $_->{IBASE}, $_->{BITS} ], @_; } sub sort_by_ip_address { return map $_->[0], sort { $a->[1] cmp $b->[1] } map [ $_, pack("C4",split(/\./,$_)) ], @_; } BEGIN { for (my $i = 0; $i <= 32; $i++) { $imask[$i] = imask($i); $imask2bits{$imask[$i]} = $i; $quadmask2bits{int2quad($imask[$i])} = $i; $quadhostmask2bits{int2quad(~$imask[$i])} = $i; $size2bits{ 2**(32-$i) } = $i; } } 1; Net-Netmask-1.9016/MANIFEST0000644000175000017500000000031307762230203013601 0ustar muirmuirNetmask.pm Netmask.pod Makefile.PL MANIFEST README CHANGELOG t/netmasks.t t/badnets.t t/sortspeed-ip.t t/sortspeed-blocks.t META.yml Module meta-data (added by MakeMaker) Net-Netmask-1.9016/Makefile.PL0000755000175000017500000000110310774266416014437 0ustar muirmuir use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile being created. WriteMakefile( 'NAME' => 'Net::Netmask', 'DISTNAME' => 'Net-Netmask', 'VERSION_FROM' => 'Netmask.pm', ($] >= 5.005 ? ('ABSTRACT' => 'Understand and manipulate IP netmaks', 'AUTHOR' => 'David Muir Sharnoff ') : ()), 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'} ); package MY; sub postamble { <<"END_OF_POSTAMBLE"; pm_to_blib: README README: Netmask.pod \tpod2text Netmask.pod >README END_OF_POSTAMBLE } Net-Netmask-1.9016/t/0000755000175000017500000000000011522010766012715 5ustar muirmuirNet-Netmask-1.9016/t/netmasks.t0000755000175000017500000004147411522010127014733 0ustar muirmuir#!/usr/bin/perl -I. -w use Net::Netmask; use Net::Netmask qw(sameblock cmpblocks); use Carp; use Carp qw(verbose); use Test::More tests => 295; # addr mask base newmask bits mb my @rtests = qw( 209.157.68.22:255.255.224.0 u 209.157.64.0 255.255.224.0 19 18 209.157.68.22 255.255.224.0 209.157.64.0 255.255.224.0 19 18 209.157.70.33 0xffffe000 209.157.64.0 255.255.224.0 19 18 209.157.70.33/19 u 209.157.64.0 255.255.224.0 19 18 209.157.70.33 u 209.157.70.33 255.255.255.255 32 32 140.174.82 u 140.174.82.0 255.255.255.0 24 23 140.174 u 140.174.0.0 255.255.0.0 16 15 10 u 10.0.0.0 255.0.0.0 8 7 10/8 u 10.0.0.0 255.0.0.0 8 7 209.157.64/19 u 209.157.64.0 255.255.224.0 19 18 209.157.64.0-209.157.95.255 u 209.157.64.0 255.255.224.0 19 18 216.140.48.16/32 u 216.140.48.16 255.255.255.255 32 28 209.157/17 u 209.157.0.0 255.255.128.0 17 16 default u 0.0.0.0 0.0.0.0 0 0 ); push(@rtests, '209.157.68.22#0.0.31.255', 'u', '209.157.64.0', '255.255.224.0', '19', '18'); my @store = qw( 209.157.64.0/19 default 209.157.81.16/28 209.157.80.0/20 ); my @lookup = qw( 209.157.75.75 209.157.64.0/19 209.157.32.10 0.0.0.0/0 209.157.81.18 209.157.81.16/28 209.157.81.14 209.157.80.0/20 ); my @store2 = qw( 209.157.64.0/19 default 209.157.81.16/28 209.157.80.0/24 ); my @lookup2 = qw( 209.157.75.75 209.157.64.0/19 209.157.32.10 0.0.0.0/0 209.157.81.18 209.157.81.16/28 209.157.81.14 209.157.64.0/19 ); my $debug = 0; my $x; my ($addr, $mask, $base, $newmask, $bits, $max); while (($addr, $mask, $base, $newmask, $bits, $max) = splice(@rtests, 0, 6)) { print "# $addr $mask $base $newmask $bits $max\n"; $mask = undef if $mask eq 'u'; $x = new Net::Netmask ($addr, $mask); is($x->base(), $base, "base of $addr"); is($x->mask(), $newmask, "mask of $addr"); is($x->maxblock(), $max, "maxblock of $addr"); is($x->bits(), $bits, "bits of $addr"); } my @y; $x = new Net::Netmask ('209.157.64.0/19'); is($x->size(), 8192, "size of 209.157.64.0/19"); is($x->hostmask(), '0.0.31.255', "hostmask of 209.157.64.0/19"); @y = $x->inaddr(); print "# REVERSE: @y\n"; is ($y[0], '64.157.209.in-addr.arpa'); is ($y[31*3], '95.157.209.in-addr.arpa'); ok(! defined($y[32*3])); $x = new Net::Netmask ('140.174.82.4/32'); is($x->size(), 1, "size of 140.174.82.4/32"); # perl bug: cannot just print this. is(($x->inaddr())[0], '82.174.140.in-addr.arpa'); $x = new Net::Netmask ('140.174.82.64/27'); is(($x->inaddr())[1], 64); is(($x->inaddr())[2], 95); $x = new Net::Netmask ('default'); ok($x->size() == 4294967296); $x = new Net::Netmask ('209.157.64.0/27'); @y = $x->enumerate(); is($y[0], '209.157.64.0'); is($y[31], '209.157.64.31'); ok(! defined($y[32])); $x = new Net::Netmask ('10.2.0.16/19'); @y = $x->enumerate(); is($y[0], '10.2.0.0'); is($y[8191], '10.2.31.255'); ok(! defined($y[8192])); my $table = {}; my $table9 = {}; { for my $b (@store) { $x = new Net::Netmask ($b); $x->storeNetblock(); } } { for my $b (@store2) { $x = new Net::Netmask ($b); $x->storeNetblock($table); $x->storeNetblock($table9); } } my $result; while (($addr, $result) = splice(@lookup, 0, 2)) { my $nb = findNetblock($addr); printf "# lookup(%s): %s, wanting %s.\n", $addr, $nb->desc(), $result; is($nb->desc(), $result, "$addr / $result"); } while (($addr, $result) = splice(@lookup2, 0, 2)) { my $nb = findNetblock($addr, $table); printf "# lookup(%s): %s, wanting %s.\n", $addr, $nb->desc(), $result; is($nb->desc(), $result, "$addr / $result"); } $newmask = Net::Netmask->new("192.168.1.0/24"); is($newmask->broadcast(), "192.168.1.255"); is($newmask->next(), "192.168.2.0"); ok($newmask->match("192.168.1.0")); ok($newmask->match("192.168.1.255")); ok($newmask->match("192.168.1.63")); ok(! $newmask->match("192.168.0.255")); ok(! $newmask->match("192.168.2.0")); ok(! $newmask->match("10.168.2.0")); ok(! $newmask->match("209.168.2.0")); is($newmask->nth(1),'192.168.1.1'); is($newmask->nth(-1),'192.168.1.255'); is($newmask->nth(-2),'192.168.1.254'); is($newmask->nth(0),'192.168.1.0'); ok($newmask->match('192.168.1.1') == 1); ok($newmask->match('192.168.1.100') == 100); ok($newmask->match('192.168.1.255') == 255); ok(($newmask->match('192.168.2.1') == 0)); ok(!($newmask->match('192.168.2.1'))); ok(((0+$newmask->match('192.168.1.0')) == 0)); ok(($newmask->match('192.168.1.0'))); my $bks; $block = new Net::Netmask '209.157.64.1/32'; $block->storeNetblock($bks); ok(findNetblock('209.157.64.1',$bks)); my @store3 = qw( 216.240.32.0/19 216.240.40.0/24 216.240.40.0/27 216.240.40.4/30 ); my $table3 = {}; my $table8 = {}; my $table7 = {}; my $table6 = {}; for my $b (@store3) { $x = new Net::Netmask ($b); $x->storeNetblock($table3); $x->storeNetblock($table8); $x->storeNetblock($table7); $x->storeNetblock($table6); } lookeq($table3, "216.240.40.5", "216.240.40.4/30"); lookeq($table3, "216.240.40.1", "216.240.40.0/27"); lookeq($table3, "216.240.40.50", "216.240.40.0/24"); lookeq($table3, "216.240.50.150", "216.240.32.0/19"); lookeq($table3, "209.157.32.32", undef); fdel("216.240.40.1", "216.240.40.0/27", $table3); lookeq($table3, "216.240.40.5", "216.240.40.4/30"); lookeq($table3, "216.240.40.1", "216.240.40.0/24"); lookeq($table3, "216.240.40.50", "216.240.40.0/24"); lookeq($table3, "216.240.50.150", "216.240.32.0/19"); lookeq($table3, "209.157.32.32", undef); fdel("216.240.50.150", "216.240.32.0/19", $table3); lookeq($table3, "216.240.40.5", "216.240.40.4/30"); lookeq($table3, "216.240.40.1", "216.240.40.0/24"); lookeq($table3, "216.240.40.50", "216.240.40.0/24"); lookeq($table3, "216.240.50.150", undef); lookeq($table3, "209.157.32.32", undef); fdel("216.240.40.4", "216.240.40.4/30", $table3); lookeq($table3, "216.240.40.5", "216.240.40.0/24"); lookeq($table3, "216.240.40.1", "216.240.40.0/24"); lookeq($table3, "216.240.40.50", "216.240.40.0/24"); lookeq($table3, "216.240.50.150", undef); lookeq($table3, "209.157.32.32", undef); fdel("216.240.40.4", "216.240.40.0/24", $table3); lookeq($table3, "216.240.40.5", undef); lookeq($table3, "216.240.40.1", undef); lookeq($table3, "216.240.40.50", undef); lookeq($table3, "216.240.50.150", undef); lookeq($table3, "209.157.32.32", undef); sub lookeq { my ($table, $value, $result) = @_; my $found = findNetblock($value, $table); if ($result) { is($found->desc, $result, "value='$value' found=@{[$found->desc]}"); } else { ok(! $found, $value); } } sub fdel { my ($value, $result, $table) = @_; my $found = findNetblock($value, $table); #print "search for $value, found and deleting @{[ $found->desc ]} eq $result\n"; is($found->desc, $result, "$value / $result"); $found->deleteNetblock($table); } my (@c) = range2cidrlist("66.33.85.239", "66.33.85.240"); my $dl = dlist(@c); ok($dl eq '66.33.85.239/32 66.33.85.240/32'); (@c) = range2cidrlist('216.240.32.128', '216.240.36.127'); $dl = dlist(@c); ok($dl eq '216.240.32.128/25 216.240.33.0/24 216.240.34.0/23 216.240.36.0/25'); my @d; @d = (@c[0,1,3]); my (@e) = cidrs2contiglists(@d); ok(@e == 2); is(dlist(@{$e[0]}), '216.240.32.128/25 216.240.33.0/24'); is(dlist(@{$e[1]}), '216.240.36.0/25'); sub dlist { my (@b) = @_; return join (' ', map { $_->desc() } @b); } sub generate { my $count = shift || 10000; my @list; $list[$count-1]=''; ## preallocate for (my $i=0; $i<$count; $i++) { my $class = int(rand(3)); if ($class == 0) { ## class A ( 1.0.0.0 - 126.255.255.255 ) $list[$i] = int(rand(126))+1; } elsif ($class == 1) { ## class B ( 128.0.0.0 - 191.255.255.255 ) $list[$i] = int(rand(64))+128; } else { ## class C ( 192.0.0.0 - 223.255.255.255 ) $list[$i] = int(rand(32))+192; } $list[$i] .= '.' . int(rand(256)); $list[$i] .= '.' . int(rand(256)); $list[$i] .= '.' . int(rand(256)); } return @list; } sub by_net_netmask_block2 { $a->{'IBASE'} <=> $b->{'IBASE'} || $a->{'BITS'} <=> $b->{'BITS'}; } my (@iplist) = generate(500); my (@sorted1) = sort_by_ip_address(@iplist); my (@blist) = map { new Net::Netmask $_ } @iplist; my (@clist) = sort @blist; my (@sorted2) = map { $_->base() } @clist; my (@dlist) = sort @blist; my (@sorted3) = map { $_->base() } @dlist; SKIP: { skip 2 if $] < 5.006_001; is("@sorted1", "@sorted2"); is("@sorted1", "@sorted3"); } my $q144 = new Net::Netmask '216.240.32.0/25'; for my $i (qw(216.240.32.0/24 216.240.32.0/26 216.240.33.0/25)) { my $q144p = new Net::Netmask $i; print "# working on $i\n"; ok (! ($q144 eq $q144p)); ok (! ($q144 == $q144p)); ok (! (sameblock($q144, $i))); ok (! ($q144->sameblock($i))); ok (cmpblocks($q144, $i)); ok ($q144->cmpblocks($i)); } my $q144pp = new Net::Netmask '216.240.32.0/25'; ok (($q144 == $q144pp)); ok (($q144 eq $q144pp)); ok (($q144->desc eq "$q144")); ok ($q144->sameblock('216.240.32.0/25')); ok (sameblock($q144, '216.240.32.0/25')); ok (! (cmpblocks($q144, '216.240.32.0/25'))); ok (! ($q144->cmpblocks('216.240.32.0/25'))); my $dnts = join(' ',dumpNetworkTable($table9)); is($dnts, '0.0.0.0/0 209.157.64.0/19 209.157.80.0/24 209.157.81.16/28'); sub lookouter { my ($table, $value, $result) = @_; my $found = findOuterNetblock($value, $table); if ($result) { is($found->desc, $result, "value = $value, result = $result"); } else { ok(! $found, "value = $value"); } } # 216.240.32.0/19 # 216.240.40.0/24 # 216.240.40.0/27 # 216.240.40.4/30 lookouter($table8, "216.240.40.5", "216.240.32.0/19"); lookouter($table8, "216.240.40.1", "216.240.32.0/19"); lookouter($table8, "216.240.40.50", "216.240.32.0/19"); lookouter($table8, "216.240.50.150", "216.240.32.0/19"); lookouter($table8, "209.157.32.32", undef); fdel("216.240.32.10", "216.240.32.0/19", $table8); lookouter($table8, "216.240.40.5", "216.240.40.0/24"); lookouter($table8, "216.240.40.1", "216.240.40.0/24"); lookouter($table8, "216.240.40.50", "216.240.40.0/24"); lookouter($table8, "216.240.50.150", undef); lookouter($table8, "209.157.32.32", undef); fdel("216.240.40.150", "216.240.40.0/24", $table8); lookouter($table8, "216.240.40.5", "216.240.40.0/27"); lookouter($table8, "216.240.40.1", "216.240.40.0/27"); lookouter($table8, "216.240.40.50", undef); lookouter($table8, "216.240.50.150", undef); lookouter($table8, "209.157.32.32", undef); fdel("216.240.40.3", "216.240.40.0/27", $table8); lookouter($table8, "216.240.40.5", "216.240.40.4/30"); lookouter($table8, "216.240.40.1", undef); lookouter($table8, "216.240.40.50", undef); lookouter($table8, "216.240.50.150", undef); lookouter($table8, "209.157.32.32", undef); fdel("216.240.40.4", "216.240.40.4/30", $table8); lookouter($table8, "216.240.40.5", undef); lookouter($table8, "216.240.40.1", undef); lookouter($table8, "216.240.40.50", undef); lookouter($table8, "216.240.50.150", undef); lookouter($table8, "209.157.32.32", undef); sub lookouterO { my ($table, $value, $result) = @_; my $block = new2 Net::Netmask $value; my $found = findOuterNetblock($block, $table); if ($result) { is($found->desc, $result, "value = $value"); } else { ok(! $found); } } lookouterO($table7, "216.240.40.5/30", "216.240.32.0/19"); lookouterO($table7, "216.240.40.5/29", "216.240.32.0/19"); lookouterO($table7, "216.240.40.50/24", "216.240.32.0/19"); lookouterO($table7, "216.240.50.150/23", "216.240.32.0/19"); lookouterO($table7, "209.157.32.32", undef); fdel("216.240.32.10", "216.240.32.0/19", $table7); lookouterO($table7, "216.240.40.5/30", "216.240.40.0/24"); lookouterO($table7, "216.240.40.5/29", "216.240.40.0/24"); lookouterO($table7, "216.240.40.50/24", "216.240.40.0/24"); lookouterO($table7, "216.240.50.150/23", undef); lookouterO($table7, "209.157.32.32", undef); fdel("216.240.40.150", "216.240.40.0/24", $table7); lookouterO($table7, "216.240.40.5/30", "216.240.40.0/27"); lookouterO($table7, "216.240.40.5/29", "216.240.40.0/27"); lookouterO($table7, "216.240.40.50/24", undef); lookouterO($table7, "216.240.50.150/23", undef); lookouterO($table7, "209.157.32.32", undef); fdel("216.240.40.3", "216.240.40.0/27", $table7); lookouterO($table7, "216.240.40.5/30", "216.240.40.4/30"); lookouterO($table7, "216.240.40.5/29", undef); lookouterO($table7, "216.240.40.50/24", undef); lookouterO($table7, "216.240.50.150/23", undef); lookouterO($table7, "209.157.32.32", undef); fdel("216.240.40.4", "216.240.40.4/30", $table7); lookouterO($table7, "216.240.40.5/30", undef); lookouterO($table7, "216.240.40.1/29", undef); lookouterO($table7, "216.240.40.50/24", undef); lookouterO($table7, "216.240.50.150/23", undef); lookouterO($table7, "209.157.32.32/8", undef); sub ctest { my $a = new Net::Netmask shift; my $b = new Net::Netmask shift; print "# ctest($a, $b)\n"; ok($a->contains($a)); ok($b->contains($b)); ok($a->contains($b)); ok(($a->sameblock($b) || ! $b->contains($a))); } sub ctestno { my $a = new Net::Netmask shift; my $b = new Net::Netmask shift; print "# ctestno($a, $b)\n"; ok (! $a->contains($b)); ok (! $b->contains($a)); } ctest("10.20.30.0/24", "10.20.30.0/25"); ctest("10.20.30.0/23", "10.20.30.0/24"); ctest("10.20.30.0/24", "10.20.30.128/25"); ctest("0.0.0.0/8", "0.255.255.255/32"); ctest("255.255.255.255/32", "255.255.255.255/32"); ctest("255.255.255.0/24", "255.255.255.255/32"); ctest("66.106.19.144/28", "66.106.19.152/29"); ctest("66.106.19.144/28", "66.106.19.144/29"); ctestno("66.106.19.144/28", "66.106.19.168/29"); ctestno("66.106.19.144/28", "198.175.15.10/29"); ctestno("66.106.19.144/28", "66.106.19.160/29"); sub multinew { return map { new Net::Netmask $_ } @_; } (@c) = cidrs2cidrs(multinew(qw(216.240.32.0/25 216.240.32.128/25 216.240.33.0/25 216.240.34.0/24))); $dl = dlist(@c); ok ($dl eq '216.240.32.0/24 216.240.33.0/25 216.240.34.0/24'); (@c) = cidrs2cidrs(multinew(qw(216.240.32.0/32 216.240.32.1/32 216.240.32.2/32 216.240.32.3/32 216.240.32.4/32))); $dl = dlist(@c); ok ($dl eq '216.240.32.0/30 216.240.32.4/32'); (@c) = cidrs2cidrs(multinew(qw(216.240.32.64/28 216.240.32.0/25 216.240.32.128/25 216.240.33.0/25 216.240.34.0/24))); $dl = dlist(@c); ok ($dl eq '216.240.32.0/24 216.240.33.0/25 216.240.34.0/24'); my $block = new Net::Netmask ('172.2.4.0', '255.255.255.0'); $table = {}; $block->storeNetblock($table); @b = findAllNetblock('172.2.4.1', $table); ok( $#b == 0 ); $block->tag('a', 'b'); $block->tag('b', 'c'); $block->tag('c', 'x'); $block->tag('c', undef); $block->tag('d', 'x'); $block->tag('d'); ok( $block->tag('a') eq 'b'); ok( $block->tag('b') eq 'c'); ok( !defined($block->tag('c'))); ok( $block->tag('d') eq 'x'); ok( $block->tag('a') eq 'b'); (@c) = cidrs2inverse('216.240.32.0/22', (multinew(qw(216.240.32.64/28 216.240.32.0/25 216.240.32.128/25 216.240.33.0/25 216.240.34.0/24)))); $dl = dlist(@c); ok ($dl eq '216.240.33.128/25 216.240.35.0/24'); (@c) = cidrs2inverse('216.240.32.0/22', (multinew(qw(215.0.0.0/16 216.240.32.64/28 216.240.32.0/25 216.240.32.128/25 216.240.33.0/25 216.240.34.0/24 216.240.45.0/24)))); $dl = dlist(@c); ok ($dl eq '216.240.33.128/25 216.240.35.0/24'); (@c) = cidrs2inverse('216.240.32.0/22', (multinew(qw(216.240.0.0/16 215.0.0.0/16 216.240.32.64/28 216.240.32.0/25 216.240.32.128/25 216.240.33.0/25 216.240.34.0/24 216.240.45.0/24)))); $dl = dlist(@c); ok ($dl eq ''); my $table77 = {}; my $block77 = new2 Net::Netmask("10.1.2.0/24", $table77); $block77->storeNetblock(); ok(! defined(findNetblock("10.2.1.0", $table77))); { my $b = new Net::Netmask("192.168.0.0/23"); my @t = ( undef , '192.168.2.0/23', # => would turn undef into "undef" 10 => '192.168.20.0/23', 7 => '192.168.14.0/23', -1 => '192.167.254.0/23', ); while (@t) { my $arg = shift(@t); my $result = shift(@t); is($b->nextblock($arg)."", $result, "$result"); } } { my $obj1 = new2 Net::Netmask ('1.0.0.4/31'); my $obj2 = new2 Net::Netmask ('1.0.0.4/32'); my @leftover = cidrs2inverse($obj1, $obj2); # print "leftover = @leftover\n"; ok(@leftover == 1); ok("$leftover[0]" eq "1.0.0.5/32"); } { my $obj1 = new2 Net::Netmask ('1.0.0.4/32'); my $obj2 = new2 Net::Netmask ('1.0.0.0/8'); my @leftover = cidrs2inverse($obj1, $obj2); ok(! @leftover, "@leftover"); } { my $obj1 = new2 Net::Netmask ('1.0.0.4/32'); my $obj2 = new2 Net::Netmask ('1.0.0.4/32'); my @leftover = cidrs2inverse($obj1, $obj2); ok(! @leftover, "@leftover"); } { my $obj1 = new2 Net::Netmask ('1.0.0.4/32'); my $obj2 = new2 Net::Netmask ('1.0.0.6/32'); my @leftover = cidrs2inverse($obj1, $obj2); ok(@leftover == 1); ok("$leftover[0]" eq '1.0.0.4/32'); } { my $obj1 = new2 Net::Netmask ('1.0.0.4/31'); my $obj2 = new2 Net::Netmask ('1.0.0.5/32'); my @leftover = cidrs2inverse($obj1, $obj2); ok(@leftover == 1); ok("$leftover[0]" eq '1.0.0.4/32'); } { my $obj1 = new2 Net::Netmask ('1.0.0.4/31'); my $obj2 = new2 Net::Netmask ('1.0.0.4/32'); my @leftover = cidrs2inverse($obj1, $obj2); ok(@leftover == 1); ok("$leftover[0]" eq '1.0.0.5/32'); } { my $obj1 = new2 Net::Netmask ('217.173.192.0/21'); my $obj2 = new2 Net::Netmask ('217.173.200.0/21'); is("$obj1", '217.173.192.0/21'); is("$obj2", '217.173.200.0/21'); ok(! $obj1->contains($obj2)); ok(! $obj2->contains($obj1)); } { my $warnings = ''; local($SIG{__WARN__}) = sub { $warnings = $_[0] }; my $block = findNetblock("127.0.0.", { 1 => []}); is($warnings, ''); } Net-Netmask-1.9016/t/sortspeed-ip.t0000644000175000017500000000270607775375342015550 0ustar muirmuir#!/usr/bin/perl -I. -w # # I've been told at times that this or that sort function is # faster for sorting IP addresses. I've decied that I won't # accept undocumented claims anymore. # # This file provides a way to test out sort functions. If you # think you've got a faster one, please try re-defining &mysortfunc. # If it's faster, let me know. If it's not, don't. # sub mysortfunc { return sort { pack("C4",split(/\./,$a)) cmp pack("C4",split(/\./,$b)) } @_ } BEGIN { unless (-t STDOUT) { print "1..0 # Skipped: this is for people looking for faster sorts\n"; exit(0); } } use Net::Netmask; use Net::Netmask qw(sameblock cmpblocks); use Carp; use Carp qw(verbose); use Benchmark qw(cmpthese); sub generate { my $count = shift || 10000; my @list; $list[$count-1]=''; ## preallocate for (my $i=0; $i<$count; $i++) { my $class = int(rand(3)); if ($class == 0) { ## class A ( 1.0.0.0 - 126.255.255.255 ) $list[$i] = int(rand(126))+1; } elsif ($class == 1) { ## class B ( 128.0.0.0 - 191.255.255.255 ) $list[$i] = int(rand(64))+128; } else { ## class C ( 192.0.0.0 - 223.255.255.255 ) $list[$i] = int(rand(32))+192; } $list[$i] .= '.' . int(rand(256)); $list[$i] .= '.' . int(rand(256)); $list[$i] .= '.' . int(rand(256)); } return @list; } my (@iplist) = generate(500); cmpthese (-1, { candidate => sub { my (@x) = mysortfunc(@iplist); }, distributed => sub { my (@x) = sort_by_ip_address(@iplist); }, }); Net-Netmask-1.9016/t/sortspeed-blocks.t0000644000175000017500000000271607775402545016412 0ustar muirmuir#!/usr/bin/perl -I. -w # # I've been told at times that this or that sort function is # faster for sorting IP addresses. I've decied that I won't # accept undocumented claims anymore. # # This file provides a way to test out sort functions. If you # think you've got a faster one, please try re-defining &mysortfunc. # If it's faster, let me know. If it's not, don't. # sub mysortfunc { return sort @_; } BEGIN { unless (-t STDOUT) { print "1..0 # Skipped: this is for people looking for faster sorts\n"; exit(0); } } use Net::Netmask; use Net::Netmask qw(int2quad quad2int imask); use Carp; use Carp qw(verbose); use Benchmark qw(cmpthese); sub generate { my ($count) = @_; my @list; while ($count-- > 0) { my ($a, $b, $c, $d); my $class = int(rand(3)); if ($class == 0) { ## class A ( 1.0.0.0 - 126.255.255.255 ) $a = int(rand(126))+1; } elsif ($class == 1) { ## class B ( 128.0.0.0 - 191.255.255.255 ) $a = int(rand(64))+128; } else { ## class C ( 192.0.0.0 - 223.255.255.255 ) $a = int(rand(32))+192; } $b = int(rand(256)); $c = int(rand(256)); $d = int(rand(256)); $mask = int(sqrt(rand(1024))); my $i = quad2int("$a.$b.$c.$d") & imask($mask); my $base = int2quad($i); push(@list, new Net::Netmask "$base/$mask"); } return @list; } my (@iplist) = generate(5000); cmpthese (-1, { candidate => sub { my (@x) = mysortfunc(@iplist); }, distributed => sub { my (@x) = sort_network_blocks(@iplist); }, }); Net-Netmask-1.9016/t/badnets.t0000755000175000017500000000545307664502451014545 0ustar muirmuir#!/usr/bin/perl -I. -w BEGIN { $| = 1; print "1..28\n";} use Net::Netmask; $loaded = 1; print "ok 1\n"; END {print "not ok 1\n" unless $loaded;} sub test { local($^W)=0; my($num,$true,$msg)=@_; print($true ? "ok $num\n" : "not ok $num $msg\n"); } ################################################################################ use strict; my $debug = 0; test(2,Net::Netmask->debug($debug)==$debug,"unable to set debug"); # test a variety of ip's with bytes greater than 255. # all these tests should return undef test(3,!defined(Net::Netmask->new2('209.256.68.22:255.255.224.0')), "bad net byte"); test(4,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(5,!defined(Net::Netmask->new2('209.180.68.22:256.255.224.0')), "bad mask byte"); test(6,scalar(Net::Netmask->errstr =~ /^illegal netmask:/),"errstr mismatch"); test(7,!defined(Net::Netmask->new2('209.157.300.22','255.255.224.0')), "bad net byte"); test(8,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(9,!defined(Net::Netmask->new2('300.157.70.33','0xffffe000')), "bad net byte"); test(10,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(11,!defined(Net::Netmask->new2('209.500.70.33/19')), "bad net byte"); test(12,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(13,!defined(Net::Netmask->new2('140.999.82')), "bad net byte"); test(14,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(15,!defined(Net::Netmask->new2('899.174')), "bad net byte"); test(16,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(17,!defined(Net::Netmask->new2('900')), "bad net byte"); test(18,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(19,!defined(Net::Netmask->new2('209.157.300/19')), "bad net byte"); test(20,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); test(21,!defined(Net::Netmask->new2('209.300.64.0-209.157.95.255')), "bad net byte"); test(22,scalar(Net::Netmask->errstr =~ /^illegal dotted quad/), "errstr mismatch"); test(23,!defined(Net::Netmask->new2('209.300/17')), "bad net byte"); test(24,scalar(Net::Netmask->errstr =~ /^could not parse /),"errstr mismatch"); # test whois numbers with space between dash test(25,Net::Netmask->new2('209.157.64.0 - 209.157.95.255'), "whois with single space around dash"); test(26,Net::Netmask->new2('209.157.64.0 - 209.157.95.255'), "whois with mulitple spaces around dash"); # test ranges that are a power-of-two big, but are not legal blocks test(27,! Net::Netmask->new2('218.0.0.0 - 221.255.255.255'), "could not find exact fit for 218.0.0.0 - 221.255.255.255"); test(28,! Net::Netmask->new2('218.0.0.4 - 218.0.0.11'), "could not find exact fit for 218.0.0.4 - 218.0.0.11"); Net-Netmask-1.9016/CHANGELOG0000644000175000017500000001406211522010551013657 0ustar muirmuir = 2011/03/22 1.9016 Fix bug #46996: warnings issued for bad input. Fix bug #43348: use POSIX::floor() instead of int() Rewrite netmask.t to use Test::More = 2006/11/30 1.9015 Fix bug # 22662 reported by grjones at gmail: cidrs2inverse wouldn't notice /32-sized leftovers. = 2006/10/13 1.9014 Fix bug # 22085 reported by grjones at gmail: cidrs2inverse wouldn't notice /32-sized holes. = 2006/09/06 1.9013 Added the nextblock() method as suggested by Robert Drake Bugfix: it couldn't parse 10/8 or 127/8 = 2004/05/31 1.9011 Some speed improvements from Todd R. Eigenschink = 2004/04/12 1.9009 Fix to netmasks.t for compatability with older perls = 2004/04/06 1.9008 Added cidrs2inverse() which will find the gaps in a list of blocks. Based on a request from Howard Jones the tag() method was added. It allows you to store your own data in a Net::Netmask object. (Of course, you could have anyway as long as you didn't use the keys 'IBASE' or 'BITS') Long ago, Alexandros M Manoussakis reported a bug that findAllNetblock would often return the same block multiple times. Fixed. Based on requests from Alexandros M Manoussakis and Lamprecht Andreas the undefined behavior for overlapping blocks with cidrs2contiglists is no longer. Such blocks will be in the same sublist. Based on a requests from Tom Rudnick and Anthony Pardini new function was added: cidrs2cidrs(). cidrs2cidrs will condense a set of netblocks by combining blocks together that make up larger blocks. Anthony Pardini , Frank Tegtmeyer and George Walker pointed me to a bug with the contains() method. Fixed. = 2004/01/01 1.9007 At Max Baker 's request, the "require 5.6.1" was removed for better compatability with older perl versions. = 2003/12/05 1.9006 Removed '@'s from this file. = 2003/11/29 1.9005 Matija Papec suggested that I do a Schwartzian transform on the IP address sort function. I tried it. It's faster. Sort function replaced. Added a sort_network_blocks function. Added a contains() function to test if one block fits within another. Peter Chen was concerned about using an illegal bitmask. Now checked. Long ago, Alexandros M Manoussakis noted that could be exported even though it was in EXPORT_OK. Fixed. = 2003/05/28 1.9004 Martin Lorensen : make 'any' a synonym for 'default'. Bugfix (aslo from Martin): fix the require to accept 5.6.1 = 2003/05/26 1.9003 Roman Shishkin provided several (public exported) functions for looking at network tables: dumpNetworkTable() checkNetblock() Inspired: changing findOuterNetblock() so it can take a block as it's IP address. Bugfix: notice that '218.0.0.0 - 221.255.255.255' isn't a valid netmask. Reported by Dan Wright . Bugfix: could not specify network '0.0.0.0-255.255.255.255'. Fix from Dominic Mitchell . Added ->sameblock() from Martin Lorensen Added ->cmpblocks(). Added overloaded stringification so that blocks stringify to their description. Added overloaded block comparision so that blocks can be compared and sorted. Added hostmask syntax a.b.c.d#hostmask - Martin Lorensen Bugfix: t/badnets.t was missing from the MANIFEST. Some spelling and typo mistakes fixed in the documentation. = 2001/11/12 Change the license to make the Debian folks happy. Interface through Jonas Smedegaard . = 2001/09/29 Sapient Fridge and Alexander Karptsov sent a patch for a bug in range2cidrlist. The last IP in the range was skipped. Sam Denton requested support for a.b.c.d/mask.mask.mask.mask. Sam also sent a request that I include the world's fastest sort-by-ip-address-in-perl function in Net::Netmask as there didn't seem to be a better place to put it. I've included it. The function in question was found/benchmarked by John Porter and written about in the Perl-Users Digest, Issue 3860, Volume 8. Sam sent a patch to eliminate a couple of trailing spaces in the error codes. My IP address are now 216.240.32/19 instead of 140.174.82/19 and thus I've changed the examples in the pod. :-) = 2001/05/15 Added deleteNetblock to match storeNetblock. Carol Lerche contributed findOuterNetblock() and findAllNetblocks(). Kevin Baker sent in patches that suggested a new handling of error conditions; extra error conditions to test for; and a test script to exercise the error conditions. Bruce Peikon sent a contribution which suggested that enumerate could do so by network. Dominic Mitchell sent in code that suggested the creation of cidrs2contiglists() and range2cidrlist(). A couple of documentation fixes from Igor Vinokurov . = 1999/09/20 Modified the match() method to return the position within the block. = 1999/09/15 Added support for understanding network blocks in the form that the whois database uses: FirstIP-LastIP. = 1999/03/27 Jochen Wiedmann contributed a function to test an IP address and a block to test see if the IP address is in the block. Accordingly, there is now a match() method. Rob Walker contributed a function to return the first usable adress in a block. Instead of using that, I added a function to return the nth address in a block. There is now an nth() function. = 1998/11/29 Jean-Luc Szpyrka requested that a function be provided that returns the oposite of a netmask. Accordingly, there is now the hostmask() method. http://faqchest.dynhost.com/prgm/perlu-l/perl-98/perl-9809/perl-980905/perl98093023_24256.html