Net-Whois-IANA

 view release on metacpan or  search on metacpan

lib/Net/Whois/IANA.pm  view on Meta::CPAN

package Net::Whois::IANA;
$Net::Whois::IANA::VERSION = '0.50';
use 5.006;

use strict;
use warnings;

use Carp       ();
use IO::Socket ();
use Net::CIDR  ();

use base 'Exporter';

# ABSTRACT: Net::Whois::IANA - A universal WHOIS data extractor.

our $WHOIS_PORT           = 43;
our $WHOIS_TIMEOUT        = 30;
our @DEFAULT_SOURCE_ORDER = qw(arin ripe apnic lacnic afrinic);

our %IANA;
our @IANA;

BEGIN {
    # populate the hash at compile time

    %IANA = (
        apnic   => [ [ 'whois.apnic.net', $WHOIS_PORT, $WHOIS_TIMEOUT, \&apnic_query ], ],
        ripe    => [ [ 'whois.ripe.net', $WHOIS_PORT, $WHOIS_TIMEOUT, \&ripe_query ], ],
        arin    => [ [ 'whois.arin.net', $WHOIS_PORT, $WHOIS_TIMEOUT, \&arin_query ], ],
        lacnic  => [ [ 'whois.lacnic.net', $WHOIS_PORT, $WHOIS_TIMEOUT, \&lacnic_query ], ],
        afrinic => [ [ 'whois.afrinic.net', $WHOIS_PORT, $WHOIS_TIMEOUT, \&afrinic_query ],
        ],
    );

    @IANA = sort keys %IANA;

    # accessors
    # do not use AUTOLOAD - only accept lowercase function name
    # define accessors at compile time
    my @accessors = qw{country netname descr status source server inetnum inet6num cidr abuse fullinfo};

    foreach my $accessor (@accessors) {
        no strict 'refs';
        *$accessor = sub {
            my ($self) = @_;
            die qq[$accessor is a method call] unless ref $self;
            return unless $self->{QUERY};
            return $self->{QUERY}->{$accessor};
        };
    }

    *desc = \&descr; # backward compatibility
}

our @EXPORT = qw( @IANA %IANA );

sub new ($) {

    my $proto = shift;
    my $class = ref $proto || $proto;
    my $self  = {};

    bless $self, $class;

    return $self;
}

sub whois_connect ($;$$) {
    my ( $host, $port, $timeout ) = @_;

    ( $host, $port, $timeout ) = @$host if ref $host;

    $port    ||= $WHOIS_PORT;
    $timeout ||= $WHOIS_TIMEOUT;

    #my $port    = $host_ref->[1] || $WHOIS_PORT;
    #my $timeout = $host_ref->[2] || $WHOIS_TIMEOUT;
    #my $host    = $host_ref->[0];
    my $retries = 2;
    my $sleep   = 2;

    my $sock;

    foreach my $iter ( 0 .. $retries ) {
        local $@;

        # catch errors
        eval {
            $sock = IO::Socket::INET->new(
                PeerAddr => $host,
                PeerPort => $port,
                Timeout  => $timeout,
            );
            1;
        } and return $sock;

        Carp::carp "Cannot connect to $host at port $port";
        Carp::carp $@;
        sleep $sleep unless $iter == $retries;    # avoid the last sleep
    }

lib/Net/Whois/IANA.pm  view on Meta::CPAN

    $self->init_query(%params);
    $self->{QUERY} = {};

    for my $source_name (@DEFAULT_SOURCE_ORDER) {
        print STDERR "Querying $source_name ...\n" if $params{-debug};
        my $sock = $self->source_connect($source_name)
          || Carp::carp "Connection failed to $source_name." && next;
        my %query = $self->{query_sub}( $sock, $params{-ip} );

        next unless keys %query;
        do { Carp::carp "Warning: permission denied at $source_name server $self->{whois_host}\n"; next }
          if $query{permission} && $query{permission} eq 'denied';
        $query{server} = uc $source_name;
        $self->{QUERY} = { post_process_query(%query) };

        return $self->{QUERY};
    }

    return {};
}

sub default_query ($$) {

    return arin_query(@_);
}

