File Coverage

blib/lib/Net/Abuse/Utils.pm

Criterion	Covered	Total	%
statement	23	164	14.0
branch	0	74	0.0
condition	0	12	0.0
subroutine	8	25	32.0
pod	14	14	100.0
total	45	289	15.5

package Net::Abuse::Utils;
# ABSTRACT: Routines useful for processing network abuse

use 5.006;
use strict;
use warnings;

use Net::DNS;
use Net::Whois::IP 1.11 'whoisip_query';
use Email::Address;
use Net::IP;
# use Memoize;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
    get_asn_info get_peer_info get_as_description get_soa_contact get_ipwi_contacts
    get_rdns get_dnsbl_listing get_ip_country get_asn_country
    get_abusenet_contact is_ip get_as_company get_domain get_malware
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our $VERSION = '0.23';
$VERSION = eval $VERSION;

# memoize('_return_rr');
my @tlds;
our @RESOLVERS;

sub _reverse_ip {
    my $ip = shift;
    my $ver = Net::IP::ip_get_version($ip);
    my @parts = split( /\./, Net::IP::ip_reverse( $ip, $ver == 4 ? 32 : 128 ) );
    # strip in-addr.arp or ip6.arpa from results
    return join('.', @parts[0 .. $#parts-2]);
}

sub _return_rr {
    my $lookup  = shift;
    my $rr_type = shift;
    my $concat  = shift;

    my @result;

    my $res = Net::DNS::Resolver->new(  );
    $res->nameservers(@RESOLVERS) if @RESOLVERS;

    my $query = $res->query($lookup, $rr_type);
    if ($query) {
            foreach my $rr ($query->answer) {
                if ($rr->type eq $rr_type) {
                    if    ($rr_type eq 'TXT') {
                        push @result, $rr->txtdata;
                    }
                    elsif ($rr_type eq 'SOA') {
                        push @result, $rr->rname;
                    }
                    elsif ($rr_type eq 'PTR') {
                        push @result, $rr->ptrdname;
                    }
                    last if !$concat;
                }
            }

            if ($concat && $concat == 2) {
                return @result;
            }
            else {
                return join ' ', @result;
            }
    }

    return;
}

sub _return_unique {
    my $array_ref = shift;
    my %unique_elements;

    foreach my $element (@$array_ref) {
        $unique_elements{ $element }++;
    }

    return keys %unique_elements;
}

sub _strip_whitespace {
    my $string = shift;

    return unless $string;

    for ($string) {
        s/^\s+//;
        s/\s+$//;
    }

    return $string;
}

sub get_ipwi_contacts {
    my $ip = shift;
    my $ver = Net::IP::ip_get_version($ip);
    return unless $ver;

    my @addresses;
    my %unique_addresses;

    # work-around for the new way arin works
    # it doesn't like networks very well.
    my @bits = split(/\//,$ip);
    $ip = $bits[0] if($#bits > 0);

    my $response = whoisip_query($ip);

    # whoisip_query returns array ref if not found
    return unless ref($response) eq 'HASH';

    foreach my $field (keys %$response) {
        push @addresses, Email::Address->parse($response->{$field});
    }

    @addresses = map { $_->address } @addresses;

    return _return_unique (\@addresses);
}

sub get_asn_info {
    my $ip = shift;
    my $ver = Net::IP::ip_get_version($ip);
    return unless $ver;

    my $domain
        = ( $ver == 4 ) ? '.origin.asn.cymru.com' : '.origin6.asn.cymru.com';

    my $lookup    = _reverse_ip($ip) . $domain;
    my @origin_as = _return_rr($lookup, 'TXT', 2) or return;

    # un-comment for testing
    #push(@origin_as,'20738 | 212.67.192.0/24 | GB | ripencc | 1999-05-12');

    # 23028 | 216.90.108.0/24 | US | arin | 1998-09-25
    # 701 1239 3549 3561 7132 | 216.90.108.0/24 | US | arin | 1998-09-25

    my $smallest_netmask = 0;
    my ($smallest_prefix, %data_for_asn);

    # surely there is a better way to do this, at least the split
    # fields are stored so they don't have to be split again ;)
    for my $asn_info (@origin_as) {
        my @fields  = split /\|/, $asn_info;
        my @network = split '/', $fields[1];

        # if multiple ASNs announce the same, block they are given space
        # seperated in the first field, we just use the first
        if ($fields[0] =~ /(\d+) \d+/) {
            $fields[0] = $1;
        }

        my $asn = $fields[0];

        $data_for_asn{$fields[1]} = [@fields];

        if ($network[1] > $smallest_netmask) {
            $smallest_netmask = $network[1];
            $smallest_prefix  = $fields[1];
        }
    }

    return map { _strip_whitespace($_) } @{ $data_for_asn{$smallest_prefix} };
}

sub get_peer_info {
    my $ip = shift;

    # IPv4 only until Cymru has an IPv6 peer database
    my $ver = Net::IP::ip_get_version($ip);
    return unless $ver && $ver == 4;

    my $lookup    = _reverse_ip($ip) . '.peer.asn.cymru.com';
    my @origin_as = _return_rr($lookup, 'TXT', 2) or return;

    my $return = [];
    foreach my $as (@origin_as){
        my @peers = split(/\s\|\s?/,$as);
        my %hash = (
            prefix  => $peers[1],
            cc      => $peers[2],
            rir     => $peers[3],
            date    => $peers[4],
        );
        my @asns = split(/\s/,$peers[0]);
        foreach (@asns){
            $hash{'asn'} = $_;
            push(@$return,{
                prefix  => $peers[1],
                cc      => $peers[2],
                rir     => $peers[3],
                date    => $peers[4],
                asn     => $_,
            });
        }
    }
    return(@$return) if wantarray;
    return($return);
}

# test with 733a48a9cb49651d72fe824ca91e8d00
# http://www.team-cymru.org/Services/MHR/

sub get_malware {
    my $hash = shift;
    return unless($hash && lc($hash) =~ /^[a-z0-9]{32}$/);

    my $lookup = $hash.'.malware.hash.cymru.com';

    my $res = _return_rr($lookup, 'TXT') or return;
    my ($last_seen,$detection_rate) = split(/ /,$res);
    return({
        last_seen   => $last_seen,
        detection_rate  => $detection_rate,
    });
}

sub get_as_description {
    my $asn = shift;
    my @ASdata;

    if ( my $data = _return_rr( "AS${asn}.asn.cymru.com", 'TXT' ) ) {
        @ASdata = split( '\|', $data );
    }
    else {
        return;
    }

    return unless $ASdata[4];
    my $org = _strip_whitespace( $ASdata[4] );

    # for arin we get "HANDLE - AS Org"
    # we want to make it "HANDLE AS Org" to match other RIRs
    $org =~ s/^(\S+) - (.*)$/$1 $2/ if ( $ASdata[2] eq ' arin ' );

    return $org;
}

sub get_as_company {
    my $asn = shift;

    my $desc = get_as_description($asn);
    return unless defined($desc);

    # remove leading org id/handle/etc
    $desc =~ s/^[-_A-Z0-9]+ //;

    # remove trailing 'AS'
    $desc =~ s/AS(:? Number)?$//;

    # remove trailing 'Autonomous System'
    $desc =~ s/Autonomous System(:? Number)?$//i;

    return $desc;
}

sub get_soa_contact {
    my $ip = shift;

    my $lookup = _reverse_ip($ip) . '.in-addr.arpa';
    $lookup =~ s/^\d+\.//;

    if ( my $soa_contact = _return_rr($lookup, 'SOA') ) {
        $soa_contact =~ s/\./@/ unless $soa_contact =~ m/@/;
        return $soa_contact;
    }

    return;
}

sub get_rdns {
    my $ip = shift;
    my $ver = Net::IP::ip_get_version($ip);
    return unless $ver;

    my $suffix = ($ver == 4) ? '.in-addr.arpa' : '.ip6.arpa';
    return _return_rr( _reverse_ip($ip) . $suffix, 'PTR');
}

sub get_dnsbl_listing {
    my ($ip, $dnsbl) = @_;

    # IPv4 Only
    my $ver = Net::IP::ip_get_version($ip);
    return unless $ver && $ver == 4;

    my $lookup = join '.', _reverse_ip( $ip ), $dnsbl;

    return _return_rr($lookup, 'TXT', 1);
}

sub get_ip_country {
     my $ip = shift;
     return (get_asn_info($ip))[2];
}

sub get_asn_country {
    my $asn   = shift;
    return unless $asn =~ /^\d+$/;

    my $as_cc = (split (/\|/,_return_rr("AS${asn}.asn.cymru.com", 'TXT')))[1];
    if ($as_cc) {
        return _strip_whitespace($as_cc);
    }
    return;
}

sub get_abusenet_contact {
    my $domain = shift;
    return _return_rr("$domain.contacts.abuse.net", 'TXT', 1)
}

sub is_ip {
    my $ip = shift;
    return defined Net::IP::ip_get_version($ip);
}

sub get_domain {
    my $hostname = shift;

    @tlds = grep {!/^#/}  unless scalar @tlds;
    my @parts = reverse (split /\./, $hostname);

    if (scalar @parts == 2) {
        # just two parts, lets return it
        return join '.', @parts[1, 0];
    }
    if (grep /^\Q$parts[1].$parts[0]\E$/, @tlds) {
        #  last two parts found in tlds
        return join '.', @parts[2, 1, 0];
    } else {
        # last two not found so *host.domain.name
        return join '.', @parts[1, 0];
    }
}

1;

=pod

=head1 NAME

Net::Abuse::Utils - Routines useful for processing network abuse

=head1 VERSION

version 0.23

=head1 SYNOPSIS

    use Net::Abuse::Utils qw( :all );
    print "IP Whois Contacts: ", join( ' ', get_ipwi_contacts($ip) ), "\n";
    print "Abuse.net Contacts: ", get_abusenet_contact($domain), "\n";

=head1 DESCRIPTION

Net::Abuse::Utils provides serveral functions useful for determining
information about an IP address including contact/reporting addresses,
ASN/network info, reverse dns, and DNSBL listing status.  Functions which take
an IP accept either IPv6 or IPv4 IPs unless indicated otherwise.

=head1 CONFIGURATION

There is a C<@RESOLVERS> package variable you can use to specify name servers
different than the systems nameservers for queries from this module.  If you
intend to use Google's nameservers here, please see L
a note of caution|https://github.com/mikegrb/Net-Abuse-Utils/issues/9#issuecomment-24387435>.

=head1 FUNCTIONS

The following functions are exportable from this module.  You may import all
of them into your namespace with the C<:all> tag.

=head2 get_asn_info ( IP )

Returns a list containing (ASN, Network/Mask, CC code, RIR, modified date)
for the network announcing C.

=head2 get_peer_info ( IP )

IPv4 Only. Returns an array of hash references containing (ASN, Network/Mask,
CC code, RIR, modified date) for the peers of the network announcing C.

=head2 get_as_description ( ASN )

Returns the AS description for C.

=head2 get_as_company ( ASN )

Similiar to C but attempts to clean it up some before
returning it.

=head2 get_soa_contact( IP )

Returns the SOA contact email address for the reverse DNS /24
zone containing C.

=head2 get_ipwi_contacts( IP )

Returns a list of all email addresses found in whois information
for C with duplicates removed.

=head2 get_rdns( IP )

Returns the reverse PTR for C.

=head2 get_dnsbl_listing( IP, DNSBL zone )

IPv4 Only. Returns the listing text for C for the designated DNSBL.
C should be the zone used for looking up addresses in the
blocking list.

=head2 get_ip_country( IP )

Returns the 2 letter country code for C.

=head2 get_asn_country( ASN )

Returns the 2 letter country code for C.

=head2 get_abusenet_contact ( domain )

Returns the abuse.net listed contact email addresses for C.

=head2 is_ip ( IP )

Returns true if C looks like an IP, false otherwise.

=head2 get_domain ( IP )

Takes a hostname and attempts to return the domain name.

=head2 get_malware ( md5 )

Takes a malware md5 hash and tests it against
http://www.team-cymru.org/Services/MHR. Returns a HASHREF of last_seen and
detection_rate.

=head1 DIAGNOSTICS

Each subroutine will return undef if unsuccessful.  In the furture,
debugging output will be available.

=head1 CONFIGURATION AND ENVIRONMENT

There are two commented out lines that can be uncommented to enable Memoize
support.  I haven't yet decided whether to include this option by default.  It
may be made available in the future via an import flag to use.

=head1 DEPENDENCIES

This module makes use of the following modules:

L, L, L, and L

=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.  Please report problems to
Michael Greb ([e-mail])

Patches are welcome.

=head1 ACKNOWLEDGEMENTS

This module was inspired by Karsten M. Self's SpamTools shell scripts,
available at http://linuxmafia.com/~karsten/.

Thanks as well to my employer, Linode.com, for allowing me the time to work
on this module.

Rik Rose, Jon Honeycutt, Brandon Hale, TJ Fontaine, A. Pagaltzis, and
Heidi Greb all provided invaluable input during the development of this
module.

=head1 SEE ALSO

For a detailed usage example, please see examples/ip-info.pl included in
this module's distribution.

=head1 AUTHORS

=over 4

=item *

mikegrb

=item *

Wes Young

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Mike Greb.

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

=cut

__DATA__