File Coverage

blib/lib/Plack/Middleware/DNSBL.pm

Criterion	Covered	Total	%
statement	18	61	29.5
branch	0	22	0.0
condition	0	9	0.0
subroutine	6	13	46.1
pod	2	4	50.0
total	26	109	23.8

package Plack::Middleware::DNSBL;

use strict;
use warnings;

use parent qw(Plack::Middleware);

our $VERSION = '0.0304';

use Carp ();
use Plack::Util::Accessor qw(cache cache_time resolver blacklists blacklisted);
use Net::DNS::Resolver;

sub prepare_app {
	my ($self) = @_;
	unless ($self->resolver) {
		$self->resolver( Net::DNS::Resolver->new );
	}

	unless ($self->blacklisted && ref $self->blacklisted eq 'CODE') {
		$self->blacklisted(sub {
			[ 500, [ 'Content-Type' => 'text/plain' ], [ '' ] ];
		});
	}

	unless ($self->blacklists && ref $self->blacklists eq 'HASH') {
		Carp::carp("'blacklists' option must contain a HASHREF value");
		$self->blacklists(+{ });
	}

	unless ($self->cache_time) {
		$self->cache_time('86400');
	}
}

sub query {
	my ($self, $address) = @_;
	my $response = $self->resolver->send($address)
		or return;

	# A Record = black listed
	foreach my $record ($response->answer) {
		return 1 if $record->type eq 'A';
	}
}

sub is_blacklisted {
	my ($self, $ip, $port) = @_;
	my $reversed = _reverse_ip($ip);

	# Check if we have a cached response
	if ($self->cache && (my $cached = $self->cache->get("dnsbl:$reversed"))) {
		return @$cached;
	}

	my ( $blacklisted, $blacklist );
	foreach (keys %{ $self->blacklists }) {
		my $address = $self->blacklists->{$_};

		$address =~ s/\$ip/$reversed/g;
		$address =~ s/\$port/$port/g;

		if ($self->query($address)) {
			$blacklist   = $_;
			$blacklisted = 1;
			last;
		}
	}

	# Caches our result
	if ($self->cache) {
		$self->cache->set("dnsbl:$reversed" => [ $blacklisted, $blacklist, 1 ],
			$self->cache_time);
	}

	return ( $blacklisted, $blacklist, 0 );
}

sub call {
	my ($self, $env) = @_;
	if (_is_ipv4($env->{REMOTE_ADDR})) {
		# Check if this IP is blacklisted
		my ($blacklisted, $blacklist, $is_cached)
			= $self->is_blacklisted($env->{REMOTE_ADDR}, $env->{SERVER_PORT});

		# If it's blacklisted, call the callback and return it's return value
		if ($blacklisted) {
			$env->{DNSBL_BLACKLISTED} = 1;
			$env->{DNSBL_BLACKLIST} = $blacklist;
			$env->{DNSBL_IS_CACHED} = $is_cached;

			return $self->blacklisted->($env, $blacklist, $is_cached);
		}
	}

	return $self->app->($env);
}


# Helper functions
sub _is_ipv4    { shift =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/ }
sub _reverse_ip { join '.', reverse split /\./, shift   }

1;
__END__