sub ripe_read_query ($$) {

    my ( $sock, $ip ) = @_;

    my %query = ( fullinfo => '' );
    print $sock "-r $ip\n";
    while (<$sock>) {
        $query{fullinfo} .= $_;
        close $sock and return ( permission => 'denied' ) if /ERROR:201/;
        next if ( /^(\%|\#)/ || !/\:/ );
        s/\s+$//;
        my ( $field, $value ) = split( /:/, $_, 2 );
        $value =~ s/^\s+//;
        $query{ lc($field) } .= ( $query{ lc($field) } ? ' ' : '' ) . $value;
    }
    close $sock;
    return %query;
}

sub ripe_process_query (%) {

    my %query = @_;

    if (
        ( defined $query{remarks} && $query{remarks} =~ /The country is really world wide/ )
        || ( defined $query{netname}
            && $query{netname} =~ /IANA-BLK/ )
        || ( defined $query{netname}
            && $query{netname} =~ /AFRINIC-NET-TRANSFERRED/ )
        || ( defined $query{country}
            && $query{country} =~ /world wide/ )
    ) {
        return ();
    }
    elsif ( !$query{inet6num} && !$query{inetnum} ) {
        return ();
    }
    else {
        $query{permission} = 'allowed';
        $query{cidr} = [ Net::CIDR::range2cidr( uc( $query{inet6num} || $query{inetnum} ) ) ];
    }
    return %query;
}

sub ripe_query ($$) {
    my ( $sock, $ip ) = @_;

    my %query = ripe_read_query( $sock, $ip );
    return () unless defined $query{country};
    return ripe_process_query(%query);
}

sub apnic_read_query ($$) {
    my ( $sock, $ip ) = @_;

    my %query = ( fullinfo => '' );
    my %tmp;
    print $sock "-r $ip\n";
    my $skip_block = 0;
    while (<$sock>) {
        $query{fullinfo} .= $_;
        close $sock and return ( permission => 'denied' ) if /^\%201/;
        if (m{^\%}) {

            # Always skip 0.0.0.0 data
            # It looks like:
            # % Information related to '0.0.0.0 - 255.255.255.255'
            if (m{^\%.*0\.0\.0\.0\s+}) {
                $skip_block = 1;
                next;
            }
            $skip_block = 0;
            next;
        }
        next if $skip_block;
        next if ( !/\:/ );
        s/\s+$//;
        my ( $field, $value ) = split( /:/, $_, 2 );
        $value =~ s/^\s+//;
        if ( $field =~ /^inet6?num$/ ) {
            next if $value =~ m{0\.0\.0\.0\s+};
            %tmp             = %query;
            %query           = ();
            $query{fullinfo} = $tmp{fullinfo};
        }
        my $lc_field = lc($field);
        next if $lc_field eq 'country' && defined $query{$lc_field};
        $query{$lc_field} .= ( $query{$lc_field} ? ' ' : '' ) . $value;
    }
    close $sock;
    for ( keys %tmp ) {
        $query{$_} = $tmp{$_} if !defined $query{$_};
    }
    return %query;
}

sub apnic_process_query (%) {
    my %query = @_;

    if (
        ( defined $query{remarks} && $query{remarks} =~ /address range is not administered by APNIC|This network in not allocated/ )
        || ( defined $query{descr}
            && $query{descr} =~ /not allocated to|by APNIC|placeholder reference/i )
    ) {
        return ();
    }
    elsif ( !$query{inet6num} && !$query{inetnum} ) {
        return ();
    }
    else {
        $query{permission} = 'allowed';
        $query{cidr} = [ Net::CIDR::range2cidr( uc( $query{inet6num} || $query{inetnum} ) ) ];
    }

    return %query;
}

sub apnic_query ($$) {
    my ( $sock, $ip ) = @_;

    my %query = apnic_read_query( $sock, $ip );
    return apnic_process_query(%query);
}

sub arin_read_query ($$) {
    my ( $sock, $ip ) = @_;

    my %query = ( fullinfo => '' );
    my %tmp = ();

    print $sock "+ $ip\n";
    while (<$sock>) {
        $query{fullinfo} .= $_;
        close $sock and return ( permission => 'denied' ) if /^\#201/;
        return () if /no match found for/i;
        next if ( /^\#/ || !/\:/ );
        s/\s+$//;
        my ( $field, $value ) = split( /:/, $_, 2 );
        $value =~ s/^\s+//;
        if (   $field eq 'OrgName'
            || $field eq 'CustName' ) {
            %tmp             = %query;
            %query           = ();
            $query{fullinfo} = $tmp{fullinfo};
        }
        $query{ lc($field) } .= ( $query{ lc($field) } ? ' ' : '' ) . $value;
    }
    close $sock;

    $query{orgname} = $query{custname} if defined $query{custname};

    for ( keys %tmp ) {
        $query{$_} = $tmp{$_} unless defined $query{$_};
    }

    return %query;
}

sub arin_process_query (%) {
    my %query = @_;

    return ()
      if $query{orgid} && $query{orgid} =~ /^\s*RIPE|LACNIC|APNIC|AFRINIC\s*$/;

    $query{permission} = 'allowed';
    $query{descr}      = $query{orgname};
    $query{remarks}    = $query{comment};
    $query{status}     = $query{nettype};
    $query{inetnum}    = $query{netrange};
    $query{source}     = 'ARIN';
    if ( defined $query{cidr} && $query{cidr} =~ /\,/ ) {
        $query{cidr} = [ split( /\s*\,\s*/, $query{cidr} ) ];

lib/Net/Whois/IANA.pm  view on Meta::CPAN

        close $sock
          and return ( permission => 'denied' )
          if /^\%201/ || /^\% Query rate limit exceeded/ || /^\% Not assigned to LACNIC/ || /\% Permission denied/;
        if (/^\% (\S+) resource:/) {
            my $srv = $1;
            close $sock and return () if $srv !~ /lacnic|brazil/i;
        }
        next if ( /^\%/ || !/\:/ );
        s/\s+$//;
        my ( $field, $value ) = split( /:/, $_, 2 );
        $value =~ s/^\s+//;
        next if $field eq 'country' && $query{country};
        $query{ lc($field) } .= ( $query{ lc($field) } ? ' ' : '' ) . $value;
    }
    close $sock;
    return %query;
}

sub lacnic_process_query (%) {
    my %query = @_;

    $query{permission} = 'allowed';
    $query{descr}      = $query{owner};
    $query{netname}    = $query{ownerid};
    $query{source}     = 'LACNIC';
    if ( $query{inetnum} ) {
        $query{cidr}    = $query{inetnum};
        $query{inetnum} = ( Net::CIDR::cidr2range( $query{cidr} ) )[0];
    }
    unless ( $query{country} ) {
        if ( $query{nserver} && $query{nserver} =~ /\.(\w\w)$/ ) {
            $query{country} = uc $1;
        }
        elsif ( $query{descr} && $query{descr} =~ /\s(\w\w)$/ ) {
            $query{country} = uc $1;
        }
        else {
            return ();
        }
    }
    return %query;
}

sub lacnic_query ($$) {
    my ( $sock, $ip ) = @_;

    my %query = lacnic_read_query( $sock, $ip );

    return lacnic_process_query(%query);
}

*afrinic_read_query = *apnic_read_query;

sub afrinic_process_query (%) {
    my %query = @_;

    return ()
      if defined $query{remarks} && $query{remarks} =~ /country is really worldwide/
      or defined $query{descr}   && $query{descr} =~ /Here for in-addr\.arpa authentication/;

    if ( !$query{inet6num} && !$query{inetnum} ) {
        return ();
    }

    $query{permission} = 'allowed';
    $query{cidr} =
      [ Net::CIDR::range2cidr( uc( $query{inet6num} || $query{inetnum} ) ) ];
    return %query;
}

sub afrinic_query ($$) {
    my ( $sock, $ip ) = @_;

    my %query = afrinic_read_query( $sock, $ip );

    return afrinic_process_query(%query);
}

sub is_mine ($$;@) {
    my ( $self, $ip, @cidr ) = @_;

    return 0 unless is_valid_ip($ip);
    if ( !scalar @cidr ) {
        my $out = $self->cidr();
        @cidr = @$out if ref $out;
    }

    @cidr = map {
        my @dots = ( split /\./ );
        my $pad = '.0' x ( 4 - @dots );
        s|(/.*)|$pad$1|;
        $_;
      }
      map  { split(/\s+/) }
      grep { defined $_ } @cidr;

    return Net::CIDR::cidrlookup( $ip, @cidr );
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Net::Whois::IANA - Net::Whois::IANA - A universal WHOIS data extractor.

=head1 VERSION

version 0.50

=head1 SYNOPSIS

  use Net::Whois::IANA;
  my $ip = '132.66.16.2';
  my $iana = Net::Whois::IANA->new;
  $iana->whois_query(-ip=>$ip);
  print "Country: " , $iana->country()            , "\n";
  print "Netname: " , $iana->netname()            , "\n";
  print "Descr: "   , $iana->descr()              , "\n";
  print "Status: "  , $iana->status()             , "\n";
  print "Source: "  , $iana->source()             , "\n";
  print "Server: "  , $iana->server()             , "\n";