Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Net::CIDR::Lite ?? (Merge CIDR addresses)

by runrig (Abbot)
on Oct 16, 2001 at 22:05 UTC ( #119206=sourcecode: print w/ replies, xml ) Need Help??

Category: Networking Code
Author/Contact Info runrig
Description: Inspired by Dominus' Challenge Problem: Merging Network Addresses, I posted a reply script which was (about 20 times) faster than the Net::CIDR solution, and thought I'd make a module out of it. Also looking for comments on whether it ought to be on CPAN, and under what name. I'd never before heard of let alone used the Socket::inet_* functions, so I couldn't have done it this way without that thread. It might be interesting to get this to work optionally with IPv6 addresses, but then you'd probably have to use some big integer library like Bit::Vector, so I'm open to suggestions on that :)

Updated with tye's recommendation.

Update: Net::CIDR::Lite has been on CPAN for awhile now and updated several times over. Consider the code on this page obsolete.

Sample usage:
use Net::CIDR::Lite;
my $cidr = Net::CIDR::Lite->new;

$cidr->add("209.152.214.112/30");
$cidr->add("209.152.214.116/31");
$cidr->add("209.152.214.118/31");

print "$_\n" for $cidr->list;

And the module:
##################################
package Net::CIDR::Lite;

use strict;
use Socket qw(inet_aton inet_ntoa);

use vars qw($VERSION);

$VERSION = '0.01';

my @masks = (0,0,map { pack("B*", substr("1" x $_ . "0" x 32, 0, 32)) 
+} 2..32);
my @bits2rng = (0,0,map { 2**(32 - $_) } 2..32);
my %rng2bits = map { $bits2rng[$_] => $_ } 0..32;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    bless {}, $class;
}

sub add {
    my $self = shift;
    local $_ = shift;
    my ($ip, $mask) = split "/";
    my $start = inet_aton($ip) & $masks[$mask];
    my $end = pack("N", unpack("N", $start) + $bits2rng[$mask]);
    $$self{$start}++;
    $$self{$end}--;
}

sub clean {
    my $self = shift;
    %$self = map { $$self{$_} ? ($_ => $$self{$_}) : () } keys %$self;
}

sub list {
    my $self = shift;
    my ($start, $total);
    my @results;
    for my $ip (sort keys %$self) {
        $start = $ip unless $total;
        $total += $$self{$ip};
        unless ($total) {
            my $diff = unpack("N", $ip) - unpack("N", $start);
            while ($diff) {
                (my $zeros = unpack("B*", $start)) =~ s/^.*1//;
                my $range;
                for my $i (32-length($zeros)..32) {
                    $range = $bits2rng[$i], last if $bits2rng[$i] <= $
+diff;
                }
                push @results, inet_ntoa($start)."/".$rng2bits{$range}
+;
                $diff -= $range;
                $start = pack("N", unpack("N", $start)+$range);
            }
        }
    }
    wantarray ? @results : \@results;
}

1;
__END__

=head1 NAME

Net::CIDR::Lite - Perl extension for merging CIDR addresses

=head1 SYNOPSIS

  use Net::CIDR::Lite;

  my $cidr = Net::CIDR::Lite->new;
  $cidr->add($cidr_address);
  @cidr_list = $cidr->list;

=head1 DESCRIPTION

Faster alternative to Net::CIDR::cidradd. Limited
for the time being to IPv4 addresses.

=head1 METHODS

=item new() 

 $cidr = Net::CIDR::Lite->new

Creates an object to represent a list of CIDR address ranges.

=item add()

 $cidr->add($cidr_address)

Adds a CIDR address range to the list.

=item $cidr->clean()

 $cidr->clean;

If you are going to call the list method more than once on the
same data, then for optimal performance, you can call this to
purge null nodes from the list.

=item $cidr->list()

 @cidr_list = $cidr->list;

Returns a list of the merged CIDR addresses.

=head1 CAVEATS

Garbage in/garbage out. This module makes no attempt to validate
the format of your data.

=head1 AUTHOR
runrig
=head1 COPYRIGHT

 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Net::CIDR>.

=cut

Comment on Net::CIDR::Lite ?? (Merge CIDR addresses)
Select or Download Code
(tye)Re: Net::CIDR::Lite ?? (Merge CIDR addresses)
by tye (Cardinal) on Oct 16, 2001 at 23:19 UTC

    Just a quick note (at least for now): You need to change your packs/unpacks to use "N" so that the sorting will work on little-endian systems.

            - tye (but my friends call me "Tye")
