239 lines
7.4 KiB
Perl
239 lines
7.4 KiB
Perl
|
package Zonemaster::Engine::ASNLookup;
|
||
|
|
|
||
|
|
use v5.16.0;
|
||
|
|
use warnings;
|
||
|
|
|
||
|
|
use version; our $VERSION = version->declare( "v1.0.11" );
|
||
|
|
|
||
|
|
use Zonemaster::Engine;
|
||
|
|
use Zonemaster::Engine::Util qw( name );
|
||
|
|
use Zonemaster::Engine::Nameserver;
|
||
|
|
use Zonemaster::Engine::Profile;
|
||
|
|
|
||
|
|
use IO::Socket;
|
||
|
|
use IO::Socket::INET;
|
||
|
|
use Net::IP::XS;
|
||
|
|
use Scalar::Util qw( looks_like_number );
|
||
|
|
|
||
|
|
our @db_sources;
|
||
|
|
our $db_style;
|
||
|
|
|
||
|
|
sub get_with_prefix {
|
||
|
|
my ( $class, $ip ) = @_;
|
||
|
|
|
||
|
|
if ( not @db_sources ) {
|
||
|
|
$db_style = Zonemaster::Engine::Profile->effective->get( q{asn_db.style} );
|
||
|
|
my %db_sources = %{ Zonemaster::Engine::Profile->effective->get( q{asn_db.sources} ) };
|
||
|
|
@db_sources = map { name( $_ ) } @{ $db_sources{ $db_style } };
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( not ref( $ip ) or not $ip->isa( 'Net::IP::XS' ) ) {
|
||
|
|
$ip = Net::IP::XS->new( $ip );
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( not @db_sources ) {
|
||
|
|
die "ASN database sources undefined";
|
||
|
|
}
|
||
|
|
|
||
|
|
my ( $asnref, $prefix, $raw, $ret_code );
|
||
|
|
|
||
|
|
if ( $db_style eq q{cymru} ) {
|
||
|
|
( $asnref, $prefix, $raw, $ret_code ) = _cymru_asn_lookup($ip);
|
||
|
|
}
|
||
|
|
elsif ( $db_style eq q{ripe} ) {
|
||
|
|
( $asnref, $prefix, $raw, $ret_code ) = _ripe_asn_lookup($ip);
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
if ( not $db_style ) {
|
||
|
|
die "ASN database style undefined";
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
die "ASN database style value '$db_style' is illegal";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
map { looks_like_number( $_ ) || die "ASN lookup value isn't numeric: '$_'" } @$asnref;
|
||
|
|
|
||
|
|
return ( $asnref, $prefix, $raw, $ret_code );
|
||
|
|
|
||
|
|
} ## end sub get_with_prefix
|
||
|
|
|
||
|
|
sub _cymru_asn_lookup {
|
||
|
|
my $ip = shift;
|
||
|
|
my @asns = ();
|
||
|
|
|
||
|
|
my $db_source_nb = 0;
|
||
|
|
foreach my $db_source ( @db_sources ) {
|
||
|
|
Zonemaster::Engine->logger->add( ASN_LOOKUP_SOURCE => { name => $db_source } );
|
||
|
|
my $reverse = $ip->reverse_ip;
|
||
|
|
my $domain = $db_source->string;
|
||
|
|
my $pair = {
|
||
|
|
'in-addr.arpa.' => "origin.$domain",
|
||
|
|
'ip6.arpa.' => "origin6.$domain",
|
||
|
|
};
|
||
|
|
$db_source_nb++;
|
||
|
|
|
||
|
|
foreach my $root ( keys %{$pair} ) {
|
||
|
|
if ( $reverse =~ s/$root/$pair->{$root}/ix ) {
|
||
|
|
my $p = Zonemaster::Engine->recurse( $reverse, 'TXT' );
|
||
|
|
|
||
|
|
if ( $p ) {
|
||
|
|
if ( $p->rcode eq q{NXDOMAIN} ) {
|
||
|
|
if ( $p->get_records( 'SOA', 'authority' ) and scalar $p->get_records( 'SOA', 'authority' ) == 1 and ($p->get_records( 'SOA', 'authority' ))[0]->owner eq name( $db_source ) ) {
|
||
|
|
return \@asns, undef, q{}, q{EMPTY_ASN_SET};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
elsif ( $p->rcode eq q{NOERROR} ) {
|
||
|
|
if ( $p->answer ) {
|
||
|
|
my @rr = $p->get_records( 'TXT', 'answer' );
|
||
|
|
|
||
|
|
if ( @rr ) {
|
||
|
|
my $max_length = 0;
|
||
|
|
my @fields;
|
||
|
|
my $str;
|
||
|
|
|
||
|
|
foreach my $rr ( @rr ) {
|
||
|
|
my $_str = $rr->txtdata;
|
||
|
|
my @_fields = split( /[ ][|][ ]?/x, $_str );
|
||
|
|
|
||
|
|
next if scalar @_fields <= 1;
|
||
|
|
return \@asns, undef, q{}, q{ERROR_ASN_DATABASE} unless Net::IP::XS->new( $_fields[1] )->overlaps( $ip );
|
||
|
|
|
||
|
|
my @_asns = split( /\s+/x, $_fields[0] );
|
||
|
|
my $_prefix_length = ($_fields[1] =~ m!^.*[/](.*)!x)[0];
|
||
|
|
if ( $_prefix_length > $max_length ) {
|
||
|
|
$str = $_str;
|
||
|
|
@asns = @_asns;
|
||
|
|
@fields = @_fields;
|
||
|
|
$max_length = $_prefix_length;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( @fields ) {
|
||
|
|
if ( Net::IP::XS->new( $fields[1] )->overlaps( $ip ) ) {
|
||
|
|
return \@asns, Net::IP::XS->new( $fields[1] ), $str, q{AS_FOUND}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return \@asns, undef, q{}, q{EMPTY_ASN_SET};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return \@asns, undef, q{}, q{ERROR_ASN_DATABASE};
|
||
|
|
}
|
||
|
|
|
||
|
|
return \@asns, undef, q{}, q{EMPTY_ASN_SET};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( $db_source_nb == scalar @db_sources ) {
|
||
|
|
return \@asns, undef, q{}, q{ERROR_ASN_DATABASE};
|
||
|
|
}
|
||
|
|
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} ## end foreach my $db_source ( @db_sources )
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _ripe_asn_lookup {
|
||
|
|
my $ip = shift;
|
||
|
|
my @asns = ();
|
||
|
|
|
||
|
|
my $db_source_nb = 0;
|
||
|
|
foreach my $db_source ( @db_sources ) {
|
||
|
|
$db_source_nb++;
|
||
|
|
my $socket = IO::Socket::INET->new( PeerAddr => $db_source->string,
|
||
|
|
PeerPort => q{43},
|
||
|
|
Proto => q{tcp} );
|
||
|
|
unless ( $socket ) {
|
||
|
|
if ( $db_source_nb == scalar @db_sources ) {
|
||
|
|
return \@asns, undef, q{}, q{ERROR_ASN_DATABASE};
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
};
|
||
|
|
|
||
|
|
printf $socket "-F -M %s\n", $ip->short();
|
||
|
|
|
||
|
|
my $data;
|
||
|
|
my $str;
|
||
|
|
my $has_answer = 0;
|
||
|
|
while ( defined ($data = <$socket>) ) {
|
||
|
|
$has_answer = 1;
|
||
|
|
chop $data;
|
||
|
|
if ( $data !~ /^%/x and $data !~ /^\s*$/x ) {
|
||
|
|
$str = $data;
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$socket->close();
|
||
|
|
if ( not $has_answer ) {
|
||
|
|
if ( $db_source_nb == scalar @db_sources ) {
|
||
|
|
return \@asns, undef, q{}, q{ERROR_ASN_DATABASE};
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
elsif ( $str ) {
|
||
|
|
my @fields = split( /\s+/x, $str );
|
||
|
|
my @asns = split( '/', $fields[0] );
|
||
|
|
return \@asns, Net::IP::XS->new( $fields[1] ), $str, q{AS_FOUND};
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return \@asns, undef, q{}, q{EMPTY_ASN_SET};
|
||
|
|
}
|
||
|
|
} ## end foreach my $db_source ( @
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get {
|
||
|
|
my ( $class, $ip ) = @_;
|
||
|
|
|
||
|
|
my ( $asnref, $prefix, $raw, $ret_code ) = $class->get_with_prefix( $ip );
|
||
|
|
|
||
|
|
if ( $asnref ) {
|
||
|
|
return @{$asnref};
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
Zonemaster::Engine::ASNLookup - do lookups of ASNs for IP addresses
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
my ( $asnref, $prefix, $raw, $ret_code ) = Zonemaster::Engine::ASNLookup->get_with_prefix( '8.8.4.4' );
|
||
|
|
my $asnref = Zonemaster::Engine::ASNLookup->get( '192.168.0.1' );
|
||
|
|
|
||
|
|
=head1 FUNCTION
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item get($addr)
|
||
|
|
|
||
|
|
As L<get_with_prefix()>, except it returns only the list of AS numbers
|
||
|
|
for the address, if any.
|
||
|
|
|
||
|
|
=item get_with_prefix($addr)
|
||
|
|
|
||
|
|
Takes a string (or a L<Net::IP::XS> object) with a single IP address, and
|
||
|
|
does a lookup in either: a) Cymru-style DNS zone or b) RIPE whois server,
|
||
|
|
depending on L<Zonemaster::Engine::Profile> setting "asn_db{style}".
|
||
|
|
|
||
|
|
Returns a list of a reference to a list of AS numbers, a Net::IP::XS object
|
||
|
|
of the covering prefix for that AS, a string of the raw query, and a string
|
||
|
|
of the return code for that query.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|