Net-Netmask-1.9104/0000775000175000017500000000000013326722143013571 5ustar jmaslakjmaslakNet-Netmask-1.9104/META.yml0000644000175000017500000000241113326722143015036 0ustar jmaslakjmaslak--- abstract: 'Understand and manipulate IP netmasks' author: - 'Joelle Maslak ' build_requires: Benchmark: '0' Test2::V0: '0.000111' Test::UseAllModules: '0.17' utf8: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Netmask provides: Net::Netmask: file: lib/Net/Netmask.pm version: '1.9104' recommends: AnyEvent: '7.14' requires: Carp: '0' Exporter: '0' Math::BigInt: '1.999811' POSIX: '0' overload: '0' perl: 5.006_001 strict: '0' vars: '0' warnings: '0' resources: bugtracker: https://github.com/jmaslak/Net-Netmask/issues homepage: http://search.cpan.org/~jmaslak/Net-Netmask/ repository: git://github.com/jmaslak/Net-Netmask.git version: '1.9104' x_contributors: - 'Joelle Maslak ' - 'David Muir Sharnoff ' - 'Adam Herzog ' - 'Ben Kolera ' - 'David Steinbrunner ' - 'bay-max1 <34803732+bay-max1@users.noreply.github.com>' x_serialization_backend: 'YAML::Tiny version 1.70' Net-Netmask-1.9104/Changes0000644000175000017500000001706013326722143015066 0ustar jmaslakjmaslak Revision history for Perl module Net::Netmask 1.9104 2018-06-27 - IPv6 support is now GA! 1.9104 2018-06-26 - DEV release only - IPv6 support - Add Code of Conduct 1.9103 2018-06-18 - Use ASCII-like regex matching (Github #4) - Convert tests to Test2 - Pass perlcritic tests - Pass Kwalitee tests - Add contributor information - Add protocol() method (just a stub today that will always return 'IPv4') 1.9102 2018-06-18 - DEV release only - Contains most changes that made it to 1.9103. 1.9101 2018-06-02 - fix precision issue on long-double platforms (BAYMAX) - Convert to use Dist::Zilla - Formatting changes 1.9100 2018-06-02 - DEV release only - fix precision issue on long-double platforms (BAYMAX) - Convert to dist.zilla - Minor formatting changes 1.9022 2015-05-05 - Changes from adamherzog: minor cleanups plus - A bunch of addtional tests - A couple of small code fixes 1.9021 2014-07-17 - Spelling fix in documentation. 1.9019 2013-10-01 - Rename $b to $bits so that netmask can be sorted. Change mostly from https://rt.cpan.org/Ticket/Display.html?id=76939 1.9018 2013-09-26 - Minor MANIFEST fix. 1.9017 2013-09-20 - Add network split() function. - Re-arrange the distribution a bit. 1.9016 2011-03-22 - Fix bug #46996: warnings issued for bad input. - Fix bug #43348: use POSIX::floor() instead of int() - Rewrite netmask.t to use Test::More 1.9015 2006-11-30 - Fix bug # 22662 reported by grjones at gmail: cidrs2inverse wouldn't notice /32-sized leftovers. 1.9014 2006-10-13 - Fix bug # 22085 reported by grjones at gmail: cidrs2inverse - wouldn't notice /32-sized holes. 1.9013 2006-09-06 - Added the nextblock() method as suggested by Robert Drake - Bugfix: it couldn't parse 10/8 or 127/8 1.9011 2004-05-31 - Some speed improvements from Todd R. Eigenschink 1.9009 2004-04-12 - Fix to netmasks.t for compatability with older perls 1.9008 2004-04-06 - 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. 1.9007 2004-01-01 - At Max Baker 's request, the "require 5.6.1" was removed for better compatability with older perl versions. 1.9006 2003-12-05 - Removed '@'s from this file. 1.9005 2003-11-29 - 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. 1.9004 2003-05-28 - Martin Lorensen : make 'any' a synonym for 'default'. - Bugfix (aslo from Martin): fix the require to accept 5.6.1 1.9003 2003-05-26 - 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. 1.9002 2001-11-12 - Change the license to make the Debian folks happy. Interface through Jonas Smedegaard . 1.9001 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. :-) 1.9 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 . 1.8 1999-09-20 - Modified the match() method to return the position within the block. 1.7 1999-09-15 - Added support for understanding network blocks in the form that the whois database uses: FirstIP-LastIP. 1.6 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. 1.4 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 Net-Netmask-1.9104/CONTRIBUTING0000644000175000017500000000323213326722143015421 0ustar jmaslakjmaslakWow, you want to help? That's great! If you want to help: * Don't change the public interface. You can add to it, but don't break code that already depends on this interface. * I'll take bug reports however you want to send them (RT, Github issue, email, etc). My preference is for Github issues. * I'll take code changes however you want to send them, but prefer it via Github pull request. * If you make suggestions/changes, I'll credit you unless you ask specifically otherwise. I'll use your email and PAUSE ID (if applicable) if I can find it. If I get this wrong or you change either, just jot me a note or PR to change it. Some things you can do that would make me smile: * Feel free to look at the TODO file - I've pointed out some things I want to do with the module. Feel free to do any of them (but if it is a bigger item, you might jot me a note first so that I don't accidentally duplicate your effort!) * Write tests for things that are known to be broken. Mark those as "todo" tests so that the failures do not cause build failures. * Improvements to documentation are always appreciated * If the module is missing something you would find useful, or you're confused about something, or if it doesn't seem to work the way you want, email me or open a Github issue. The module makes sense to me and my way of working, but if it doesn't to you, you probably are not the only person who it doesn't make sense to. * "Meta" stuff is great too - I'm no expert on Dist::Zilla and all that it can/should do. So please feel free to send me suggestions or PR for packaging, metafiles, etc Net-Netmask-1.9104/LICENSE0000644000175000017500000004404513326722143014603 0ustar jmaslakjmaslakThis software is copyright (c) Various -- See Documentation by Various -- See Documentation. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) Various -- See Documentation by Various -- See Documentation. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) Various -- See Documentation by Various -- See Documentation. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Net-Netmask-1.9104/Makefile.PL0000644000175000017500000000322713326722143015545 0ustar jmaslakjmaslak# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.010. use strict; use warnings; use 5.006001; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Understand and manipulate IP netmasks", "AUTHOR" => "Joelle Maslak ", "BUILD_REQUIRES" => { "Test::UseAllModules" => "0.17" }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Net-Netmask", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.006001", "NAME" => "Net::Netmask", "PREREQ_PM" => { "Carp" => 0, "Exporter" => 0, "Math::BigInt" => "1.999811", "POSIX" => 0, "overload" => 0, "strict" => 0, "vars" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Benchmark" => 0, "Test2::V0" => "0.000111", "Test::UseAllModules" => "0.17", "utf8" => 0 }, "VERSION" => "1.9104", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Benchmark" => 0, "Carp" => 0, "Exporter" => 0, "Math::BigInt" => "1.999811", "POSIX" => 0, "Test2::V0" => "0.000111", "Test::UseAllModules" => "0.17", "overload" => 0, "strict" => 0, "utf8" => 0, "vars" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; if ( $^O eq 'MSWin32' ) { $WriteMakefileArgs{PREREQ_PM}{'Thread::Queue'} = '3.12'; $WriteMakefileArgs{PREREQ_PM}{'threads'} = '0'; } WriteMakefile(%WriteMakefileArgs); Net-Netmask-1.9104/lib/0000775000175000017500000000000013326722143014337 5ustar jmaslakjmaslakNet-Netmask-1.9104/lib/Net/0000775000175000017500000000000013326722143015065 5ustar jmaslakjmaslakNet-Netmask-1.9104/lib/Net/Netmask.pod0000644000175000017500000003463113326722143017200 0ustar jmaslakjmaslak=head1 NAME Net::Netmask - parse, manipulate and lookup IP network blocks =head1 SYNOPSIS use Net::Netmask; $block = Net::Netmask->new(network block) $block = Net::Netmask->new(network block, netmask) $block = Net::Netmask->new2(network block) $block = Net::Netmask->new2(network block, netmask) print $block; # a.b.c.d/bits or 1:2:3::4/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]); print $block->protocol(); 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 and IPv6 CIDR blocks (see L for more information on CIDR blocks). It's built with an object-oriented interface, with functions being methods that operate on a Net::Netmask object. These methods provide nearly all types of information about a network block that you might want. There are also functions to insert a network block into a table and then later lookup network blocks by IP address using 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. All functions understand both IPv4 and IPv6. Matches, finds, etc, will always return false when an IPv4 address is matched against an IPv6 address. IPv6 support was added in 1.9104. =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 IPv6 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 - that is, the hostmask is the bitwise inverse of a netmask). =item '2001:db8:1234:5678::/64' The preferred IPv6 form. =item '2001:db8:1234:5678::9876' A /128 block. =item 'default6' or 'any6' ::/0 (the default route) =back There are two constructor methods: C and C. C differs from C in that it will return undef for invalid netmasks, while 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" or "2001:db8:1234::/48". This is also available as overloaded stringification. =item ->B() Returns base address of the network block as a string. Eg: "216.240.32.0". or "2001:db8:1234::/48". 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" or "ffff:ffff:ffff:ffff::" =item ->B() Returns the host mask which is the opposite of the netmask. Eg: "0.0.0.255" or "::ffff:ffff:ffff:ffff". =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. For IPv6 addresses, this will be a Math::BigInt object. =item ->B() The blocks broadcast address. (The last IP address inside the block.) Eg: 192.168.1.0/24 => 192.168.1.255 or 2001:db8::/64 => 2001:db8::ffff:ffff:ffff:ffff =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 or 2001:db8:0:1::/64 => 2001:db8:0:2::/64 =item ->B() & ->B() Synonyms for ->B() and ->B() =item ->B() Added in version 1.9102. Returns the address family/protocol represented by the block. Either 'IPv4' or 'IPv6'. =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() and 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") or an IPv6 address in standard notation (eg: "2001:db8::1"). 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). Note that for IPv6, this will return failure if more than 1,000,000,000 addresses would be returned. =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 address, use B(-2). =item ->B() Returns an inline list of tuples. For IPv4: There is a tuple for each DNS zone name (at the /24 level) 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. For IPv6: A list is returned with each DNS zone name at the shortest-prefix length possible. This is not returned as a tuple, but just a list of strings. Examples: the list returned for the block '2002::/16' would be a one element list, containing just 2.0.0.2.ip6.arpa'. The list for '2002::/17' would return a two element list containing '0.2.0.0.2.ip6.arpa' and '1.2.0.0.2.ip6.arpa'. =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. =item ->B($parts) Splits a netmask into a number of sub netblocks. This number must be a base 2 number (2,4,8,16,etc.) and the number must not exceed the number of IPs within this netmask. For instance, Net::Netmask->new( '10.0.0.0/24' )->split(2) is equivilent to ( Net::Netmask( '10.0.0.0/25'), Net::Netmask( '10.0.0.128/25' ) ) =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 =over 25 =item B<""> Strinification is overloaded to be the ->B() method. =item B Numerical and string comparisons 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 ... This method also will sort IPv6 addresses, but is not performance optimized. It is correct, however. =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 correspond 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 discontiguous 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 AUTHORS Joelle Maslak (current maintainer) David Muir Sharnoff (original creator/author) =head1 LICENSE Copyright (C) 1998-2006 David Muir Sharnoff. Copyright (C) 2011-2013 Google, Inc. Copyright (C) 2018 Joelle Maslak This module may be used, modified and redistributed under the same terms as Perl itself. =cut Net-Netmask-1.9104/lib/Net/Netmask.pm0000644000175000017500000006541513326722143017036 0ustar jmaslakjmaslak# Copyright (C) 1998-2006 David Muir Sharnoff # Copyright (C) 2011-2013 Google, Inc. # Copyright (C) 2018 Joelle Maslak package Net::Netmask; $Net::Netmask::VERSION = '1.9104'; use 5.006_001; # ABSTRACT: Understand and manipulate IP netmasks # Disable one-arg bless to preserve the existing interface. ## no critic (ClassHierarchies::ProhibitOneArgBless) 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(ascii2int int2quad quad2int %quadmask2bits %quadhostmask2bits imask i6mask int2ascii sameblock cmpblocks contains) ); my $remembered = {}; my %imask2bits; my %size2bits; my @imask; my @i6mask; # our %quadmask2bits; # our %quadhostmask2bits; use vars qw($error $debug %quadmask2bits %quadhostmask2bits); $debug = 1; use strict; use warnings; use Carp; use Math::BigInt; 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; my $proto = 'IPv4'; undef $error; if ( $net =~ m,^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)/([0-9]+)$, ) { ( $base, $bits ) = ( $1, $2 ); } elsif ( $net =~ m,^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)[:/]([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$, ) { $base = $1; my $quadmask = $2; if ( exists $quadmask2bits{$quadmask} ) { $bits = $quadmask2bits{$quadmask}; } else { $error = "illegal netmask: $quadmask"; } } elsif ( $net =~ m,^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)[#]([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$, ) { $base = $1; my $hostmask = $2; if ( exists $quadhostmask2bits{$hostmask} ) { $bits = $quadhostmask2bits{$hostmask}; } else { $error = "illegal hostmask: $hostmask"; } } elsif ( ( $net =~ m,^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$, ) && ( $mask =~ m,[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$, ) ) { $base = $net; if ( exists $quadmask2bits{$mask} ) { $bits = $quadmask2bits{$mask}; } else { $error = "illegal netmask: $mask"; } } elsif ( ( $net =~ m,^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$, ) && ( $mask =~ m,0x[a-f0-9]+,i ) ) { $base = $net; my $imask = hex($mask); if ( exists $imask2bits{$imask} ) { $bits = $imask2bits{$imask}; } else { $error = "illegal netmask: $mask ($imask)"; } } elsif ( $net =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/ && !$mask ) { ( $base, $bits ) = ( $net, 32 ); } elsif ( $net =~ /^[0-9]+\.[0-9]+\.[0-9]+$/ && !$mask ) { ( $base, $bits ) = ( "$net.0", 24 ); } elsif ( $net =~ /^[0-9]+\.[0-9]+$/ && !$mask ) { ( $base, $bits ) = ( "$net.0.0", 16 ); } elsif ( $net =~ /^[0-9]+$/ && !$mask ) { ( $base, $bits ) = ( "$net.0.0.0", 8 ); } elsif ( $net =~ m,^([0-9]+\.[0-9]+\.[0-9]+)/([0-9]+)$, ) { ( $base, $bits ) = ( "$1.0", $2 ); } elsif ( $net =~ m,^([0-9]+\.[0-9]+)/([0-9]+)$, ) { ( $base, $bits ) = ( "$1.0.0", $2 ); } elsif ( $net =~ m,^([0-9]+)/([0-9]+)$, ) { ( $base, $bits ) = ( "$1.0.0.0", $2 ); } elsif ( $net eq 'default' || $net eq 'any' ) { ( $base, $bits ) = ( "0.0.0.0", 0 ); } elsif ( $net =~ m,^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\s*-\s*([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$, ) { # 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] ) ); } elsif ( $net =~ m,^([0-9a-f]*:[0-9a-f]*:[0-9a-f:]*)/([0-9]+)$, ) { # IPv6 with netmask - ex: 2001:db8::/32 if ( $mask ne '' ) { $error = "mask ignored for IPv6 address" } ( $base, $bits, $proto ) = ( $1, $2, 'IPv6' ); } elsif ( $net =~ m,^([0-9a-f]*:[0-9a-f]*:[0-9a-f:]*)$, ) { # IPv6 without netmask - ex: 2001:db8::1234 if ( $mask ne '' ) { $error = "mask ignored for IPv6 address" } ( $base, $bits, $proto ) = ( $1, 128, 'IPv6' ); } elsif ( $net eq 'default6' || $net eq 'any6' ) { if ( $mask ne '' ) { $error = "mask ignored for IPv6 address" } ( $base, $bits, $proto ) = ( "::", 0, 'IPv6' ); } else { $error = "could not parse $net"; $error .= " $mask" if $mask; } carp $error if $error && $debug; $bits = 0 unless $bits; if ( ( $proto eq 'IPv4' ) && ( $bits > 32 ) ) { $error = "illegal number of bits: $bits" unless $error; $bits = 32; } elsif ( ( $proto eq 'IPv6' ) && ( $bits > 128 ) ) { $error = "illegal number of bits: $bits" unless $error; $bits = 128; } $ibase = ascii2int( ( $base || '::' ), $proto ) unless defined $ibase; unless ( defined($ibase) || defined($error) ) { $error = "could not parse $net"; $error .= " $mask" if $mask; } $ibase = i_getnet_addr( $ibase, $bits, $proto ); return bless { 'IBASE' => $ibase, 'BITS' => $bits, 'PROTOCOL' => $proto, ( $error ? ( 'ERROR' => $error ) : () ), }; } sub i_getnet_addr { my ( $ibase, $bits, $proto ) = @_; if ( !defined($ibase) ) { return; } if ( $proto eq 'IPv4' ) { return $ibase & $imask[$bits]; } else { return $ibase & $i6mask[$bits]; } } sub new2 { local ($debug) = 0; my $net = new(@_); return if $error; return $net; } sub errstr { return $error; } sub debug { my $this = shift; return ( @_ ? $debug = shift : $debug ) } sub base { my ($this) = @_; return int2ascii( $this->{IBASE}, $this->{PROTOCOL} ); } sub bits { my ($this) = @_; return $this->{'BITS'}; } sub protocol { my ($this) = @_; return $this->{'PROTOCOL'}; } sub size { my ($this) = @_; if ( $this->{PROTOCOL} eq 'IPv4' ) { return 2**( 32 - $this->{'BITS'} ); } else { return Math::BigInt->new(2)->bpow( 128 - $this->{'BITS'} ); } } sub next { ## no critic: (Subroutines::ProhibitBuiltinHomonyms) my ($this) = @_; # TODO: CONSOLIDATE if ( $this->{PROTOCOL} eq 'IPv4' ) { return int2quad( $this->{'IBASE'} + $this->size() ); } else { return $this->_ipv6next( $this->size ); } } sub broadcast { my ($this) = @_; return int2ascii( $this->{'IBASE'} + $this->size() - 1, $this->{PROTOCOL} ); } *first = \&base; *last = \&broadcast; sub desc { return int2ascii( $_[0]->{IBASE}, $_[0]->{PROTOCOL} ) . '/' . $_[0]->{BITS}; } sub imask { return ( 2**32 - ( 2**( 32 - $_[0] ) ) ); } sub i6mask { my $bits = shift; return Math::BigInt->new(2)->bpow(128) - Math::BigInt->new(2)->bpow( 128 - $bits ); } sub mask { my ($this) = @_; if ( $this->{PROTOCOL} eq 'IPv4' ) { return int2quad( $imask[ $this->{'BITS'} ] ); } else { return int2ascii( $i6mask[ $this->{'BITS'} ], $this->{PROTOCOL} ); } } sub hostmask { my ($this) = @_; if ( $this->{PROTOCOL} eq 'IPv4' ) { return int2quad( ~$imask[ $this->{BITS} ] ); } else { return int2ascii( $i6mask[ $this->{BITS} ] ^ $i6mask[128], $this->{PROTOCOL} ); } } sub nth { my ( $this, $index, $bitstep ) = @_; my $maxbits = $this->{PROTOCOL} eq 'IPv4' ? 32 : 128; my $size = $this->size(); my $ibase = $this->{'IBASE'}; $bitstep = $maxbits unless $bitstep; my $increment = 2**( $maxbits - $bitstep ); $index *= $increment; $index += $size if $index < 0; return if $index < 0; return if $index >= $size; my $i = $ibase + $index; return int2ascii( $i, $this->{PROTOCOL} ); } sub enumerate { my ( $this, $bitstep ) = @_; my $proto = $this->{PROTOCOL}; # Set default step size by protocol $bitstep = ( $proto eq 'IPv4' ? 32 : 128 ) unless $bitstep; my $size = $this->size(); my @ary; ### We should be able to consolidate this if ( $proto eq 'IPv4' ) { my $increment = 2**( 32 - $bitstep ); my $ibase = $this->{'IBASE'}; for ( my $i = 0; $i < $size; $i += $increment ) { push( @ary, int2quad( $ibase + $i ) ); } } else { my $increment = Math::BigInt->new(2)->bpow( 128 - $bitstep ); if ( ( $size / $increment ) > 1_000_000_000 ) { # Let's help the user out and catch really obvious issues. # Asking for a billion IP addresses is probably one of them. # # That said, please contact the author if this number causes # you issues! confess("More than 1,000,000,000 results would be returned, dieing"); } for ( my $i = Math::BigInt->new(0); $i < $size; $i += $increment ) { push( @ary, $this->_ipv6next($i) ); } } return @ary; } sub _ipv6next { my ( $this, $bitstep ) = @_; my $istart = $this->{IBASE}; my $val = $istart + $bitstep; return ipv6Cannonical( int2ascii( $val, $this->{PROTOCOL} ) ); } sub inaddr { my ($this) = @_; if ( $this->{PROTOCOL} eq 'IPv4' ) { return $this->inaddr4(); } else { return $this->inaddr6(); } } sub inaddr4 { 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 inaddr6 { my ($this) = @_; my (@digits) = split //, $this->{IBASE}->to_hex; my $static = floor( $this->{BITS} / 4 ); my $len = floor( ( $static + 3 ) / 4 ); my $remainder = $this->{BITS} % 4; my $blocks = $remainder ? ( 2**( 4 - $remainder ) ) : 1; my @tail; if ( !$len ) { # Specal case: 0 len return ('ip6.arpa'); } push @tail, reverse( @digits[ 0 .. ( $static - 1 ) ] ), 'ip6.arpa'; if ( !$remainder ) { # Special case - at nibble boundary already return ( join '.', @tail ); } my $last = hex $digits[$static]; my @ary; for ( my $i = 0; $i < $blocks; $i++ ) { push @ary, join( '.', sprintf( "%x", $last ), @tail ); $last++; } 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 unless @bytes == 4 && !grep { !( /[0-9]+$/ && $_ < 256 ) } @bytes; return unpack( "N", pack( "C4", @bytes ) ); } sub int2quad { return join( '.', unpack( 'C4', pack( "N", $_[0] ) ) ); } # Uses the internal "raw" representation (such as IBASE). # For IPv4, this is an integer # For IPv6, this is a raw bit string. sub int2ascii { if ( $_[1] eq 'IPv4' ) { return join( '.', unpack( 'C4', pack( "N", $_[0] ) ) ); } elsif ( $_[1] eq 'IPv6' ) { my $addr = ( ref $_[0] ) ne '' ? $_[0]->to_hex : Math::BigInt->new( $_[0] )->to_hex; return ipv6Cannonical($addr); } else { confess("Incorrect call"); } } # Produces the internal "raw" representation (such as IBASE). # For IPv4, this is an integer # For IPv6, this is a raw bit string. sub ascii2int { if ( $_[1] eq 'IPv4' ) { return quad2int( $_[0] ); } elsif ( $_[1] eq 'IPv6' ) { return ipv6ascii2int( $_[0] ); } else { confess("Incorrect call"); } } # Take an IPv6 ASCII address and produce a raw value sub ipv6ascii2int { my $addr = shift; $addr = ipv6NonCompacted($addr); $addr = join '', map { sprintf( "%04x", hex($_) ) } split( /:/, $addr ); return Math::BigInt->from_hex($addr); } # Takes an IPv6 address and produces a standard version seperated by # colons (without compacting) sub ipv6NonCompacted { my $addr = shift; if ( $addr !~ /:/ ) { if ( length($addr) < 32 ) { $addr = ( "0" x ( 32 - length($addr) ) ) . $addr; } $addr =~ s/(....)(?=....)/$1:/gsx; } # Handle address format with trailing IPv6 # Ex: 0:0:0:0:1.2.3.4 if ( $addr =~ m/^[0-9a-f:]+[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/i ) { my ( $l, $r1, $r2, $r3, $r4 ) = $addr =~ m/^([0-9a-f:]+)([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$/i; $addr = sprintf( "%s%02x%02x:%02x%02x", $l, $r1, $r2, $r3, $r4 ); } my ( $left, $right ) = split /::/, $addr; if ( !defined($right) ) { $right = '' } my (@lparts) = split /:/, $left; my (@rparts) = split /:/, $right; # Strip leading 0's & lowercase @lparts = map { $_ =~ s/^0+([0-9a-f]+)/$1/; lc($_) } @lparts; @rparts = map { $_ =~ s/^0+([0-9a-f]+)/$1/; lc($_) } @rparts; # Expand :: my $missing = 8 - ( @lparts + @rparts ); if ($missing) { $addr = join ':', @lparts, ( 0, 0, 0, 0, 0, 0, 0, 0 )[ 0 .. $missing - 1 ], @rparts; } else { $addr = join ':', @lparts, @rparts; } return $addr; } # Compacts an IPv6 address (reduces successive :0: runs) sub ipv6AsciiCompact { my $addr = shift; # Compress, per RFC5952 if ( $addr =~ s/^0:0:0:0:0:0:0:0$/::/ ) { return $addr; } elsif ( $addr =~ s/(:?^|:)0:0:0:0:0:0:0(:?:|$)/::/ ) { return $addr; } elsif ( $addr =~ s/(:?^|:)0:0:0:0:0:0(:?:|$)/::/ ) { return $addr; } elsif ( $addr =~ s/(:?^|:)0:0:0:0:0(:?:|$)/::/ ) { return $addr; } elsif ( $addr =~ s/(:?^|:)0:0:0:0(:?:|$)/::/ ) { return $addr; } elsif ( $addr =~ s/(:?^|:)0:0:0(:?:|$)/::/ ) { return $addr; } elsif ( $addr =~ s/(:?^|:)0:0(:?:|$)/::/ ) { return $addr; } elsif ( $addr =~ s/(:?^|:)0(:?:|$)/::/ ) { return $addr; } return $addr; } # Cannonicalize IPv6 addresses in ascii format sub ipv6Cannonical { my $addr = shift; $addr = ipv6NonCompacted($addr); $addr = ipv6AsciiCompact($addr); return $addr; } # IPv6 addresses are stored with a leading zero. sub storeNetblock { my ( $this, $t ) = @_; $t = $remembered unless $t; my $base = $this->{'IBASE'}; if ( $this->{PROTOCOL} eq 'IPv6' ) { $base = "0$base"; } $t->{$base} = [] unless exists $t->{$base}; my $mb = maxblock($this); my $bits = $this->{'BITS'}; my $i = $bits - $mb; return ( $t->{$base}[$i] = $this ); } sub deleteNetblock { my ( $this, $t ) = @_; $t = $remembered unless $t; my $base = $this->{'IBASE'}; if ( $this->{PROTOCOL} eq 'IPv6' ) { $base = "0$base"; } my $mb = maxblock($this); my $bits = $this->{'BITS'}; my $i = $bits - $mb; return unless defined $t->{$base}; undef $t->{$base}->[$i]; for my $x ( @{ $t->{$base} } ) { return if $x; } return delete $t->{$base}; } sub findNetblock { my ( $ascii, $t ) = @_; $t = $remembered unless $t; my $proto = ( $ascii =~ m/:/ ) ? 'IPv6' : 'IPv4'; my $ip = ascii2int( $ascii, $proto ); return unless defined $ip; my %done; my $maxbits = $proto eq 'IPv6' ? 128 : 32; for ( my $bits = $maxbits; $bits >= 0; $bits-- ) { my $nb = i_getnet_addr( $ip, $bits, $proto ); if ( $proto eq 'IPv6' ) { $nb = "0$nb"; } next unless exists $t->{$nb}; my $mb = imaxblock( $nb, $maxbits, $proto ); next if $done{$mb}++; my $i = $bits - $mb; while ( $i >= 0 ) { return $t->{$nb}->[$i] if defined $t->{$nb}->[$i]; $i--; } } return; } sub findOuterNetblock { my ( $ipstr, $t ) = @_; $t = $remembered unless $t; my $proto; my $maxbits; my $ip; my $len; if ( ref($ipstr) ) { $proto = $ipstr->{PROTOCOL}; $maxbits = $proto eq 'IPv4' ? 32 : 128; $ip = $ipstr->{IBASE}; $len = $ipstr->{BITS}; } else { $proto = ( $ipstr =~ m/:/ ) ? 'IPv6' : 'IPv4'; $maxbits = $proto eq 'IPv4' ? 32 : 128; $ip = ascii2int( $ipstr, $proto ); $len = $maxbits; } for ( my $bits = 0; $bits <= $len; $bits++ ) { my $nb = $ip & ( $proto eq 'IPv4' ? $imask[$bits] : $i6mask[$bits] ); if ( $proto eq 'IPv6' ) { $nb = "0$nb"; } next unless exists $t->{$nb}; my $mb = imaxblock( $nb, $len, $proto ); my $i = $bits - $mb; confess "$mb, $bits, $ipstr, $nb" if $i < 0; confess "$mb, $bits, $ipstr, $nb" if $i > $maxbits; while ( $i >= 0 ) { return $t->{$nb}->[$i] if defined $t->{$nb}->[$i]; $i--; } } return; } sub findAllNetblock { my ( $ipstr, $t ) = @_; $t = $remembered unless $t; my $proto = ( $ipstr =~ m/:/ ) ? 'IPv6' : 'IPv4'; my $maxbits = $proto eq 'IPv4' ? 32 : 128; my $ip = ascii2int( $ipstr, $proto ); my %done; my @ary; for ( my $bits = $maxbits; $bits >= 0; $bits-- ) { my $nb = $ip & ( $proto eq 'IPv4' ? $imask[$bits] : $i6mask[$bits] ); if ( $proto eq 'IPv6' ) { $nb = "0$nb"; } next unless exists $t->{$nb}; my $mb = imaxblock( $nb, $maxbits, $proto ); next if $done{$mb}++; my $i = $bits - $mb; confess "$mb, $bits, $ipstr, $nb" if $i < 0; confess "$mb, $bits, $ipstr, $nb" if $i > $maxbits; 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 $bits = $this->{'BITS'}; my $i = $bits - $mb; return defined $t->{$base}->[$i]; } sub match { my ( $this, $ip ) = @_; my $proto = $this->{PROTOCOL}; # Two different protocols: return undef if ( $ip =~ /:/ ) { if ( $proto ne 'IPv6' ) { return } } else { if ( $proto ne 'IPv4' ) { return } } my $i = ascii2int( $ip, $this->{PROTOCOL} ); my $ia = i_getnet_addr( $i, $this->{BITS}, $proto ); if ( $proto eq 'IPv4' ) { if ( $ia == $this->{IBASE} ) { return ( ( $i & ~( $this->{IBASE} ) ) || "0 " ); } else { return 0; } } else { if ( $ia == $this->{IBASE} ) { return ( ( $i - $this->{IBASE} ) || "0 " ); } else { return 0; } } } sub maxblock { my ($this) = @_; return ( !defined $this->{ERROR} ) ? imaxblock( $this->{IBASE}, $this->{BITS}, $this->{PROTOCOL} ) : undef; } sub nextblock { my ( $this, $index ) = @_; $index = 1 unless defined $index; my $ibase = $this->{IBASE}; if ( $this->{PROTOCOL} eq 'IPv4' ) { $ibase += $index * 2**( 32 - $this->{BITS} ); } else { $ibase += $index * Math::BigInt->new(2)->bpow( 128 - $this->{BITS} ); } my $newblock = bless { IBASE => $ibase, BITS => $this->{BITS}, PROTOCOL => $this->{PROTOCOL}, }; if ( $this->{PROTOCOL} eq 'IPv4' ) { return if $newblock->{IBASE} >= 2**32; } else { return if $newblock->{IBASE} >= Math::BigInt->new(2)->bpow(128); } return if $newblock->{IBASE} < 0; return $newblock; } sub imaxblock { my ( $ibase, $tbit, $proto ) = @_; confess unless defined $ibase; if ( !defined($proto) ) { $proto = 'IPv4'; } while ( $tbit > 0 ) { my $ia = i_getnet_addr( $ibase, $tbit - 1, $proto ); last if ( $ia != $ibase ); $tbit--; } return $tbit; } sub range2cidrlist { my ( $startip, $endip ) = @_; my $proto; if ( $startip =~ m/:/ ) { if ( $endip =~ m/:/ ) { $proto = 'IPv6'; } } else { if ( $endip !~ m/:/ ) { $proto = 'IPv4'; } } if ( !defined($proto) ) { confess("Cannot mix IPv4 and IPv6 in range2cidrlist()"); } my $start = ascii2int( $startip, $proto ); my $end = ascii2int( $endip, $proto ); ( $start, $end ) = ( $end, $start ) if $start > $end; return irange2cidrlist( $start, $end, $proto ); } sub irange2cidrlist { my ( $start, $end, $proto ) = @_; if ( !defined($proto) ) { $proto = 'IPv4' } my $bits = $proto eq 'IPv4' ? 32 : 128; my @result; while ( $end >= $start ) { my $maxsize = imaxblock( $start, $bits, $proto ); my $maxdiff; if ( $proto eq 'IPv4' ) { $maxdiff = $bits - _log2( $end - $start + 1 ); } else { $maxdiff = $bits - ( $end - $start + 1 )->blog(2); } $maxsize = $maxdiff if $maxsize < $maxdiff; push( @result, bless { 'IBASE' => $start, 'BITS' => $maxsize, 'PROTOCOL' => $proto, } ); if ( $proto eq 'IPv4' ) { $start += 2**( 32 - $maxsize ); } else { $start += Math::BigInt->new(2)->bpow( $bits - $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; my $proto; if ( scalar(@cidrs) ) { $proto = $cidrs[0]->{PROTOCOL}; if ( grep { $proto ne $_->{PROTOCOL} } @cidrs ) { confess("Cannot call cidrs2cidrs with mixed protocol arguments"); } } 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, $proto ) ); } return @result; } sub cidrs2inverse { my $outer = shift; $outer = __PACKAGE__->new2($outer) || croak($error) unless ref($outer); # cidrs2cidrs validates that everything is in the same address # family my (@cidrs) = cidrs2cidrs(@_); my $proto; if ( scalar(@cidrs) ) { $proto = $cidrs[0]->{PROTOCOL}; } 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, $proto ) ); } push( @r, irange2cidrlist( $first, $cidrs[0]->{IBASE} - 1, $proto ) ); } last if $cidrs[0]->{IBASE} > $last; $first = $cidrs[0]->{IBASE} + $cidrs[0]->size; shift(@cidrs); } if ( $first <= $last ) { push( @r, irange2cidrlist( $first, $last, $proto ) ); } return @r; } sub by_net_netmask_block { return $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 { if ( ( $_[0]->{PROTOCOL} eq 'IPv4' ) && ( $_[1]->{PROTOCOL} eq 'IPv4' ) ) { # IPv4 return ( $_[0]->{IBASE} <=> $_[1]->{IBASE} || $_[0]->{BITS} <=> $_[1]->{BITS} ); } elsif ( ( $_[0]->{PROTOCOL} eq 'IPv6' ) && ( $_[1]->{PROTOCOL} eq 'IPv6' ) ) { # IPv6 return ( $_[0]->{IBASE} <=> $_[1]->{IBASE} || $_[0]->{BITS} <=> $_[1]->{BITS} ); } else { # IPv4 to IPv6, order by protocol return ( $_[0]->{PROTOCOL} cmp $_[1]->{PROTOCOL} ); } } sub sort_network_blocks { return map { $_->[0] } sort { $a->[3] cmp $b->[3] || $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] } map { [ $_, $_->{IBASE}, $_->{BITS}, $_->{PROTOCOL} ] } @_; } sub sort_by_ip_address { return map { $_->[0] } sort { $a->[1] cmp $b->[1] } map { [ $_, pack( "C4", split( /\./, $_ ) ) ] } @_; } sub split ## no critic: (Subroutines::ProhibitBuiltinHomonyms) { my ( $self, $parts ) = @_; my $num_ips = $self->size; confess "Parts must be defined and greater than 0." unless defined($parts) && $parts > 0; confess "Netmask only contains $num_ips IPs. Cannot split into $parts." unless $num_ips >= $parts; my $log2 = _log2($parts); confess "Parts count must be a number of base 2. Got: $parts" unless ( 2**$log2 ) == $parts; my $new_mask = $self->bits + $log2; return map { Net::Netmask->new( $_ . "/" . $new_mask ) } map { $self->nth( ( $num_ips / $parts ) * $_ ) } ( 0 .. ( $parts - 1 ) ); } # Implement log2 sub routine directly, to avoid precision problems with floor() # problems with perls built with uselongdouble defined. # Credit: xenu, on IRC sub _log2 { my $n = shift; my $ret = 0; $ret++ while ( $n >>= 1 ); return $ret; } 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; } for ( my $i = 0; $i <= 128; $i++ ) { $i6mask[$i] = i6mask($i); } } 1; Net-Netmask-1.9104/CODE_OF_CONDUCT.md0000644000175000017500000000623513326722143016374 0ustar jmaslakjmaslak# Contributor Covenant Code of Conduct ## Our Pledge In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, education, socio-economic status, nationality, personal appearance, race, religion, or sexual identity and orientation. ## Our Standards Examples of behavior that contributes to creating a positive environment include: * Using welcoming and inclusive language * Being respectful of differing viewpoints and experiences * Gracefully accepting constructive criticism * Focusing on what is best for the community * Showing empathy towards other community members Examples of unacceptable behavior by participants include: * The use of sexualized language or imagery and unwelcome sexual attention or advances * Trolling, insulting/derogatory comments, and personal or political attacks * Public or private harassment * Publishing others' private information, such as a physical or electronic address, without explicit permission * Other conduct which could reasonably be considered inappropriate in a professional setting ## Our Responsibilities Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. ## Scope This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at jmaslak@antelope.net. All complaints will be reviewed and investigated and will result in a response that is deemed necessary and appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. ## Attribution This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html [homepage]: https://www.contributor-covenant.org Net-Netmask-1.9104/README0000644000175000017500000005133413326722143014455 0ustar jmaslakjmaslakNAME Net::Netmask - parse, manipulate and lookup IP network blocks SYNOPSIS use Net::Netmask; $block = Net::Netmask->new(network block) $block = Net::Netmask->new(network block, netmask) $block = Net::Netmask->new2(network block) $block = Net::Netmask->new2(network block, netmask) print $block; # a.b.c.d/bits or 1:2:3::4/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]); print $block->protocol(); 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 and IPv6 CIDR blocks (see for more information on CIDR blocks). It's built with an object-oriented interface, with functions being methods that operate on a Net::Netmask object. These methods provide nearly all types of information about a network block that you might want. There are also functions to insert a network block into a table and then later lookup network blocks by IP address using 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. All functions understand both IPv4 and IPv6. Matches, finds, etc, will always return false when an IPv4 address is matched against an IPv6 address. IPv6 support was added in 1.9104. 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 IPv6 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 - that is, the hostmask is the bitwise inverse of a netmask). '2001:db8:1234:5678::/64' The preferred IPv6 form. '2001:db8:1234:5678::9876' A /128 block. 'default6' or 'any6' ::/0 (the default route) There are two constructor methods: "new" and "new2". "new2" differs from "new" in that it will return undef for invalid netmasks, while "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" or "2001:db8:1234::/48". This is also available as overloaded stringification. ->base() Returns base address of the network block as a string. Eg: "216.240.32.0". or "2001:db8:1234::/48". 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" or "ffff:ffff:ffff:ffff::" ->hostmask() Returns the host mask which is the opposite of the netmask. Eg: "0.0.0.255" or "::ffff:ffff:ffff:ffff". ->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. For IPv6 addresses, this will be a Math::BigInt object. ->broadcast() The blocks broadcast address. (The last IP address inside the block.) Eg: 192.168.1.0/24 => 192.168.1.255 or 2001:db8::/64 => 2001:db8::ffff:ffff:ffff:ffff ->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 or 2001:db8:0:1::/64 => 2001:db8:0:2::/64 ->first() & ->last() Synonyms for ->base() and ->broadcast() ->protocol() Added in version 1.9102. Returns the address family/protocol represented by the block. Either 'IPv4' or 'IPv6'. ->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() and 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") or an IPv6 address in standard notation (eg: "2001:db8::1"). 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). Note that for IPv6, this will return failure if more than 1,000,000,000 addresses would be returned. ->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 address, use nth(-2). ->inaddr() Returns an inline list of tuples. For IPv4: There is a tuple for each DNS zone name (at the /24 level) 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. For IPv6: A list is returned with each DNS zone name at the shortest-prefix length possible. This is not returned as a tuple, but just a list of strings. Examples: the list returned for the block '2002::/16' would be a one element list, containing just 2.0.0.2.ip6.arpa'. The list for '2002::/17' would return a two element list containing '0.2.0.0.2.ip6.arpa' and '1.2.0.0.2.ip6.arpa'. ->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. ->split($parts) Splits a netmask into a number of sub netblocks. This number must be a base 2 number (2,4,8,16,etc.) and the number must not exceed the number of IPs within this netmask. For instance, Net::Netmask->new( '10.0.0.0/24' )->split(2) is equivilent to ( Net::Netmask( '10.0.0.0/25'), Net::Netmask( '10.0.0.128/25' ) ) 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 "" Strinification is overloaded to be the ->desc() method. cmp Numerical and string comparisons 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 ... This method also will sort IPv6 addresses, but is not performance optimized. It is correct, however. 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 correspond 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 discontiguous 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. AUTHORS Joelle Maslak (current maintainer) David Muir Sharnoff (original creator/author) LICENSE Copyright (C) 1998-2006 David Muir Sharnoff. Copyright (C) 2011-2013 Google, Inc. Copyright (C) 2018 Joelle Maslak This module may be used, modified and redistributed under the same terms as Perl itself. Net-Netmask-1.9104/TODO0000644000175000017500000000050413326722143014256 0ustar jmaslakjmaslakTODO Items Good beginner tasks: * Use test2 native exception testing where we're using $sig{__WARN__} to catch exceptions * Refactor tests in netmask.t to not use dlist() helper (just use "is") * Refactor tests in netmask.t to always have descriptions Advanced tests: * IPv6 Support * Speed improvements for IPv6 Net-Netmask-1.9104/dist.ini0000644000175000017500000000205313326722143015233 0ustar jmaslakjmaslakname = Net-Netmask author = Joelle Maslak license = Perl_5 copyright_holder = Various -- See Documentation copyright_year = Various -- See Documentation version = 1.9104 [@Filter] -bundle = @Basic -remove = Readme [AutoPrereqs] ; [CustomLicense] ; [ExtraTests] [MetaJSON] [MetaProvides::Package] [PkgVersion] [PodSyntaxTests] [Test::Kwalitee::Extra] [Test::UnusedVars] [Test::UseAllModules] [Test::Version] [Git::Contributors] include_authors=1 order_by=commits [GitHub::Meta] fork=0 [OSPrereqs / MSWin32] threads=0 Thread::Queue=3.12 ; Need predictible thread behavior [Pod2Readme] source_filename = lib/Net/Netmask.pod [Prereqs / RuntimeRecommends] AnyEvent=7.14 ; Need predictable AnyEvent behavior [Prereqs / RuntimeRequires] Math::BigInt=1.999811 ; Need to_hex [Prereqs / BuildRequires] Test::UseAllModules=0.17 ; [Test::UseAllModules] fails with earlier versions [Test::Perl::Critic] critic_config = t/data/perlcriticrc [Test::TrailingSpace] filename_regex = \.(?:ini|pl|pm|pod|t|txt)\z Net-Netmask-1.9104/META.json0000644000175000017500000000462213326722143015214 0ustar jmaslakjmaslak{ "abstract" : "Understand and manipulate IP netmasks", "author" : [ "Joelle Maslak " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Net-Netmask", "prereqs" : { "build" : { "requires" : { "Test::UseAllModules" : "0.17" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::More" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41", "Test::TrailingSpace" : "0.0203", "Test::Version" : "1" } }, "runtime" : { "recommends" : { "AnyEvent" : "7.14" }, "requires" : { "Carp" : "0", "Exporter" : "0", "Math::BigInt" : "1.999811", "POSIX" : "0", "overload" : "0", "perl" : "5.006_001", "strict" : "0", "vars" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Benchmark" : "0", "Test2::V0" : "0.000111", "Test::UseAllModules" : "0.17", "utf8" : "0" } } }, "provides" : { "Net::Netmask" : { "file" : "lib/Net/Netmask.pm", "version" : "1.9104" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/jmaslak/Net-Netmask/issues" }, "homepage" : "http://search.cpan.org/~jmaslak/Net-Netmask/", "repository" : { "type" : "git", "url" : "git://github.com/jmaslak/Net-Netmask.git", "web" : "https://github.com/jmaslak/Net-Netmask" } }, "version" : "1.9104", "x_contributors" : [ "Joelle Maslak ", "David Muir Sharnoff ", "Adam Herzog ", "Ben Kolera ", "David Steinbrunner ", "bay-max1 <34803732+bay-max1@users.noreply.github.com>" ], "x_serialization_backend" : "Cpanel::JSON::XS version 3.0239" } Net-Netmask-1.9104/MANIFEST0000644000175000017500000000104713326722143014722 0ustar jmaslakjmaslak# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.010. CODE_OF_CONDUCT.md CONTRIBUTING Changes LICENSE MANIFEST META.json META.yml Makefile.PL README TODO dist.ini errors.err lib/Net/Netmask.pm lib/Net/Netmask.pod t/00-load.t t/author-critic.t t/author-pod-syntax.t t/author-test-version.t t/badnets.t t/data/perlcriticrc t/github-0004.t t/ipv6_cannonical.t t/ipv6_raw2ascii.t t/netmasks.t t/release-kwalitee.t t/release-trailing-space.t t/release-unused-vars.t t/sortspeed-blocks.t t/sortspeed-ip.t t/split-ipv6.t t/split.t Net-Netmask-1.9104/errors.err0000644000175000017500000000000013326722143015603 0ustar jmaslakjmaslakNet-Netmask-1.9104/t/0000775000175000017500000000000013326722143014034 5ustar jmaslakjmaslakNet-Netmask-1.9104/t/release-kwalitee.t0000644000175000017500000000067213326722143017447 0ustar jmaslakjmaslak#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } # This test is generated by Dist::Zilla::Plugin::Test::Kwalitee::Extra use strict; use warnings; use Test::More; # needed to provide plan. eval { require Test::Kwalitee::Extra }; plan skip_all => "Test::Kwalitee::Extra required for testing kwalitee: $@" if $@; eval "use Test::Kwalitee::Extra"; Net-Netmask-1.9104/t/github-0004.t0000755000175000017500000000137013326722143016066 0ustar jmaslakjmaslak#!/usr/bin/perl -w use strict; use utf8; use Test2::V0; use Net::Netmask; my $debug = 0; ok( 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 my @tests = ( { input => ['١٠٠.١٠٠.١٠٠.١٠٠/32'], error => qr/^could not parse /, type => 'bad net byte', }, ); foreach my $test (@tests) { my $input = $test->{input}; my $err = $test->{error}; my $name = ( join ', ', @{ $test->{input} } ); my $type = $test->{type}; my $result = Net::Netmask->new2(@$input); is( $result, undef, "$name $type" ); like( Net::Netmask->errstr, $err, "$name errstr mismatch" ); } done_testing; Net-Netmask-1.9104/t/netmasks.t0000755000175000017500000010165013326722143016052 0ustar jmaslakjmaslak#!/usr/bin/perl -w use strict; use Test2::V0; use Net::Netmask qw( cidrs2cidrs cidrs2contiglists cidrs2inverse cmpblocks dumpNetworkTable findAllNetblock findNetblock findOuterNetblock range2cidrlist sameblock sort_by_ip_address ); use Carp qw(verbose); MAIN: { # Note that _ in the addr gets replaced with a '#' # addr mask base newmask bits mb proto todo my @rtests = qw( 209.157.68.22:255.255.224.0 u 209.157.64.0 255.255.224.0 19 18 IPv4 0 209.157.68.22 255.255.224.0 209.157.64.0 255.255.224.0 19 18 IPv4 0 209.157.70.33 0xffffe000 209.157.64.0 255.255.224.0 19 18 IPv4 0 209.157.70.33/19 u 209.157.64.0 255.255.224.0 19 18 IPv4 0 209.157.70.33 u 209.157.70.33 255.255.255.255 32 32 IPv4 0 140.174.82 u 140.174.82.0 255.255.255.0 24 23 IPv4 0 140.174 u 140.174.0.0 255.255.0.0 16 15 IPv4 0 10 u 10.0.0.0 255.0.0.0 8 7 IPv4 0 10/8 u 10.0.0.0 255.0.0.0 8 7 IPv4 0 209.157.64/19 u 209.157.64.0 255.255.224.0 19 18 IPv4 0 209.157.64.0-209.157.95.255 u 209.157.64.0 255.255.224.0 19 18 IPv4 0 216.140.48.16/32 u 216.140.48.16 255.255.255.255 32 28 IPv4 0 209.157/17 u 209.157.0.0 255.255.128.0 17 16 IPv4 0 default u 0.0.0.0 0.0.0.0 0 0 IPv4 0 209.157.68.22_0.0.31.255 u 209.157.64.0 255.255.224.0 19 18 IPv4 0 2001:db8::/32 u 2001:db8:: ffff:ffff:: 32 29 IPv6 0 2001:db8:100::/48 u 2001:db8:100:: ffff:ffff:ffff:: 48 40 IPv6 0 2001:db8:100:: u 2001:db8:100:: ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff 128 40 IPv6 0 2001:db8:100::1 u 2001:db8:100::1 ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff 128 128 IPv6 0 1:2:3:4:5:6:7:4/64 u 1:2:3:4:: ffff:ffff:ffff:ffff:: 64 62 IPv6 0 default6 u :: :: 0 0 IPv6 0 ); my @store = qw( 209.157.64.0/19 default default6 209.157.81.16/28 209.157.80.0/20 2001:db8:100::/48 ); 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 2001:db8:100::3 2001:db8:100::/48 2001:db8:200::3 ::/0 ); my @store2 = qw( 209.157.64.0/19 default default6 209.157.81.16/28 209.157.80.0/24 2001:db8:100::/48 ); 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 2001:db8:100::3 2001:db8:100::/48 2001:db8:200::3 ::/0 ); my $debug = 0; my $x; my ( $addr, $mask, $base, $newmask, $bits, $max, $proto, $todo ); while ( ( $addr, $mask, $base, $newmask, $bits, $max, $proto, $todo ) = splice( @rtests, 0, 8 ) ) { $addr =~ s/_/#/g; diag "$addr $mask $base $newmask $bits $max $proto $todo"; $mask = undef if $mask eq 'u'; $newmask = undef if $newmask eq 'u'; my $test = sub { $x = Net::Netmask->new( $addr, $mask ); ok( $x, "parsed $addr " ); if ( defined($x) ) { 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" ); is( $x->protocol(), $proto, "protocol of $addr" ); } }; if ($todo) { todo 'marked as todo' => $test; } else { $test->(); } } my @y; $x = Net::Netmask->new('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 ] ), '!defined $y[32*3]' ); $x = Net::Netmask->new('140.174.82.4/32'); is( $x->size(), 1, "size of 140.174.82.4/32" ); is( ( $x->inaddr() )[0], '82.174.140.in-addr.arpa' ); $x = Net::Netmask->new('140.174.82.64/27'); is( ( $x->inaddr() )[1], 64 ); is( ( $x->inaddr() )[2], 95 ); $x = Net::Netmask->new('any'); ok( $x->size() == 4294967296, 'size of any netblock' ); $x = Net::Netmask->new('::/0'); is( $x->size(), '340282366920938463463374607431768211456', "size of ::/0" ); is( $x->hostmask(), 'ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff', "hostmask of ::/0" ); @y = $x->inaddr(); print "# REVERSE: @y\n"; is( $y[0], 'ip6.arpa' ); ok( !defined( $y[1] ), '!defined $y[1]' ); $x = Net::Netmask->new('2001:db8:100::3'); is( $x->size(), '1', "size of 2001:db8:100::3" ); is( $x->hostmask(), '::', "hostmask of 2001:db8:100::3" ); @y = $x->inaddr(); print "# REVERSE: @y\n"; is( $y[0], '3.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1.0.8.b.d.0.1.0.0.2.ip6.arpa' ); ok( !defined( $y[1] ), '!defined $y[1]' ); $x = Net::Netmask->new('2001:db8:100::/48'); is( $x->size(), '1208925819614629174706176', "size of 2001:db8:100::/48" ); is( $x->hostmask(), '::ffff:ffff:ffff:ffff:ffff', "hostmask of 2001:db8:100::/48" ); @y = $x->inaddr(); print "# REVERSE: @y\n"; is( $y[0], '0.0.1.0.8.b.d.0.1.0.0.2.ip6.arpa' ); ok( !defined( $y[1] ), '!defined $y[1]' ); $x = Net::Netmask->new('2001:db8:100::/49'); is( $x->size(), '604462909807314587353088', "size of 2001:db8:100::/48" ); @y = $x->inaddr(); print "# REVERSE: @y\n"; is( $y[0], '0.0.0.1.0.8.b.d.0.1.0.0.2.ip6.arpa' ); is( $y[1], '1.0.0.1.0.8.b.d.0.1.0.0.2.ip6.arpa' ); is( $y[7], '7.0.0.1.0.8.b.d.0.1.0.0.2.ip6.arpa' ); ok( !defined( $y[8] ), '!defined $y[8]' ); $x = Net::Netmask->new('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] ), '!defiend($y[32])' ); @y = $x->enumerate(31); is( $y[0], '209.157.64.0' ); is( $y[15], '209.157.64.30' ); ok( !defined( $y[16] ), '!defined($y[16]' ); $x = Net::Netmask->new('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] ), '!defined($y[8192])' ); $x = Net::Netmask->new('2001:db8:100::/56'); @y = $x->enumerate(64); is( $y[0], '2001:db8:100::' ); is( $y[1], '2001:db8:100:1::' ); is( $y[255], '2001:db8:100:ff::' ); ok( !defined( $y[256] ), '!defined($y[256])' ); $x = Net::Netmask->new('::/0'); ok( dies( sub { @y = $x->enumerate() } ), "Dies on large enumeration" ); my $table = {}; my $table9 = {}; { for my $b (@store) { $x = Net::Netmask->new($b); $x->storeNetblock(); } } { for my $b (@store2) { $x = Net::Netmask->new($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"), 'match 192.168.1.0' ); ok( $newmask->match("192.168.1.255"), 'match 192.168.1.255' ); ok( $newmask->match("192.168.1.63"), 'match 192.168.1.63' ); ok( !$newmask->match("192.168.0.255"), 'match 192.168.0.255' ); ok( !$newmask->match("192.168.2.0"), 'match 192.168.2.0' ); ok( !$newmask->match("10.168.2.0"), 'match 10.168.2.0' ); ok( !$newmask->match("209.168.2.0"), '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' ); is( $newmask->nth( 1, 31 ), '192.168.1.2' ); is( $newmask->nth(256), undef ); is( $newmask->nth(-257), undef ); is( $newmask->match('192.168.1.1'), 1, 'match 192.168.1.1' ); is( $newmask->match('192.168.1.100'), 100, 'match 192.168.1.100' ); is( $newmask->match('192.168.1.255'), 255, 'match 192.168.1.255' ); ok( ( $newmask->match('192.168.2.1') == 0 ), 'match 192.168.2.1' ); ok( !( $newmask->match('192.168.2.1') ), 'match 192.168.2.1' ); ok( ( ( 0 + $newmask->match('192.168.1.0') ) == 0 ), '0 + match 192.168.1.0' ); ok( ( $newmask->match('192.168.1.0') ), 'match 192.168.1.0' ); $newmask = Net::Netmask->new("1:2:3:4::/64"); is( $newmask->next(), "1:2:3:5::", "next of 1:2:3:4::/64" ); $newmask = Net::Netmask->new("2001:db8:100::/48"); is( $newmask->broadcast(), "2001:db8:100:ffff:ffff:ffff:ffff:ffff", "Broadcast for IPv6" ); is( $newmask->next(), "2001:db8:101::", "next of 2001:db8:100::/48" ); ok( $newmask->match('2001:db8:100::'), 'match 2001:db8:100::' ); ok( $newmask->match('2001:db8:100:ffff:ffff:ffff:ffff:ffff'), 'match 2001:db8:100:ffff:ffff:ffff:ffff:ffff' ); ok( $newmask->match('2001:db8:100::2'), 'match 2001:db8:100::2' ); is( int( $newmask->match('2001:db8:100::') ), 0, 'match 2001:db8:100:: 2' ); is( $newmask->match('2001:db8:100::2'), 2, 'match 2001:db8:100::2 2' ); ok( !$newmask->match('2001:db8:99:ffff:ffff:ffff:ffff:ffff'), 'match 2001:db8:99:ffff:ffff:ffff:ffff:ffff' ); ok( !$newmask->match('2001:db8:101::'), 'match 2001:db8:101::' ); ok( !$newmask->match('1:db8:100:ffff:ffff:ffff:ffff:ffff'), 'match 1:db8:100:ffff:ffff:ffff:ffff:ffff' ); ok( !$newmask->match('4000:db8:100:ffff:ffff:ffff:ffff:ffff'), 'match 4000:db8:100:ffff:ffff:ffff:ffff:ffff' ); ok( 0 + $newmask->match('2001:db8:100::') == 0, '0 + match 2001:db8:100::' ); is( $newmask->nth(1), '2001:db8:100::1', 'IPv6 nth 1' ); is( $newmask->nth(-1), '2001:db8:100:ffff:ffff:ffff:ffff:ffff', 'IPv6 nth -1' ); $newmask = Net::Netmask->new('::/128'); is( $newmask->nth(1), undef, 'IPv6 nth 1 (2)' ); is( $newmask->nth(-1), '::', 'IPv6 nth -1 (2)' ); is( $newmask->nth(-2), undef, 'IPv6 nth -2 (2)' ); my $bks; my $block = Net::Netmask->new('209.157.64.1/32'); $block->storeNetblock($bks); ok( findNetblock( '209.157.64.1', $bks ), 'findNetBlock 209.157.64.1 / 209.157.64.1/32' ); my @store3 = qw( 216.240.32.0/19 216.240.40.0/24 216.240.40.0/27 216.240.40.4/30 2001:db8:ffcc:abcd::/64 ); my $table3 = {}; my $table8 = {}; my $table7 = {}; my $table6 = {}; for my $b (@store3) { $x = Net::Netmask->new($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 ); my (@c) = range2cidrlist( "66.33.85.239", "66.33.85.240" ); my $dl = dlist(@c); is( $dl, '66.33.85.239/32 66.33.85.240/32', 'match cidrlist 1' ); (@c) = range2cidrlist( "66.33.85.240", "66.33.85.239" ); $dl = dlist(@c); is( $dl, '66.33.85.239/32 66.33.85.240/32', 'match cidrlist 2' ); (@c) = range2cidrlist( '216.240.32.128', '216.240.36.127' ); $dl = dlist(@c); is( $dl, '216.240.32.128/25 216.240.33.0/24 216.240.34.0/23 216.240.36.0/25', 'match cidrlist 3' ); my @d; @d = ( @c[ 0, 1, 3 ] ); my (@e) = cidrs2contiglists(@d); is( @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' ); my (@iplist) = generate(500); my (@sorted1) = sort_by_ip_address(@iplist); my (@blist) = map { Net::Netmask->new($_) } @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" ); } (@c) = range2cidrlist( "2001:db8::", "2001:db8:0:0:ffff:ffff:ffff:ffff" ); my (@got) = map { $_->desc } @c; is( \@got, ['2001:db8::/64'], 'match ipv6 cidrlist 1' ); (@c) = range2cidrlist( "2001:db8:1:1:1::ffff", "2001:db8:5::" ); (@got) = map { $_->desc } @c; $result = [ qw ( 2001:db8:1:1:1::ffff/128 2001:db8:1:1:1::1:0/112 2001:db8:1:1:1::2:0/111 2001:db8:1:1:1::4:0/110 2001:db8:1:1:1::8:0/109 2001:db8:1:1:1::10:0/108 2001:db8:1:1:1::20:0/107 2001:db8:1:1:1::40:0/106 2001:db8:1:1:1::80:0/105 2001:db8:1:1:1::100:0/104 2001:db8:1:1:1::200:0/103 2001:db8:1:1:1::400:0/102 2001:db8:1:1:1::800:0/101 2001:db8:1:1:1::1000:0/100 2001:db8:1:1:1::2000:0/99 2001:db8:1:1:1::4000:0/98 2001:db8:1:1:1::8000:0/97 2001:db8:1:1:1:1::/96 2001:db8:1:1:1:2::/95 2001:db8:1:1:1:4::/94 2001:db8:1:1:1:8::/93 2001:db8:1:1:1:10::/92 2001:db8:1:1:1:20::/91 2001:db8:1:1:1:40::/90 2001:db8:1:1:1:80::/89 2001:db8:1:1:1:100::/88 2001:db8:1:1:1:200::/87 2001:db8:1:1:1:400::/86 2001:db8:1:1:1:800::/85 2001:db8:1:1:1:1000::/84 2001:db8:1:1:1:2000::/83 2001:db8:1:1:1:4000::/82 2001:db8:1:1:1:8000::/81 2001:db8:1:1:2::/79 2001:db8:1:1:4::/78 2001:db8:1:1:8::/77 2001:db8:1:1:10::/76 2001:db8:1:1:20::/75 2001:db8:1:1:40::/74 2001:db8:1:1:80::/73 2001:db8:1:1:100::/72 2001:db8:1:1:200::/71 2001:db8:1:1:400::/70 2001:db8:1:1:800::/69 2001:db8:1:1:1000::/68 2001:db8:1:1:2000::/67 2001:db8:1:1:4000::/66 2001:db8:1:1:8000::/65 2001:db8:1:2::/63 2001:db8:1:4::/62 2001:db8:1:8::/61 2001:db8:1:10::/60 2001:db8:1:20::/59 2001:db8:1:40::/58 2001:db8:1:80::/57 2001:db8:1:100::/56 2001:db8:1:200::/55 2001:db8:1:400::/54 2001:db8:1:800::/53 2001:db8:1:1000::/52 2001:db8:1:2000::/51 2001:db8:1:4000::/50 2001:db8:1:8000::/49 2001:db8:2::/47 2001:db8:4::/48 2001:db8:5::/128 ) ]; is( \@got, $result, 'match ipv6 cidrlist 2' ); my $q144 = Net::Netmask->new('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 = Net::Netmask->new($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 = Net::Netmask->new('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') ) ); $q144 = Net::Netmask->new('2001:db8::/46'); for my $i (qw(2001:db8::/44 2001:db8::/48 2001:db8:1000::/46)) { my $q144p = Net::Netmask->new($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) ); } $q144pp = Net::Netmask->new('2001:db8::/46'); ok( ( $q144 == $q144pp ) ); ok( ( $q144 eq $q144pp ) ); ok( ( $q144->desc eq "$q144" ) ); ok( $q144->sameblock('2001:db8::/46'), 'Sameblock 2001:db8::/46' ); ok( sameblock( $q144, '2001:db8::/46' ), 'Sameblock 2001:db8::/46 2' ); ok( !( cmpblocks( $q144, '2001:db8::/46' ) ), 'cmpblocks 2001:db8::/46' ); ok( !( $q144->cmpblocks('2001:db8::/46') ), 'cmpblocks 2001:db8::/46' ); 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 ::/0 2001:db8:100::/48' ); # 216.240.32.0/19 # 216.240.40.0/24 # 216.240.40.0/27 # 216.240.40.4/30 # 2001:db8:ffcc:abcd::/64 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 ); lookouter( $table8, '2001:db8:ffcc:abce::', undef ); lookouterO( $table8, '2001:db8:ffcc:abce::', undef ); lookouter( $table8, '2001:db8:ffcc:abcd::', '2001:db8:ffcc:abcd::/64' ); lookouterO( $table8, '2001:db8:ffcc:abcd::', '2001:db8:ffcc:abcd::/64' ); fdel( "2001:db8:ffcc:abcd:1:2::3", "2001:db8:ffcc:abcd::/64", $table8 ); lookouter( $table8, '2001:db8:ffcc:abcd::', undef ); lookouterO( $table8, '2001:db8:ffcc:abcd::', undef ); 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 ); 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" ); ctest( "::/0", "2001:db8:ffcc:42::1" ); ctest( "2000::/3", "2001:db8:ffcc:42::1" ); ctest( "2001:db8:ffcc:42::/64", "2001:db8:ffcc:42::1" ); ctest( "2001:db8:ffcc:42::/120", "2001:db8:ffcc:42::1" ); ctest( "2001:db8:ffcc:42::1/128", "2001:db8:ffcc:42::1" ); ctestno( "2001:db8:ffcc:42::/128", "2001:db8:ffcc:42::1" ); ctestno( "2001:db8:ffcd::/48", "2001:db8:ffcc:42::1" ); ctestno( "2001:db8:ffcc:42::ff00/124", "2001:db8:ffcc:42::1" ); (@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); is( $dl, '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); is( $dl, '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); is( $dl, '216.240.32.0/24 216.240.33.0/25 216.240.34.0/24' ); (@c) = cidrs2cidrs( multinew(qw(2001:db8:ffcc::/128 2001:db8:ffcc::1/128 2001:db8:ffcc::5/128)) ); is( \@c, [qw(2001:db8:ffcc::/127 2001:db8:ffcc::5/128)], "IPv6 cidrs2cidrs 1" ); (@c) = cidrs2cidrs( multinew(qw(2001:db8:ffcc::/128 2001:db8:ffcc::/48 2001:db8:ffcc::5/128)) ); is( \@c, [qw(2001:db8:ffcc::/48)], "IPv6 cidrs2cidrs 2" ); $block = Net::Netmask->new( '172.2.4.0', '255.255.255.0' ); $table = {}; $block->storeNetblock($table); my (@b1) = findAllNetblock( '172.2.4.1', $table ); is( \@b1, [qw(172.2.4.0/24)], 'IPv4 findAllNetblock' ); $block->tag( 'a', 'b' ); $block->tag( 'b', 'c' ); $block->tag( 'c', 'x' ); $block->tag( 'c', undef ); $block->tag( 'd', 'x' ); $block->tag('d'); is( $block->tag('a'), 'b' ); is( $block->tag('b'), 'c' ); is( $block->tag('c'), undef ); is( $block->tag('d'), 'x' ); is( $block->tag('a'), 'b' ); $table = {}; $block = Net::Netmask->new('2001:db8::/32'); $block->storeNetblock($table); $block = Net::Netmask->new('2001:db8:1:/48'); $block->storeNetblock($table); @b1 = findAllNetblock( '2001:db8:1::1', $table ); is( \@b1, [qw(2001:db8:1::/48 2001:db8::/32)], 'IPv6 findAllNetblock' ); (@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); is( $dl, '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); is( $dl, '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); is( $dl, '' ); (@c) = cidrs2inverse( '2001:db8:ffcc::/120', multinew(qw(2001:db8:ffcc::/128 2001:db8:ffcc::1/128 2001:db8:ffcc::5/128)) ); is( \@c, [ qw( 2001:db8:ffcc::2/127 2001:db8:ffcc::4/128 2001:db8:ffcc::6/127 2001:db8:ffcc::8/125 2001:db8:ffcc::10/124 2001:db8:ffcc::20/123 2001:db8:ffcc::40/122 2001:db8:ffcc::80/121 ) ], "IPv6 cidrs2inverse 1" ); my $table77 = {}; my $block77 = Net::Netmask->new2("10.1.2.0/24"); $block77->storeNetblock(); is( findNetblock( "10.2.1.0", $table77 ), undef ); $table77 = {}; $block77 = Net::Netmask->new2("2001:db8:cccc:1111::/64"); is( $Net::Netmask::error, undef, 'No error' ); $block77->storeNetblock(); is( findNetblock( "2001:db8:cccc:2222::", $table77 ), undef ); { my $bl = Net::Netmask->new("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); $result = shift(@t); is( $bl->nextblock($arg) . "", $result, "IPv4 nextblock $result" ); } } { my $bl = Net::Netmask->new("2001:db8:cccc:1111::/64"); my @t = ( undef, '2001:db8:cccc:1112::/64', # => would turn undef into "undef" 10 => '2001:db8:cccc:111b::/64', 7 => '2001:db8:cccc:1118::/64', -1 => '2001:db8:cccc:1110::/64', ); while (@t) { my $arg = shift(@t); $result = shift(@t); is( $bl->nextblock($arg) . "", $result, "IPv6 nextblock $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"; is( @leftover, 1 ); is( "$leftover[0]", "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 ); is( @leftover, 0, "@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 ); is( @leftover, 0, "@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 ); is( @leftover, 1 ); is( "$leftover[0]", '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 ); is( @leftover, 1 ); is( "$leftover[0]", '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 ); is( @leftover, 1 ); is( "$leftover[0]", '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' ); is( $obj1->contains($obj2), 0 ); is( $obj2->contains($obj1), 0 ); } { my $obj1 = new2 Net::Netmask('217.173.192.0/21'); ok( $obj1->contains("217.173.192.0/24") ); ok( !$obj1->contains("217.173.200.0/21") ); } { my $warnings = ''; local ( $SIG{__WARN__} ) = sub { $warnings = $_[0] }; my $blk = findNetblock( "127.0.0.", { 1 => [] } ); is( $warnings, '' ); } done_testing(); } 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 ); } return; } 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); return; } sub dlist { my (@bl) = @_; return join( ' ', map { $_->desc() } @bl ); } 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 { return $a->{'IBASE'} <=> $b->{'IBASE'} || $a->{'BITS'} <=> $b->{'BITS'}; } 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" ); } return; } sub lookouterO { my ( $table, $value, $result ) = @_; my $block = Net::Netmask->new2($value); my $found = findOuterNetblock( $block, $table ); if ($result) { is( $found->desc, $result, "value = $value" ); } else { ok( !$found ); } return; } sub ctest { my $a = Net::Netmask->new(shift); my $b = Net::Netmask->new(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) ) ); return; } sub ctestno { my $a = Net::Netmask->new(shift); my $b = Net::Netmask->new(shift); print "# ctestno($a, $b)\n"; ok( !$a->contains($b) ); ok( !$b->contains($a) ); return; } sub multinew { return map { Net::Netmask->new($_) } @_; } Net-Netmask-1.9104/t/split.t0000644000175000017500000000242413326722143015354 0ustar jmaslakjmaslak#!/usr/bin/perl -I. -w use strict; use Test2::V0; use Net::Netmask; #feel free to add a build requires of Test::Exception if that is okay with you. sub throws_ok(&$$) { my ( $code, $regex, $desc ) = @_; eval { $code->(); }; my $err = $@; like( $err, $regex ); return; } sub make_nm { my ($cidr_str) = @_; return Net::Netmask->new($cidr_str); } my $cidr32 = make_nm('10.0.0.0/32'); my $cidr30 = make_nm('10.0.0.0/30'); my $cidr24 = make_nm('10.0.0.0/24'); throws_ok { $cidr30->split(3) } qr/^Parts count must be a number of base 2. Got: 3/, "Non base 2 split count errors."; throws_ok { $cidr30->split() } qr/^Parts must be defined and greater than 0./, "undef split throws error"; throws_ok { $cidr30->split(0) } qr/^Parts must be defined and greater than 0./, "Zero split throws error"; throws_ok { $cidr30->split(-1) } qr/^Parts must be defined and greater than 0./, "Negative split count errors"; throws_ok { $cidr32->split(2) } qr/^Netmask only contains 1 IPs. Cannot split into 2./, "32 cannot be split"; is $cidr24->split(2), map( { make_nm( "10.0.0.$_" . "/25" ) } ( 0, 128 ) ), 'Can split /24 into 2 25s'; is $cidr24->split(256), map( { make_nm "10.0.0.$_" } ( 0 .. 255 ) ), 'Can split into 32s (i.e $parts = $self->size)'; done_testing(); Net-Netmask-1.9104/t/ipv6_raw2ascii.t0000644000175000017500000000277513326722143017062 0ustar jmaslakjmaslak#!/usr/bin/perl # # Copyright (C) 2018 Joelle Maslak # All Rights Reserved - See License # use strict; use warnings; use Test2::V0 0.000111; use Math::BigInt; use Net::Netmask; my (@tests) = ( { input => '0', output => '::', }, { input => '00010002000300040005000600070008', output => '1:2:3:4:5:6:7:8', }, { input => '00010002000300000000000600070008', output => '1:2:3::6:7:8', }, { input => '00000000000300040005000600070008', output => '::3:4:5:6:7:8', }, { input => '00010002000300040005000600000000', output => '1:2:3:4:5:6::', }, { input => '00000000000300040005000600000000', output => '::3:4:5:6:0:0', }, { input => '00000000000300040005000000000000', output => '0:0:3:4:5::', }, { input => '00010000000000000005000000000000', output => '1::5:0:0:0', }, { output => '1::5f:0:0:0', input => '0001000000000000005f000000000000', }, ); foreach my $test (@tests) { my $in = Math::BigInt->from_hex($test->{input}); my $got = Net::Netmask::int2ascii( "$in", 'IPv6' ); is( $got, $test->{output}, $test->{output} ); $got = Net::Netmask::int2ascii( $in, 'IPv6' ); is( $got, $test->{output}, "MBI Input " . $test->{output} ); my $reverse = Net::Netmask::ascii2int( $test->{output}, 'IPv6' ); is( $reverse, "$in", 'ascii2int for ' . $test->{output} ); } done_testing; 1; Net-Netmask-1.9104/t/badnets.t0000755000175000017500000000757313326722143015656 0ustar jmaslakjmaslak#!/usr/bin/perl -w use strict; use Test2::V0; use Net::Netmask; my $debug = 0; ok( 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 my @tests = ( { input => ['209.256.68.22:255.255.224.0'], error => qr/^could not parse /, type => 'bad net byte', }, { input => ['209.180.68.22:256.255.224.0'], error => qr/^illegal netmask: /, type => 'bad mask byte', }, { input => [ '209.157.300.22', '255.255.224.0' ], error => qr/^could not parse /, type => 'bad net byte', }, { input => [ '300.157.70.33', '0xffffe000' ], error => qr/^could not parse /, type => 'bad net byte', }, { input => ['209.500.70.33/19'], error => qr/^could not parse /, type => 'bad net byte', }, { input => ['140.999.82'], error => qr/^could not parse /, type => 'bad net byte', }, { input => ['899.174'], error => qr/^could not parse /, type => 'bad net byte', }, { input => ['900'], error => qr/^could not parse /, type => 'bad net byte', }, { input => ['209.157.300/19'], error => qr/^could not parse /, type => 'bad net byte', }, { input => ['209.300.64.0-209.157.95.255'], error => qr/^illegal dotted quad/, type => 'bad net byte', }, # test ranges that are a power-of-two big, but are not legal blocks { input => ['218.0.0.0 - 211.255.255.255'], error => qr/^could not find exact fit/, type => 'inexact fit', }, # test some more bad nets/masks { input => ['218.0.0.4 - 218.0.0.11'], error => qr/^could not find exact fit/, type => 'inexact fit', }, { input => ['10.10.10.10#256.0.0.0'], error => qr/^illegal hostmask:/, type => 'bad mask byte', }, { input => [ '209.157.200.22', '256.255.224.0' ], error => qr/^illegal netmask:/, type => 'bad mask byte', }, { input => [ '10.10.10.10', '0xF' ], error => qr/^illegal netmask:/, type => 'bad mask', }, { input => ['209.200.70.33/33'], error => qr/^illegal number of bits/, type => 'bad mask', }, { input => ['209.200.64.0-309.157.95.255'], error => qr/^illegal dotted quad/, type => 'bad mask byte', }, # completely invalid args { input => ['foo'], error => qr/^could not parse /, type => 'bad net', }, { input => [ '10.10.10.10', 'foo' ], error => qr/^could not parse /, type => 'bad mask', }, { input => [ '10.10.10', 'foo' ], error => qr/^could not parse /, type => 'bad mask', }, { input => [ '10.10', 'foo' ], error => qr/^could not parse /, type => 'bad mask', }, { input => [ '10', 'foo' ], error => qr/^could not parse /, type => 'bad mask', }, { input => [ '10.10.10.10', '0xYYY' ], error => qr/^could not parse /, type => 'bad mask', }, ); foreach my $test (@tests) { my $input = $test->{input}; my $err = $test->{error}; my $name = ( join ', ', @{ $test->{input} } ); my $type = $test->{type}; my $result = Net::Netmask->new2(@$input); is( $result, undef, "$name $type" ); like( Net::Netmask->errstr, $err, "$name errstr mismatch" ); } # test whois numbers with space between dash (valid!) ok( Net::Netmask->new2('209.157.64.0 - 209.157.95.255'), "whois with single space around dash" ); ok( Net::Netmask->new2('209.157.64.0 - 209.157.95.255'), "whois with mulitple spaces around dash" ); done_testing; Net-Netmask-1.9104/t/author-test-version.t0000644000175000017500000000104113326722143020155 0ustar jmaslakjmaslak BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Net-Netmask-1.9104/t/sortspeed-ip.t0000644000175000017500000000340413326722143016636 0ustar jmaslakjmaslak#!/usr/bin/perl -w use strict; # # 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 ) { ## no critic: (InputOutput::ProhibitInteractiveTest) 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.9104/t/author-critic.t0000644000175000017500000000041713326722143016776 0ustar jmaslakjmaslak#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::Perl::Critic (-profile => "t/data/perlcriticrc") x!! -e "t/data/perlcriticrc"; all_critic_ok(); Net-Netmask-1.9104/t/author-pod-syntax.t0000644000175000017500000000045413326722143017630 0ustar jmaslakjmaslak#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Net-Netmask-1.9104/t/release-unused-vars.t0000644000175000017500000000057113326722143020114 0ustar jmaslakjmaslak#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } use Test::More 0.96 tests => 1; eval { require Test::Vars }; SKIP: { skip 1 => 'Test::Vars required for testing for unused vars' if $@; Test::Vars->import; subtest 'unused vars' => sub { all_vars_ok(); }; }; Net-Netmask-1.9104/t/release-trailing-space.t0000644000175000017500000000117513326722143020543 0ustar jmaslakjmaslak#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { print qq{1..0 # SKIP these tests are for release candidate testing\n}; exit } } use strict; use warnings; use Test::More; eval "use Test::TrailingSpace"; if ($@) { plan skip_all => "Test::TrailingSpace required for trailing space test."; } else { plan tests => 1; } # TODO: add .pod, .PL, the README/Changes/TODO/etc. documents and possibly # some other stuff. my $finder = Test::TrailingSpace->new( { root => '.', filename_regex => qr#\.(?:ini|pl|pm|pod|t|txt)\z#, }, ); # TEST $finder->no_trailing_space( "No trailing space was found." ); Net-Netmask-1.9104/t/data/0000775000175000017500000000000013326722143014745 5ustar jmaslakjmaslakNet-Netmask-1.9104/t/data/perlcriticrc0000644000175000017500000000221513326722143017353 0ustar jmaslakjmaslakseverity=4 verbose=8 exclude=InputOutput::RequireBriefOpen Subroutines::ProhibitSubroutinePrototypes Subroutines::RequireArgUnpacking # Classes with metod signatures [-Subroutines::ProhibitSubroutinePrototypes] # We turn on strictures in our bootstrap module we almost always use [-TestingAndDebugging::RequireUseStrict] [-TestingAndDebugging::RequireUseWarnings] # When we modify $_, we know what we're doing. [-ControlStructures::ProhibitMutatingListFunctions] # It's okay to do "no warnings 'foo'" if needed - you are expected to # know what you're doing if you do that! [TestingAndDebugging::ProhibitNoWarnings] allow_with_category_restriction = 1 # If I use , I don't want <>! [-InputOutput::ProhibitExplicitStdin] # This is useful in map to map an array to a hash ( map { $_, $_ } ... ) [ValuesAndExpressions::ProhibitCommaSeparatedStatements] allow_last_statement_to_be_comma_separated_in_map_and_grep = 1 # We don't want to require these [-ErrorHandling::RequireUseOfExceptions] # I want to know about redefined variables [Variables::ProhibitReusedNames] severity = 4 # Testing for found words [BadStrings] words = Joel Maslak severity = 4 Net-Netmask-1.9104/t/ipv6_cannonical.t0000644000175000017500000000333313326722143017272 0ustar jmaslakjmaslak#!/usr/bin/perl # # Copyright (C) 2018 Joelle Maslak # All Rights Reserved - See License # use strict; use warnings; use Test2::V0 0.000111; use Net::Netmask; my (@tests) = ( { input => '::', output => '::', }, { input => ':0::', output => '::', }, { input => '::0:', output => '::', }, { input => '0:0:0:0:0:0:0:0', output => '::', }, { input => '1:2:3:4:5:6:7:8', output => '1:2:3:4:5:6:7:8', }, { input => '01:02:03:04:05:06:07:08', output => '1:2:3:4:5:6:7:8', }, { input => '1:2:3:0:0:6:7:8', output => '1:2:3::6:7:8', }, { input => '0:0:3:4:5:6:7:8', output => '::3:4:5:6:7:8', }, { input => '1:2:3:4:5:6:0:0', output => '1:2:3:4:5:6::', }, { input => '0:0:3:4:5:6:0:0', output => '::3:4:5:6:0:0', }, { input => '0:0:3:4:5:0:0:0', output => '0:0:3:4:5::', }, { input => '1:0:0:0:5:0:0:0', output => '1::5:0:0:0', }, { input => '1:0:0:0:5F:0:0:0', output => '1::5f:0:0:0', }, { input => '1:0:0:0:5F:0:1.2.3.4', output => '1::5f:0:102:304', }, { input => '1:0:0:0:5F:0:1.2.255.4', output => '1::5f:0:102:ff04', }, { input => '1:0:0:0:5F:0:0:0', output => '1::5f:0:0:0', }, { input => '1:0:0:0:5F:0:0:0', output => '1::5f:0:0:0', }, ); foreach my $test (@tests) { my $got = Net::Netmask::ipv6Cannonical($test->{input}); is($got, $test->{output}, $test->{input} . ' -> ' . $test->{output}); } done_testing; 1; Net-Netmask-1.9104/t/00-load.t0000644000175000017500000000007713326722143015357 0ustar jmaslakjmaslakuse strict; use Test::UseAllModules; BEGIN { all_uses_ok(); } Net-Netmask-1.9104/t/split-ipv6.t0000644000175000017500000000247013326722143016237 0ustar jmaslakjmaslak#!/usr/bin/perl -I. -w use strict; use Test2::V0; use Net::Netmask; #feel free to add a build requires of Test::Exception if that is okay with you. sub throws_ok(&$$) { my ( $code, $regex, $desc ) = @_; eval { $code->(); }; my $err = $@; like( $err, $regex ); return; } sub make_nm { my ($cidr_str) = @_; return Net::Netmask->new($cidr_str); } my $cidr128 = make_nm('2001:db8::/128'); my $cidr120 = make_nm('2001:db8::/120'); my $cidr48 = make_nm('2001:db8::/48'); throws_ok { $cidr48->split(3) } qr/^Parts count must be a number of base 2. Got: 3/, "Non base 2 split count errors."; throws_ok { $cidr48->split() } qr/^Parts must be defined and greater than 0./, "undef split throws error"; throws_ok { $cidr48->split(0) } qr/^Parts must be defined and greater than 0./, "Zero split throws error"; throws_ok { $cidr48->split(-1) } qr/^Parts must be defined and greater than 0./, "Negative split count errors"; throws_ok { $cidr128->split(2) } qr/^Netmask only contains 1 IPs. Cannot split into 2./, "32 cannot be split"; is $cidr48->split(2), map( { make_nm( "2001:db8:${_}::/49" ) } ( "0", "8000" ) ), 'Can split /48 into 2 49s'; is $cidr120->split(256), map( { make_nm sprintf("2001:db8::%x", $_) } ( 0 .. 255 ) ), 'Can split into 128s (i.e $parts = $self->size)'; done_testing(); Net-Netmask-1.9104/t/sortspeed-blocks.t0000644000175000017500000000346113326722143017506 0ustar jmaslakjmaslak#!/usr/bin/perl -w use strict; # # 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 ) { ## no critic: (InputOutput::ProhibitInteractiveTest) 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 ( $o1, $o2, $o3, $o4 ); my $class = int( rand(3) ); if ( $class == 0 ) { ## class A ( 1.0.0.0 - 126.255.255.255 ) $o1 = int( rand(126) ) + 1; } elsif ( $class == 1 ) { ## class B ( 128.0.0.0 - 191.255.255.255 ) $o2 = int( rand(64) ) + 128; } else { ## class C ( 192.0.0.0 - 223.255.255.255 ) $o3 = int( rand(32) ) + 192; } $o2 = int( rand(256) ); $o3 = int( rand(256) ); $o4 = int( rand(256) ); $mask = int( sqrt( rand(1024) ) ); my $i = quad2int("$o1.$o2.$o3.$o4") & imask($mask); my $base = int2quad($i); push( @list, Net::Netmask->new("$base/$mask") ); } return @list; } my (@iplist) = generate(5000); cmpthese( -1, { candidate => sub { my (@x) = mysortfunc(@iplist); }, distributed => sub { my (@x) = sort_network_blocks(@iplist); }, } );