Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Sorting subnets into a tree

by C_T (Scribe)
on Mar 19, 2008 at 15:13 UTC ( [id://675016]=perlquestion: print w/replies, xml ) Need Help??

C_T has asked for the wisdom of the Perl Monks concerning the following question:

I'm looking for functionality similar to Net::Netmask's cidrs2contiglists() function, but one that creates a full tree (hash of hashes or array of arrays). That is... given a set of subnets it will put them into a data structure based on whether or not a smaller subnet is "contained in" a larger subnet. Leaves should be /32 subnets, then 30s, 29s, etc. The other issue being is that the subnets I'm using for input are sparsely populated. For example, we have /16s, then /24s, then /27s, and finally /32s. Is there a module that can do a sort like this, or am I better off "rolling my own"? Thanks.
Charles Thomas
Madison, WI

Replies are listed 'Best First'.
Re: Sorting subnets into a tree
by ikegami (Patriarch) on Mar 19, 2008 at 17:12 UTC

    The following builds a binary tree, then collapses it into the format I think you want.

    use strict; use warnings; # ----- { package SubnetTreeBuilder; use Socket qw( inet_aton ); sub new { my ($class) = @_; my $btree; return bless(\$btree, $class); } sub add { my ($self, $addr_first, $size, $data) = @_; $data = "$addr_first/$size" if !defined($data); my $pkd_first = inet_aton($addr_first); my $vec_first = pack 'L', unpack 'N', $pkd_first; my $p = $self; $p = \($$p->[ vec($vec_first, 31-$_, 1) ]) for 0 .. $size-1; $$p->[2] = $data; } sub generate { my ($self, $data) = @_; $data = '0.0.0.0/32' if !defined($data); local *_helper = sub { my ($node) = @_; my @children; push @children, _helper($node->[0]) if defined $node->[0]; push @children, _helper($node->[1]) if defined $node->[1]; if (defined($node->[2])) { return [ $node->[2], @children ]; } else { return @children; } }; return [ $data, _helper($$self) ]; } 1; } # ----- sub visit { my ($node, $cb, $depth) = @_; $cb->($node->[0], $depth||0); ++$depth; visit($node->[$_], $cb, $depth) for 1..$#$node; } my $builder = SubnetTreeBuilder->new(); $builder->add('64.0.0.0', 3); # 0,1,0 $builder->add('128.0.0.0', 2); # 1,0 $builder->add('128.0.0.0', 3); # 1,0,0 $builder->add('160.0.0.0', 3); # 1,0,1 # $tree contains a hierarchy of arrays. # Each array represents a subnet. # The first element of a subnet array is the name of the subnet. # Subsequent elements of a subnet array are subnets of the subnet. my $tree = $builder->generate(); visit($tree, sub { my $subnet = $_[0]; my $indent = ' ' x ($_[1]*3); print("$indent$subnet\n"); });
    0.0.0.0/32 64.0.0.0/3 128.0.0.0/2 128.0.0.0/3 160.0.0.0/3

    By the way, it will find the first address of the subnet without even trying if you supply an address that's not the first address of the subnet.

    Update: Bug fix in the return value.

      This is fast as heck and works like a charm. I'm very impressed!

      Thanks!

      Charles Thomas
      Madison, WI
Re: Sorting subnets into a tree
by pc88mxer (Vicar) on Mar 19, 2008 at 17:34 UTC
    I don't know of any existing routine, but I think something like this should work:
    use Net::Netmask; my @blocks = (...); # list of your cidr blocks my @sorted = sort { ($a->bits <=> $b->bits) || ($a->base <=> $b->base) + } @blocks; my @children; my @parent; for my $i (0..$#sorted) { for (my $j = $i-1; $j >= 0; $j--) { if ($sorted[$j]->contains($sorted[$i])) { $parent[$i] = $j; # or = $sorted[$j]; push(@{$children[$j]}, $i); # or $sorted[$i] last; } } }
    If you want the whole tree rooted, just add:
    unshift(@sorted, new Net::Netmask("0.0.0.0/0")); # one subnet to rule +them all
      This is very much along the lines of what I was thinking of doing by "roll my own". Definitely wanted to make sure I wasn't missing some existing Perl module that would do it automagically. Thanks very much! CT
      Charles Thomas
      Madison, WI

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://675016]
Approved by moritz
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2024-03-29 15:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found