Net-IPTrie-0.7000755001750001750 011433564401 14024 5ustar00cvicentecvicente000000000000Net-IPTrie-0.7/README000444001750001750 465411433564401 15052 0ustar00cvicentecvicente000000000000Net::IPTrie ############################################################################ INSTALLATION ############################################################################ You have two options: perl Build.PL ./Build ./Build test ./Build install or (if you have GNU make): perl Makefile.PL make make test make install ############################################################################ BACKGROUND: ############################################################################ A trie structure is based on a radix tree using a radix of two. This is commonly used in routing engines, which need to quickly find the best match for a given address against a list of prefixes. The term "Trie" is derived from the word "retrieval". For more information on digital trees, see: * Algorithms in C, Robert Sedgewick How it works: A digital tree is built by performing a binary comparison on each bit of the number (in this case, the IP address) sequentially, starting from the most significant bit. Examples: Given these two IP addresses: bit 31 0 | | 10.0.0.0/8 : 00001010.00000000.00000000.00000000/8 10.128.0.0/32 : 00001010.10000000.00000000.00000000/32 Insert the first one in the trie and look up the second one. Starting with the first address: bit tree position ------------------------------------------------------------------- 31 0 30 0 29 0 28 0 27 1 26 0 25 1 24 0 <-- Prefix position (size - prefix). Stop and save object Continuing with the second address: bit tree position ------------------------------------------------------------------- 31 0 30 0 29 0 28 0 27 1 26 0 25 1 24 0 <-- 10.0.0.0/8 exists here 23 1 22 0 ...continued until bit 0 Since there are no more objects to process, it is determined that the "parent" of the second adddress is the first address. ############################################################################ COPYRIGHT AND LICENCE ############################################################################ Copyright (c) Carlos Vicente . All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-IPTrie-0.7/Changes000444001750001750 133111433564401 15452 0ustar00cvicentecvicente000000000000 Revision history for Net::IPTrie 0.7 2010/08/20 - Require Scalar::Util >= 1.21 0.6 2010/08/20 - Fixed Bug #60552 for Net-IPTrie: Memory leak if an IPTrie becomes unreferenced (thanks to Christian Ehrhardt) 0.5.1 2010/08/12 - Fixed bug where a node's parent would not be found after the node was deleted - Fixed IPv6 tests 0.5 2009/08/10 - Removed requirement for version.pm 0.4 2008/10/26 - Fixed to match the default route (0.0.0.0/0) - rt.cpan.org #38768 - Minor changes in POD documentation 0.3 2007/11/26 - Fixed to accept all-zero prefixes (thanks to Ville Mattila) - Fixes in POD documentation 0.2 2007/10/10 - Added missing Makefile.PL and this file 0.1 2007/10/08 Initial release. Net-IPTrie-0.7/Build.PL000444001750001750 56411433564401 15442 0ustar00cvicentecvicente000000000000use Module::Build; my $build = Module::Build->new ( module_name => 'Net::IPTrie', license => 'perl', requires => { 'perl' => '5.8.0', 'Class::Struct' => '0.63', 'Scalar::Util' => '1.21', 'Test::More' => '0', 'NetAddr::IP' => '4.007', }, create_makefile_pl => 'traditional', ); $build->create_build_script; Net-IPTrie-0.7/Makefile.PL000444001750001750 111111433564401 16125 0ustar00cvicentecvicente000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.3603 require 5.008000; use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Net::IPTrie', 'VERSION_FROM' => 'lib/Net/IPTrie.pm', 'PREREQ_PM' => { 'Class::Struct' => '0.63', 'NetAddr::IP' => '4.007', 'Scalar::Util' => '1.21', 'Test::More' => '0' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Net-IPTrie-0.7/MANIFEST000444001750001750 17711433564401 15277 0ustar00cvicentecvicente000000000000Build.PL Makefile.PL lib/Net/IPTrie.pm lib/Net/IPTrie/Node.pm MANIFEST This list of files META.yml README Changes t/IPTrie.t Net-IPTrie-0.7/META.yml000444001750001750 121111433564401 15425 0ustar00cvicentecvicente000000000000--- abstract: 'Perl module for building IPv4 and IPv6 address space hierarchies' author: - 'Carlos Vicente ' configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3603' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-IPTrie provides: Net::IPTrie: file: lib/Net/IPTrie.pm version: 0.7 Net::IPTrie::Node: file: lib/Net/IPTrie/Node.pm version: 0.7 requires: Class::Struct: 0.63 NetAddr::IP: 4.007 Scalar::Util: 1.21 Test::More: 0 perl: v5.8.0 resources: license: http://dev.perl.org/licenses/ version: 0.7 Net-IPTrie-0.7/t000755001750001750 011433564401 14267 5ustar00cvicentecvicente000000000000Net-IPTrie-0.7/t/IPTrie.t000444001750001750 430711433564401 15751 0ustar00cvicentecvicente000000000000use strict; use Test::More qw(no_plan); use lib "lib"; BEGIN { use_ok('Net::IPTrie'); } my $tr = Net::IPTrie->new(version=>4); isa_ok($tr, 'Net::IPTrie', 'Constructor'); my $n = $tr->add(address=>'10.0.0.0', prefix=>8); isa_ok($n, 'Net::IPTrie::Node', 'Node Constructor'); # Root (default route) my $r = $tr->add(address=>'0.0.0.0', prefix=>0); is($r->address, '0.0.0.0', 'address'); is($r->iaddress, 0, 'iaddress'); is($r->prefix, 0, 'prefix'); is($n->address, '10.0.0.0', 'address'); is($n->iaddress, '167772160', 'iaddress'); is($n->prefix, '8', 'prefix'); is($n->parent->address, $r->address, 'root parent'); my $a = $tr->add(address=>'10.0.0.0', prefix=>24); is($a->parent->address, $n->address, 'parent'); my $b = $tr->add(address=>'10.0.0.1'); is($b->parent->address, $a->address, 'parent'); my $p = $tr->find(address=>'10.0.0.1'); is($p->address, $b->address, 'find'); my $q = $tr->find(address=>'10.0.0.2'); is($q->address, $a->address, 'find'); # This is 10.0.0.7 in integer format my $c = $tr->add(iaddress=>'167772167', data=>'blah'); is($c->parent->address, $a->address, 'parent'); is($c->data, 'blah', 'data'); # Traversal my $list = (); my $code = sub { push @$list, shift @_ }; my $count = $tr->traverse(code=>$code); my $tlist = [$r, $n, $a, $b, $c]; is_deeply($tlist, $list, 'traverse'); is($count, 5, 'traverse count'); # Delete does not actually delete the node, but empties it $a->delete(); is($a->address, undef, 'delete'); is($a->iaddress, undef, 'delete'); is($a->prefix, undef, 'delete'); is($a->data, undef, 'delete'); # b's parent should now be $n, not $a is($b->parent->address, $n->address, 'parent'); $b->delete(); my $s = $tr->find(address=>'10.0.0.1'); is($s->address, $n->address, 'find'); # IPv6 tests my $tr6 = Net::IPTrie->new(version=>6); isa_ok($tr, 'Net::IPTrie', 'Constructor'); my $n6 = $tr6->add(address=>'FEC0:468:D00::', prefix=>40); my $a6 = $tr6->add(address=>'FEC0:468:D00::', prefix=>48); is($a6->parent->address, $n6->address, 'parent'); my $b6 = $tr6->add(address=>'FEC0:468:D00:1::', prefix=>64); is($b6->parent->address, $a6->address, 'parent'); my $c6 = $tr6->add(address=>'FEC0:468:D00:1::80DF:3C16', prefix=>128); is($c6->parent->address, $b6->address, 'parent'); Net-IPTrie-0.7/lib000755001750001750 011433564401 14572 5ustar00cvicentecvicente000000000000Net-IPTrie-0.7/lib/Net000755001750001750 011433564401 15320 5ustar00cvicentecvicente000000000000Net-IPTrie-0.7/lib/Net/IPTrie.pm000444001750001750 2576311433564401 17204 0ustar00cvicentecvicente000000000000package Net::IPTrie; use warnings; use strict; use Carp; use NetAddr::IP; use Net::IPTrie::Node; use vars qw($VERSION); $VERSION = '0.7'; 1; =head1 NAME Net::IPTrie - Perl module for building IPv4 and IPv6 address space hierarchies =head1 SYNOPSIS use Net::IPTrie; my $tr = Net::IPTrie->new(version=>4); # IPv4 my $n = $tr->add(address=>'10.0.0.0', prefix=>8); my $a = $tr->add(address=>'10.0.0.1', data=>$data) # prefix defaults to 32 $a->parent->address eq $n->address and print "$a is within $n"; # Addresses can be provided in integer (decimal) format # 10.0.0.7 == 167772167 my $b = $tr->add(iaddress=>'167772167', data=>'blah'); if ( my $c = $tr->find(address=>"10.0.0.7" ) { print $c->data; # should print "blah" } # If the IP does not exist: my $d = $tr->find(address=>"10.0.0.8") print $d->address; # should print "10.0.0.0", which is the closest parent block =head1 DESCRIPTION This module uses a radix tree (or trie) to quickly build the hierarchy of a given address space (both IPv4 and IPv6). This allows the user to perform fast subnet or routing lookups. It is implemented exclusively in Perl. =head1 CLASS METHODS =head2 new - Class Constructor Arguments: Hash with the following keys: version - IP version (4|6) Returns: New Net::IPTrie object Examples: my $tr = Net::IPTrie->new(version=>4); =cut sub new { my ($proto, %argv) = @_; croak "Missing required parameters: version" unless defined $argv{version}; my $class = ref($proto) || $proto; my $self = {}; if ( $argv{version} == 4 ){ $self->{_size} = 32; }elsif ( $argv{version} == 6 ){ # IPv6 numbers are larger than what a normal integer can hold use bigint; $self->{_size} = 128; }else{ croak("Invalid IP version: $argv{version}"); } $self->{_version} = $argv{version}; $self->{_trie} = Net::IPTrie::Node->new(); bless $self, $class; return $self; } ############################################################################ =head1 INSTANCE METHODS =head2 version - Set or get IP version (4 or 6) Arguments: IP version (4 or 6) - optional Returns: version (4 or 6) Examples: print $tr->version; =cut sub version { my ($self, $v) = @_; croak "version is an instance method" unless ref($self); $self->{_version} = $v if ( defined $v ); return $self->{_version}; } ############################################################################ =head2 size - Set or get IP size (32 or 128) Arguments: Size (32 or 128) - optional Returns: Address size in bits (32 or 128) Examples: print $tr->size; =cut sub size { my ($self, $s) = @_; croak "size is an instance method" unless ref($self); $self->{_size} = $s if ( defined $s ); return $self->{_size}; } ############################################################################ =head2 find - Find an IP object in the trie If the given IP does not exist, there are two options: a) If the "deep" flag is off, the closest covering IP block is returned. This is the default behavior. b) If the "deep" flag is on, the node where the searched IP should be inserted is returned. This is basically only useful for the "add" method. Arguments: Hash with following keys: address - String (i.e. "10.0.0.1") address iaddress - Integer (i.e. "167772161") address, IPv4 or IPv6. prefix - Prefix Length (optional - defaults to host mask) deep - Flag (optional). If not found, return the node where object should be inserted. Returns: Net::IPTrie::Node object. Examples: my $n = $tr->find("10.0.0.1", 32); =cut sub find { my ($self, %argv) = @_; croak "find is an instance method" unless ref($self); my ($address, $iaddress, $prefix, $deep) = @argv{'address', 'iaddress', 'prefix', 'deep'}; croak "Missing required arguments: address or iaddress" unless (defined $address || defined $iaddress); $prefix = $self->size unless ( defined $prefix ); my $p = $self->{_trie}; # pointer that starts at the root my $bit = $self->size; # Start at the most significant bit # Convert string address into integer if necessary if ( defined $address && !defined $iaddress ){ $iaddress = $self->_ip2int($address); } while ( $bit > $self->size - $prefix ){ $bit--; # bit comparison. my $r = ($iaddress & 2**$bit) == 0 ? 'left' : 'right'; if ( !defined $p->$r ){ if ( $deep ){ # Insert new node $p->$r(Net::IPTrie::Node->new(up=>$p)); }else{ # Just return the closest covering IP block if ( $p->iaddress ){ return $p; }else{ return $p->parent; } } } # Walk one step down the tree $p = $p->$r; if ( defined $p->iaddress ){ # If the address matches, return node if ( $p->iaddress == $iaddress && $p->prefix == $prefix ){ return $p; } }elsif ( !$deep && ($bit == $self->size - $prefix) ){ # This is a deleted node return $p->parent; } } # We fell off the bottom. We tell where to create a new node. return $p; } ############################################################################ =head2 add - Add an IP to the trie Arguments: Hash with following keys: address - String address, IPv4 or IPv6 (i.e. "10.0.0.1") iaddress - Integer address, IPv4 or IPv6 (i.e. "167772161") prefix - Prefix Length (optional - defaults to host mask) data - Data (optional) Returns: New Net::IPTrie::Node object Examples: my $n = $tr->add(address=>"10.0.0.1", prefix=>32, data=>\$data); =cut sub add { my ($self, %argv) = @_; croak "add is an instance method" unless ref($self); my ($address, $iaddress, $prefix, $data) = @argv{'address', 'iaddress', 'prefix', 'data'}; croak "Missing required arguments: address\n" unless ( defined $address || defined $iaddress ); $prefix = $self->size unless ( defined $prefix ); # Convert string address into integer if necessary if ( defined $address && !defined $iaddress ){ $iaddress = $self->_ip2int($address); }elsif ( defined $iaddress && !defined $address ){ $address = $self->_int2ip($iaddress); } my $n = $self->find(iaddress=>$iaddress, prefix=>$prefix, deep=>1); unless ( defined $n->iaddress && $n->iaddress == $iaddress ){ $n->iaddress($iaddress); $n->address($address); $n->prefix($prefix); $n->data($data); } return $n; } ############################################################################ =head2 traverse - Traverse every node in the tree Arguments: root - node object (optional - defaults to tree root) code - coderef (will be passed the Net::IPTrie::Node object to act upon) mode - (depth_first only, for now) Returns: Number of actual IP nodes visited Examples: # Store all IP nodes in an array, ordered. my $list = (); my $code = sub { push @$list, shift @_ }; my $count = $tr->traverse(code=>$code); =cut sub traverse { my ($self, %argv) = @_; croak "traverse is an instance method" unless ref($self); my ($root, $code, $mode) = @argv{'root', 'code', 'mode'}; my $p = $root || $self->{_trie}; my $count = 0; $mode |= 'depth_first'; if ( $mode eq 'depth_first' ){ $self->_depth_first(node=>$p, code=>$code, count=>\$count); }else{ croak "Unknown climb mode: $mode"; } return $count; } ############################################################################ # # PRIVATE METHODS # ############################################################################ ############################################################################ # _ip2int - Convert string IP to integer # # Arguments: # IP address in string format ('10.0.0.1') # Returns: # IP address in integer format # Examples: # my $number = $tr->ip2int('10.0.0.1'); # sub _ip2int { my ($self, $ip) = @_; my $nip; if ( $self->version == 4 ){ $nip = NetAddr::IP->new($ip); }else{ $nip = NetAddr::IP->new6($ip); } croak "Invalid IP: $ip" unless $nip; return $nip->numeric; } ############################################################################ # _int2ip - Convert integer IP to string # # Arguments: # IP address in integer format # Returns: # IP address in string format # Examples: # my $dottedquad = $tr->_int2ip(167772161); # sub _int2ip { my ($self, $int) = @_; my $nip; if ( $self->version == 4 ){ $nip = NetAddr::IP->new($int); }else{ $nip = NetAddr::IP->new6($int); } croak "Invalid IP integer: $int" unless $nip; return $nip->addr; } ############################################################################ # _depth_first - Recursively visit each node in depth-first mode # # Arguments: # Hash with following key/value pairs: # node - Starting node # code - coderef (will be passed the Net::IPTrie::Node object to act upon) # count - Scalar reference # Returns: # Examples: # # sub _depth_first { my ($self, %argv) = @_; my ($n, $code, $count) = @argv{'node', 'code', 'count'}; if ( $n->address ){ if ( defined $code && ref($code) eq "CODE" ){ # execute code $code->($n); } $$count++; } $self->_depth_first(node=>$n->left, code=>$code, count=>$count) if ( defined $n->left ); $self->_depth_first(node=>$n->right, code=>$code, count=>$count) if ( defined $n->right ); } =head1 AUTHOR Carlos Vicente =head1 SEE ALSO Net::IPTrie::Node Net::Patricia =head1 LICENCE AND COPYRIGHT Copyright (c) 2007-2010, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "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 SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. 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 SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (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 SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut Net-IPTrie-0.7/lib/Net/IPTrie000755001750001750 011433564401 16454 5ustar00cvicentecvicente000000000000Net-IPTrie-0.7/lib/Net/IPTrie/Node.pm000444001750001750 755311433564401 20046 0ustar00cvicentecvicente000000000000package Net::IPTrie::Node; use warnings; use strict; use Carp; use Class::Struct; use Scalar::Util qw(weaken); use vars qw($VERSION); $VERSION = '0.7'; BEGIN { struct ( "Net::IPTrie::_Node" => { 'up' => '$', 'left' => '$', 'right' => '$', 'address' => '$', 'iaddress' => '$', 'prefix' => '$', 'data' => '$', }); } use base qw (Net::IPTrie::_Node); =head1 NAME Net::IPTrie::Node =head1 SYNOPSIS See Net::IPTrie =head1 DESCRIPTION See Net::IPTrie =head1 CLASS METHODS =head2 new - Constructor Arguments: up - Parent node left - Left child node right - Right child node address - Address string prefix - IP prefix (defaults to host mask) iaddress - Integer address data - Scalar (could be a reference to any data structure) Returns: New Net::IPTrie::Node object Examples: my $n = Net::IPTrie::Node->new(up=>$up, address=>"10.0.0.1") =cut sub new { my $ret = shift->SUPER::new(@_); if ( defined($ret->{'Net::IPTrie::_Node::up'}) ) { weaken $ret->{'Net::IPTrie::_Node::up'}; } return $ret; } sub up { my $self = shift; if (@_) { $self->{'Net::IPTrie::_Node::up'} = shift; if ( defined($self->{'Net::IPTrie::_Node::up'}) ) { weaken $self->{'Net::IPTrie::_Node::up'}; } } return $self->{'Net::IPTrie::_Node::up'}; } =head1 INSTANCE METHODS =cut ############################################################################ =head2 parent - Find closest parent node with IP information Arguments: None Returns: Node object with address, or undef Examples: my $parent = $node->parent; =cut sub parent { my ($self) = @_; my $p = $self->up; while ( defined $p && !defined $p->iaddress ){ $p = $p->up; } return $p; } ############################################################################ =head2 delete - Delete an IP node from the tree Note: The node is actually emptied, not deleted Arguments: None Returns: Deleted (empty) Node object Examples: my $n = $tr->find("10.0.0.1"); $n->delete(); =cut sub delete { my ($self) = @_; $self->address(undef); $self->iaddress(undef); $self->prefix(undef); $self->data(undef); return $self; } # Make sure to return 1 1; =head1 AUTHOR Carlos Vicente =head1 SEE ALSO Net::IPTrie =head1 LICENCE AND COPYRIGHT Copyright (c) 2007-2010, Carlos Vicente . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "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 SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. 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 SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (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 SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut