File Coverage

blib/lib/WebService/AbuseIPDB.pm

Criterion	Covered	Total	%
statement	108	108	100.0
branch	42	42	100.0
condition	12	17	70.5
subroutine	14	14	100.0
pod	5	5	100.0
total	181	186	97.3

package WebService::AbuseIPDB;

use 5.010;
use strict;
use warnings;

# use other modules
use IO::Socket::SSL;
use REST::Client;
use Carp;
use JSON::XS;
use URI;    # The GET requests need URI-escaping

our $VERSION = '0.03_02';

sub new {
	my ($class, %opts) = @_;
	croak "Only version 2 is supported."
	  if exists $opts{ver} && 2 != $opts{ver};
	croak "No key provided." unless exists $opts{key};

	# This is weird. If you don't set the outer timeout it goes to 300.
	# If you do set the outer timeout, it sets the inner one too so it's
	# effectively doubled. Setting the inner timeout has no effect.
	my $self = {
		ua => REST::Client->new (
			{   host    => 'https://api.abuseipdb.com',
				timeout => $opts{timeout} // 20,
				agent   => "WebService::AbuseIPDB/$VERSION",

#			useragent => LWP::UserAgent->new (ssl_opts => {
#					verify_hostname => 1,
#				},
#				#timeout => $opts{timeout} // 20,
#			)
			}
		),
		retry   => $opts{retry} // 0,
		api_ver => $opts{ver}   // 2,
		key     => $opts{key},
	};
	bless ($self, $class);
	return $self;
}

sub _send_receive {
	my ($self, $meth, $path, $data) = @_;

	$path = "/api/v$self->{api_ver}/$path";
	my $ct = {'Content-type' => 'application/json'};
	my $headers = {
		Accept => 'application/json',
		Key    => $self->{key}
	};
	if ($meth eq 'GET') {
		my $u = URI->new ($path);
		$u->query_form (%$data);
		$path = $u->as_string;
	}
	my $tries_left = $self->{retry} + 1;
	while ($tries_left) {

		if ($meth eq 'GET') {
			$self->{ua}->GET ($path, $headers);
		} elsif ($meth eq 'POST') {
			$headers->{'Content-type'} = 'application/json';
			$self->{ua}->POST ($path, encode_json ($data), $headers);
		} else {
			croak "Unrecognised method '$meth'";
		}

		if ($self->{ua}->responseCode !~ /400|50./) {
			return decode_json $self->{ua}->responseContent
			  if $self->{ua}->responseHeader ('Content-type') eq
			  'application/json';
			return undef;
		}
		$tries_left--;
		warn "REST error " . $self->{ua}->responseCode;
	}

	if ($self->{ua}->responseCode > 499) {
		# Not our problem, so don't carp
		return {
			errors => [{
				status => $self->{ua}->responseCode,
				detail => $self->{ua}->responseContent //
					'Server Problem'
			}]
		};
	}

	carp "Problem with $meth $path\nData was " . encode_json ($data) .
		"\nClient warning: " .
		(	$self->{ua}->responseHeader ('Client-Warning') //
			$self->{ua}->responseContent //
			$self->{ua}->responseCode);
	return undef;
}

sub check {
	my ($self, %args) = @_;
	unless (exists $args{ip}) {
		carp "No IP in argument hash";
		return;
	}

	# Validate this here TODO
	my $data = {ipAddress => $args{ip}};
	$data->{maxAgeInDays} = $args{max_age} if exists $args{max_age};
	# TODO $data->{verbose} = 1 if $args{verbose};
	require WebService::AbuseIPDB::CheckResponse;
	return WebService::AbuseIPDB::CheckResponse->new (
		$self->_send_receive ('GET', 'check', $data));
}

sub check_block {
	my ($self, %args) = @_;
	unless (exists $args{ip}) {
		carp "No IP in argument hash";
		return;
	}

	# Validate this here TODO
	my $data = {network => $args{ip}};
	$data->{maxAgeInDays} = $args{max_age} if exists $args{max_age};
	require WebService::AbuseIPDB::CheckBlockResponse;
	return WebService::AbuseIPDB::CheckBlockResponse->new (
		$self->_send_receive ('GET', 'check-block', $data));
}

sub report {
	my ($self, %args) = @_;
	for my $mand (qw/ip categories/) {
		unless (exists $args{$mand}) {
			carp "No '$mand' key in argument hash";
			return;
		}
	}

	# More validation here
	my $data = {ip => $args{ip}};

	# Form the category string
	# More validation here too
	require WebService::AbuseIPDB::Category;
	my @categories =
	  map { WebService::AbuseIPDB::Category->new ($_) } @{$args{categories}};
	$data->{categories} = join (',', map { $_->id } @categories);

	# Trim the comment
	$data->{comment} = substr ($args{comment}, 0, 1024)
	  if defined $args{comment};

	# Run it
	require WebService::AbuseIPDB::ReportResponse;
	return WebService::AbuseIPDB::ReportResponse->new (
		$self->_send_receive ('POST', 'report', $data));
}

sub blacklist {
	my ($self, %args) = @_;
	my $data = {
		limit => 1000,
		confidenceMinimum => 75
	};

	if (exists $args{limit}) {
		unless ($args{limit} =~ /^[0-9]+$/) {
			carp "limit must be a whole number";
			return;
		}
		if ($args{limit} < 1) {
			carp "limit must be greater than zero";
			return;
		}
		$data->{limit} = $args{limit};
	}

	if (exists $args{min_abuse}) {
		unless ($args{min_abuse} =~ /^[0-9]+$/) {
			carp "min_abuse must be a whole number";
			return;
		}
		if ($args{min_abuse} < 25) {
			carp "min_abuse is $args{min_abuse} but must be greater than 24";
			return;
		}
		if ($args{min_abuse} > 100) {
			carp "min_abuse is $args{min_abuse} but must be less than 100";
			return;
		}
		$data->{confidenceMinimum} = $args{min_abuse};
	}

	require WebService::AbuseIPDB::BlacklistResponse;
	require WebService::AbuseIPDB::BlacklistMember;
	return WebService::AbuseIPDB::BlacklistResponse->new (
		$self->_send_receive ('GET', 'blacklist', $data));

}

1;

__END__