File Coverage

blib/lib/Plack/Middleware/DNSBL.pm
Criterion Covered Total %
statement 3 3 100.0
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 4 4 100.0


line stmt bran cond sub pod time code
1             package Plack::Middleware::DNSBL;
2 1     1   19383 use parent qw(Plack::Middleware);
  1         282  
  1         5  
3             use strict; use warnings;
4              
5             our $VERSION = '0.03';
6              
7             use Carp ();
8             use Plack::Util::Accessor qw(cache cache_time resolver blacklists blacklisted);
9             use Net::DNS::Resolver;
10              
11             sub prepare_app {
12             my ($self) = @_;
13             unless ($self->resolver) {
14             $self->resolver( Net::DNS::Resolver->new );
15             }
16              
17             unless ($self->blacklisted && ref $self->blacklisted eq 'CODE') {
18             $self->blacklisted(sub {
19             [ 500, [ 'Content-Type' => 'text/plain' ], [ '' ] ];
20             });
21             }
22              
23             unless ($self->blacklists && ref $self->blacklists eq 'HASH') {
24             Carp::carp("'blacklists' option must contain a HASHREF value");
25             $self->blacklists(+{ });
26             }
27              
28             unless ($self->cache_time) {
29             $self->cache_time('86400');
30             }
31             }
32              
33             sub query {
34             my ($self, $address) = @_;
35             my $response = $self->resolver->send($address)
36             or return;
37              
38             # A Record = black listed
39             foreach my $record ($response->answer) {
40             return 1 if $record->type eq 'A';
41             }
42             }
43              
44             sub is_blacklisted {
45             my ($self, $ip, $port) = @_;
46             my $reversed = _reverse_ip($ip);
47              
48             # Check if we have a cached response
49             if ($self->cache && (my $cached = $self->cache->get("dnsbl:$reversed"))) {
50             return @$cached;
51             }
52              
53             my ( $blacklisted, $blacklist );
54             foreach (keys %{ $self->blacklists }) {
55             my $address = $self->blacklists->{$_};
56              
57             $address =~ s/\$ip/$reversed/g;
58             $address =~ s/\$port/$port/g;
59              
60             if ($self->query($address)) {
61             $blacklist = $_;
62             $blacklisted = 1;
63             last;
64             }
65             }
66              
67             # Caches our result
68             if ($self->cache) {
69             $self->cache->set("dnsbl:$reversed" => [ $blacklisted, $blacklist, 1 ],
70             $self->cache_time);
71             }
72              
73             return ( $blacklisted, $blacklist, 0 );
74             }
75              
76             sub call {
77             my ($self, $env) = @_;
78             if (_is_ipv4($env->{REMOTE_ADDR})) {
79             # Check if this IP is blacklisted
80             my ($blacklisted, $blacklist, $is_cached)
81             = $self->is_blacklisted($env->{REMOTE_ADDR}, $env->{SERVER_PORT});
82              
83             # If it's blacklisted, call the callback and return it's return value
84             if ($blacklisted) {
85             $env->{DNSBL_BLACKLISTED} = 1;
86             $env->{DNSBL_BLACKLIST} = $blacklist;
87             $env->{DNSBL_IS_CACHED} = $is_cached;
88              
89             return $self->blacklisted->($env, $blacklist, $is_cached);
90             }
91             }
92              
93             return $self->app->($env);
94             }
95              
96              
97             # Helper functions
98             sub _is_ipv4 { shift =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/ }
99             sub _reverse_ip { join '.', reverse split /\./, shift }
100              
101             1;
102             __END__