asused 3.72-12 / usr / share / perl5 / NCC / RipeDelegations.pm

# Copyright (c) 2001						RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#------------------------------------------------------------------------------
# Module Header
# Filename          : NCC::RipeDelegations.pm
# Author            : Timur I. Bakeyev <timur@ripe.net>
# Date              : 200104
# Description       : Provides OO interface to the list of IP delegations from IANA
# Language Version  : Perl 5.6.0
# OSs Tested        : BSD/OS 3.1
# Command Line      : -
# Input Files       : -
# Output Files      : -
# External Programs : -
# Problems          : -
# Comments          : 
# $Id: RipeDelegations.pm,v 1.7 2001/09/10 15:47:23 timur Exp $
#------------------------------------------------------------------------------

package NCC::RipeDelegations;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK @DELEGATIONS);

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(@DELEGATIONS);
	
$VERSION = '0.04';

use ipv4pack;

# XXX: This should be separate module!
my $OCTET = "(?:\\d|[1-9]\\d|1\\d\\d|2[0-4]\\d|25[0-5])";
my $IP = "(?:$OCTET(?:\\.$OCTET){0,3})";
my $IP_RANGE = "$IP\\s*\\-\\s*$IP";
my $IP_RANGE_RE = "($IP) *\\- *($IP)";

# Location of the external delegations data file(RIPE)
my $delegations = '/ncc/ip-reg/delegations';

####################################################################
#  DESCRIPTION: Constructor
#        INPUT: None
#       OUTPUT: New instance of the class or undef
# SIDE EFFECTS: None
####################################################################

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my %param = @_;
    my $self = { };
    
    bless $self, $class;
    # Don't return object, if failed to initialiaze
    return unless($self->_init());

    return $self;
}

####################################################################
#  DESCRIPTION: Read RIPE delegations list and put it into the hash
#        INPUT: None
#       OUTPUT: 1, if initialization was successful
#		0, otherwise
# SIDE EFFECTS: None
####################################################################