Re: Net::CIDR::Lite ?? (Merge CIDR addresses)
by runrig (Abbot) on Oct 20, 2001 at 04:55 UTC
    Here's an update which works on IPv4, IPv6, and heck even IPvN addresses. Its a bit slower (benchmark on the sample file increased from ~10 to ~16 seconds), but it helps to call clean() before you call list if there was alot of merges (which took the benchmark back down to ~12 seconds). I'm not sure I'm happy with everything, but tye will probably post a better answer soon anyway (who gave me ideas about how to produce this version) (:
    package Net::CIDR::Lite; use strict; use vars qw($VERSION $DEBUG); use Carp qw(confess); $VERSION = '0.02'; my %masks; my @fields = qw(PACK UNPACK NBITS ZERO MASKS); # Preloaded methods go here. sub new { my $proto = shift; my $class = ref($proto) || $proto; bless {}, $class; } sub add { my $self = shift; my ($ip, $mask) = split "/", shift; $self->_init($ip) || confess "Can't determine ip format" unless %$ +self; my $start = $self->{PACK}->($ip) & $self->{MASKS}[$mask] or confess "Bad ip address: $ip"; my $end = _add_bit($start, $mask); ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start}; --$$self{RANGES}{$end} || delete $$self{RANGES}{$end}; } sub clean { my $self = shift; my $ranges = $$self{RANGES}; my $total; $$self{RANGES} = { map { $total ? ($total+=$$ranges{$_})? () : ($_=>1) : do { $total+=$$ranges{$_}; ($_=>-1) } } sort keys %$ranges }; } sub list { my $self = shift; my $nbits = $$self{NBITS}; my ($start, $total); my @results; for my $ip (sort keys %{$$self{RANGES}}) { $start = $ip unless $total; $total += $$self{RANGES}{$ip}; unless ($total) { while ($start lt $ip) { my ($end, $bits); (my $zeros = unpack("B*", $start)) =~ s/.*1//; for my $mask ($nbits-length($zeros)..$nbits) { $end = _add_bit($start, $mask) or next; $bits = $mask, last if $end le $ip; } push @results, $self->{UNPACK}->($start) . "/$bits"; $start = $end; } } } wantarray ? @results : \@results; } sub _init { my $self = shift; my $ip = shift; my ($nbits, $pack, $unpack); if (_pack_ipv4($ip)) { $nbits = 32; $pack = \&_pack_ipv4; $unpack = \&_unpack_ipv4; } elsif (_pack_ipv6($ip)) { $nbits = 128; $pack = \&_pack_ipv6; $unpack = \&_unpack_ipv6; } else { return; } $$self{PACK} = $pack; $$self{UNPACK} = $unpack; $$self{NBITS} = $nbits; $$self{ZERO} = "0" x $nbits; $$self{MASKS} = $masks{$nbits} ||= [ map { pack("B*", substr("1" x $_ . "0" x $nbits, 0, $nbits)) } 0..$nbits ]; } sub _pack_ipv4 { my @nums = split /\./, shift(), -1; return unless @nums == 4; for (@nums) { return unless /^\d{1,3}$/ and $_ <= 255; } pack("C*", @nums); } sub _unpack_ipv4 { join(".", unpack("C*", shift)); } sub _pack_ipv6 { my $ip = shift; return if $ip =~ /^:/ and $ip !~ s/^::/:/; return if $ip =~ /:$/ and $ip !~ s/::$/:/; my @nums = split /:/, $ip, -1; return unless @nums <= 8; my ($empty, $ipv4, $str) = (0,'',''); for (@nums) { return if $ipv4; $str .= "0" x (4-length) . $_, next if /^[a-fA-F\d]{1,4}$/; do { return if $empty++ }, $str .= "X", next if $_ eq ''; next if $ipv4 = _pack_ipv4($_); return; } return if $ipv4 and @nums > 6; $str =~ s/X/"0" x (($ipv4 ? 25 : 33)-length($str))/e if $empty; pack("H*", $str).$ipv4; } sub _unpack_ipv6 { _compress_ipv6(join(":", (unpack("H*", shift)) =~ /..../g)), } sub _compress_ipv6 { my $ip = shift; if (my @runs = $ip =~ /((?:(?:^|:)(?:0000))+:?)/g ) { my $max = $runs[0]; for (@runs[1..$#runs]) { $max = $_ if length($max) < length; } $ip =~ s/$max/::/; } $ip; } sub add_range { my $self = shift; local $_ = shift; my ($ip_start, $ip_end) = split "-"; $self->_init($ip_start) || confess "Can't determine ip format" unless %$self; my $start = $self->{PACK}->($ip_start) or confess "Bad ip address: $ip_start"; my $end = $self->{PACK}->($ip_end) or confess "Bad ip address: $ip_end"; my $end = _add_bit($start, $$self{NBITS}); $$self{RANGES}{$start}++; $$self{RANGES}{$end}--; } sub add_cidr { my $self = shift; my $cidr = shift; unless (%$self) { @$self{@fields} = @$cidr{@fields}; } $$self{RANGES}{$_} += $$cidr{RANGES}{$_} for keys %{$$cidr{RANGES} +}; } sub _add_bit { my ($start, $add) = @_; $add--; my $end = unpack("B*", $start); { if ($add < 0) { return "\xFF" x (length($start)+1) if $end eq "0" x length +($end); return; } if (substr($end, $add, 1) eq "0") { substr($end, $add, 1) = "1"; last; } substr($end, $add, 1) = "0"; $add--; redo; } pack("B*", $end); } 1; __END__
    Update: Stole tye's idea of "cleaning as you go" which shaved off a few seconds. I don't get anywhere near the benchmarks he does. I get 10-11 seconds on his version versus 12-13 on mine.

    Another Update: Ought to actually work on real IPv6 addresses now (now that I know what they are...not very tested yet, though). If you're curious about what IPv6 is here's a good tutorial. This took the benchmark from ~11-12 seconds up to ~18. Still pretty reasonable I think, especially since there's more validation. Enjoy :-)

