lite.pm

net cidr lite 相关源包算法

package Net::CIDR::Lite;

use strict;
use vars qw($VERSION);
use Carp qw(confess);

$VERSION = '0.20';

my %masks;
my @fields = qw(PACK UNPACK NBITS MASKS);

# Preloaded methods go here.

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = bless {}, $class;
    $self->add_any($_) for @_;
    $self;
}

sub add_any {
    my $self = shift;
    for (@_) {
        tr|/|| && do { $self->add($_); next };
        tr|-|| && do { $self->add_range($_); next };
        UNIVERSAL::isa($_, 'Net::CIDR::Lite') && do {
            $self->add_cidr($_); next
        };
        $self->add_ip($_), next;
    }
    $self;
}

sub add {
    my $self = shift;
    my ($ip, $mask) = split "/", shift;
    $self->_init($ip) || confess "Can't determine ip format" unless %$self;
    confess "Bad mask $mask"
        unless $mask =~ /^\d+$/ and $mask <= $self->{NBITS}-8;
    $mask += 8;
    my $start = $self->{PACK}->($ip) & $self->{MASKS}[$mask]
        or confess "Bad ip address: $ip";
    my $end = $self->_add_bit($start, $mask);
    ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
    --$$self{RANGES}{$end}   || delete $$self{RANGES}{$end};
    $self;
}

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
    };
    $self;
}

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 $sbit = $nbits-1;
                # Find the position of the last 1 bit
                $sbit-- while !vec($start, $sbit^7, 1) and $sbit>0;
                for my $pos ($sbit+1..$nbits) {
                    $end = $self->_add_bit($start, $pos);
                    $bits = $pos-8, last if $end le $ip;
                }
                push @results, $self->{UNPACK}->($start) . "/$bits";
                $start = $end;
            }
        }
    }
    wantarray ? @results : \@results;
}

sub list_range {
    my $self = shift;
    my ($start, $total);
    my @results;
    for my $ip (sort keys %{$$self{RANGES}}) {
        $start = $ip unless $total;
        $total += $$self{RANGES}{$ip};
        unless ($total) {
            $ip = $self->_minus_one($ip);
            push @results,
                $self->{UNPACK}->($start) . "-" . $self->{UNPACK}->($ip);
        }
    }
    wantarray ? @results : \@results;
}

sub _init {
    my $self = shift;
    my $ip = shift;
    my ($nbits, $pack, $unpack);
    if (_pack_ipv4($ip)) {
        $nbits = 40;
        $pack = \&_pack_ipv4;
        $unpack = \&_unpack_ipv4;
    } elsif (_pack_ipv6($ip)) {
        $nbits = 136;
        $pack = \&_pack_ipv6;
        $unpack = \&_unpack_ipv6;
    } else {
        return;
    }
    $$self{PACK}  = $pack;
    $$self{UNPACK}  = $unpack;
    $$self{NBITS} = $nbits;
    $$self{MASKS} = $masks{$nbits} ||= [
      map { pack("B*", substr("1" x $_ . "0" x $nbits, 0, $nbits))
          } 0..$nbits
    ];
    $$self{RANGES} = {};
    $self;
}

sub _pack_ipv4 {
    my @nums = split /\./, shift(), -1;
    return unless @nums == 4;
    for (@nums) {
        return unless /^\d{1,3}$/ and $_ <= 255;
    }
    pack("CC*", 0, @nums);
}

sub _unpack_ipv4 {
    join(".", unpack("xC*", 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*", "00" . $str).$ipv4;
}

sub _unpack_ipv6 {
    _compress_ipv6(join(":", unpack("xH*", shift) =~ /..../g)),
}

# Replace longest run of null blocks with a double colon
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 =~ s/:0{1,3}/:/g;
    $ip;
}

# Add a single IP address
sub add_ip {
    my $self = shift;
    my $ip = shift;
    $self->_init($ip) || confess "Can't determine ip format" unless %$self;
    my $start = $self->{PACK}->($ip) or confess "Bad ip address: $ip";
    my $end = $self->_add_bit($start, $self->{NBITS});
    ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
    --$$self{RANGES}{$end}   || delete $$self{RANGES}{$end};
    $self;
}

# Add a hyphenated range of IP addresses
sub add_range {
    my $self = shift;
    local $_ = shift;
    my ($ip_start, $ip_end, $crud) = split /\s*-\s*/;
    confess "Only one hyphen allowed in range" if defined $crud;
    $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";
    confess "Start IP is greater than end IP" if $start gt $end;
    $end = $self->_add_bit($end, $$self{NBITS});
    ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
    --$$self{RANGES}{$end}   || delete $$self{RANGES}{$end};
    $self;
}

# Add ranges from another Net::CIDR::Lite object
sub add_cidr {
    my $self = shift;
    my $cidr = shift;
    confess "Not a CIDR object" unless UNIVERSAL::isa($cidr, 'Net::CIDR::Lite');
    unless (%$self) {
        @$self{@fields} = @$cidr{@fields};
    }
    $$self{RANGES}{$_} += $$cidr{RANGES}{$_} for keys %{$$cidr{RANGES}};
    $self;
}

# Increment the ip address at the given bit position
# bit position is in range 1 to # of bits in ip
# where 1 is high order bit, # of bits is low order bit
sub _add_bit {
    my $self= shift;
    my $base= shift();
    my $bits= shift()-1;
    while (vec($base, $bits^7, 1)) {
        vec($base, $bits^7, 1) = 0;
        $bits--;
        return $base if  $bits < 0;
    }
    vec($base, $bits^7, 1) = 1;
    return $base;
}

# Subtract one from an ip address
sub _minus_one {
  my $self = shift;
  my $nbits = $self->{NBITS};
  my $ip = shift;
  $ip = ~$ip;
  $ip = $self->_add_bit($ip, $nbits);
  $ip = $self->_add_bit($ip, $nbits);
  $self->_add_bit(~$ip, $nbits);
}

sub find {
    my $self = shift;
    $self->prep_find unless $self->{FIND};
    return $self->bin_find(@_) unless @{$self->{FIND}} < $self->{PCT};
    my $this_ip = $self->{PACK}->(shift);
    my $ranges = $self->{RANGES};
    my $last = -1;
    for my $ip (@{$self->{FIND}}) {
        last if $this_ip lt $ip;
        $last = $ranges->{$ip};
    }
    $last > 0;
}

sub bin_find {
    my $self = shift;
    my $ip = $self->{PACK}->(shift);
    $self->prep_find unless $self->{FIND};
    my $find = $self->{FIND};
    my ($start, $end) = (0, $#$find);
    return unless $ip ge $find->[$start] and $ip lt $find->[$end];
    while ($end - $start > 0) {
        my $mid = int(($start+$end)/2);
        if ($start == $mid) {
            if ($find->[$end] eq $ip) {
                $start = $end;
            } else { $end = $start }
        } else {
            ($find->[$mid] lt $ip ? $start : $end) = $mid;
        }
    }
    $self->{RANGES}{$find->[$start]} > 0;
}

sub prep_find {
    my $self = shift;
    $self->clean;
    $self->{PCT} = shift || 20;
    my $aref = $self->{FIND} = [];
    push @$aref, $_ for sort keys %{$self->{RANGES}};
    $self;
}

sub spanner {
    Net::CIDR::Lite::Span->new(@_);
}

sub _ranges {
    sort keys %{shift->{RANGES}};
}

sub _packer { shift->{PACK} }
sub _unpacker { shift->{UNPACK} }

package Net::CIDR::Lite::Span;
use Carp qw(confess);