sub _init {
    my $self = shift;
    # List of delegated ranges
    my @delegations = ();
    # Try to use external data
    if(open(FILE, $delegations)) {
	while(<FILE>) {
	    # Skip comments
    	    next if(/^#.*/);
	    # Skip empty lines
	    next if(/^\s*$/);
	    # Extract the range
	    push(@delegations, $1) if(/\"(.*?\s*\-\s*.*?)\"/);
	}
	close(FILE);
    }
    # Fall back to bundled list
    else {
	# Get the initial pozition of in the DATA stream
	my $filepos = tell(DATA);
	# Load list of ranges
	while(<DATA>) {
	    # Skip comments
	    next if(/^#.*/);
	    # Skip empty lines
	    next if(/^\s*$/);
	    # Extract the range
	    push(@delegations, $1) if(m%^\s*($IP_RANGE)\s*$%);
	}
	# Rewind to the begining of the stream
	seek(DATA, $filepos, 0);
    }
    
    # Try to normalize obtained ranges
    foreach my $range (@delegations) {
	# Normalize the range
	my($inetnum, $respond) = normalizerange($range);
	# If the range is ok, we'll keep it
	if($respond == $O_OK && $inetnum) {
	    my($ip1, $ip2) = ($inetnum =~ m%^$IP_RANGE_RE$%);
	    # Skip, if didn't extract quads
	    next unless($ip1 && $ip2);
	    my $int1 = quad2int($ip1);
	    my $int2 = quad2int($ip2);
	    # Skip bogus ranges
	    next unless($int1 >= 0 && $int2 >= 0 && $int2 >= $int1);
	    # Store range boundaries in array
	    $self->{'inetnum'}{$inetnum} = [$int1, $int2];
	}
    }
    # Make a sorted list of delegations
    @{$self->{'DELEGATIONS'}} = sort {
    	    $self->{'inetnum'}{$a}[0] <=> $self->{'inetnum'}{$b}[0] ||
    	    $self->{'inetnum'}{$a}[1] <=> $self->{'inetnum'}{$b}[1]
	} keys(%{$self->{'inetnum'}});

    # Success
    return 1;
}

####################################################################
#  DESCRIPTION: Returns a sorted array of RIPE delegations
#        INPUT: None
#       OUTPUT: Array or ref to array of delegations
# SIDE EFFECTS: None
####################################################################

sub getDelegations {
    my $self = shift;
    
    return wantarray() ? @{$self->{'DELEGATIONS'}} : $self->{'DELEGATIONS'};
}

####################################################################
#  DESCRIPTION: Check if a range one of the RIPE delegations
#        INPUT: IP range
#       OUTPUT: 1, if range is a RIPE delegation, 0 - otherwise
# SIDE EFFECTS: None
####################################################################

sub isDelegation {
    my $self = shift;
    my($in) = @_;
    
    # Normalize the range
    my($inetnum, $respond) = normalizerange($in);
    # Return false if passed range was invalid
    return 0 unless($respond == $O_OK);
    # Return true, if the range part of the delegation
    return (defined($self->{'inetnum'}{$inetnum})) ? 1 : 0;
}

####################################################################
#  DESCRIPTION: Check, if a range is part of one of the delegations
#        INPUT: IP range
#       OUTPUT: 1, if range a part of delegation, 0 - otherwise
# SIDE EFFECTS: None
####################################################################

sub Contains {
    my $self = shift;
    my($in) = @_;
    
    # Normalize the range
    my($inetnum, $respond) = normalizerange($in);
    # Return false if passed range was invalid
    return 0 unless($respond == $O_OK);
    # Split the range into quads
    my($ip1, $ip2) = ($inetnum =~ m%^$IP_RANGE_RE$%);
    # Skip, if didn't extract quads
    return 0 unless($ip1 && $ip2);
    my $int1 = quad2int($ip1);
    my $int2 = quad2int($ip2);
    # Skip bogus ranges
    return 0 unless($int1 >= 0 && $int2 >= 0 && $int2 >= $int1);

    # Perform a lookup
    foreach my $range (@{ $self->getDelegations() }) {
	# Get range boundarues
	my($start, $end) = @{ $self->{'inetnum'}{$range} };
	# Return true, if passed range within the delegated range
	return 1 if($int1 >= $start && $int2 <= $end);
    }
    return 0;
}

####################################################################
#  DESCRIPTION: Main 
#        INPUT: None
#       OUTPUT: None
# SIDE EFFECTS: Initialze global array @DELEGATIONS
####################################################################

@DELEGATIONS = new NCC::RipeDelegations()->getDelegations();

1;

=head1 NAME

NCC::RipeDelegations - OO interface to the list of IP delegations from IANA

=head1 SYNOPSIS

  use NCC::RipeDelegations;

=head1 DESCRIPTION

This module provides interface to the list of IP delegations to RIPE NCC from IANA.

=head1 AUTHOR

Timur Bakeyev, timur@ripe.net

=head1 SEE ALSO

perl(1).

=cut

__DATA__
# List of delegated to RIPE IP ranges
24.132.0.0 - 24.132.255.255
24.133.0.0 - 24.135.255.255
62.0.0.0 - 62.255.255.255
80.0.0.0 - 80.255.255.255
81.0.0.0 - 81.255.255.255
82.0.0.0 - 82.255.255.255
145.0.0.0 - 145.127.255.255
146.188.0.0 - 146.188.255.255
192.106.0.0 - 192.106.255.255
192.162.0.0 - 192.162.255.255
192.164.0.0 - 192.167.255.255
193.0.0.0 - 193.255.255.255
194.0.0.0 - 194.255.255.255
195.0.0.0 - 195.255.255.255
196.200.0.0 - 196.207.255.255
212.0.0.0 - 212.255.255.255
213.0.0.0 - 213.255.255.255
217.0.0.0 - 217.255.255.255