(tye)Re2: Net::CIDR::Lite ?? (Merge CIDR addresses)
by tye (Cardinal) on Oct 22, 2001 at 22:49 UTC

    OK, here is my version (which also handles IPv6). It does the famous nm5.in in just under 3 seconds (your original code takes about 3.5 seconds and you new more-than-4-octets code takes over a minute -- no, I don't know why so slow for me), on one computer. It also appears to handle ranges that include 255.255.255.255 which it doesn't appear either of your versions do properly (see nm3.in).

    The major differences are that I "clean as I go" and I use single bitwise operations on strings when possible. This is so much faster and smaller than Net::CIDR, that I'm tempted to make a drop-in replacement for that module based on this (though I'll probably get side-tracked before that happens).

    package CIDR_Lite; use strict; use vars qw($VERSION); $VERSION= '0.03'; my $cache; sub _setCache { my $nBytes= shift; my $nBits= 8*$nBytes; my $h= $cache->[$nBytes]; if( ! $h ) { $h= {}; $h->{zero}= my $zero= "\0" x $nBytes; @{ $h->{mask} }= ( map { pack( "B*", "0" x $_ . "1" x ($nBits-$_) ) } 0..$nBits, ); @{ $h->{width} }= ( $zero, map { pack( "B*", "0" x ($_-1) . "1" . "0" x ($nBits-$_-2) ) } 1..$nBits, ); $cache->[$nBytes]= $h; } return $h; } sub new { my $proto = shift; my $class = ref($proto) || $proto; my $nBytes= shift || 4; my $self= {}; @{$self}{qw( mask width zero )}= @{_setCache($nBytes)}{qw( mask width zero )}; $self->{nBytes}= $nBytes; $self->{nBits}= 8*$nBytes; bless $self, $class; } sub _plus { my $self= shift; my $base= shift; my $bits= shift; my $res= $base | $self->{width}[$bits]; while( $res le $base ) { $res &= ~$self->{width}[$bits--]; return "\xff"x(1+length($base)) if $bits < 0; $res |= $self->{width}[$bits]; } return $res; } sub add { my $self= shift; my $input = shift; my( $ip, $bits )= split "/", $input; my $start= pack( "C*", split /\./, $ip ) & ~$self->{mask}[$bits]; my $end= $self->_plus( $start, $bits ); ++($self->{ranges}{$start}) || delete $self->{ranges}{$start}; --($self->{ranges}{$end}) || delete $self->{ranges}{$end}; } sub clean { my $self = shift; my $ranges= $self->{ranges}; my $total= 0; for my $key ( sort keys %$ranges ) { if( 0 == $total ) { die "Impossible" if $ranges->{$key} <= 0; $total += $ranges->{$key}; $ranges->{$key}= 1; } elsif( 0 == ( $total += $ranges->{$key} ) ) { die "Impossible" if 0 <= $ranges->{$key}; $ranges->{$key}= -1; } else { delete $ranges->{$key}; } } } sub list { my $self= shift; my( $start, $total ); my @results; my $zero= $self->{zero}; for my $ip ( sort keys %{ $self->{ranges} } ) { $start= $ip unless $total; $total += $self->{ranges}{$ip}; if( 0 == $total ) { my $end= $ip; my $bits= $self->{nBits}; while( 1 ) { $bits-- while $zero eq ( $start & $self->{mask}[$bi +ts] ); my $next= $self->_plus( $start, ++$bits ); last if $end lt $next; push @results, join(".",unpack"C*",$start)."/".$bits; $start= $next; } my @temp; $bits= $self->{nBits}; while( 1 ) { $bits-- while $zero eq ( $end & $self->{mask}[$bits +] ); my $next= ~ $self->_plus( ~$end, ++$bits ); last if $next lt $start; push @temp, join(".",unpack"C*",$next)."/".$bits; $end= $next; } push @results, reverse @temp; } } wantarray ? @results : \@results; } 1;
    Updated: Thanks to runrig for catching a couple of hard-coded 32s that got left in.

            - tye (but my friends call me "Tye")
Reaped: Re: Net::CIDR::Lite ?? (Merge CIDR addresses)
by NodeReaper (Curate) on Sep 15, 2011 at 04:30 UTC

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://119206]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2014-09-23 04:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (210 votes), past polls