File Coverage

blib/lib/LWPx/ParanoidHandler.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch	2	2	100.0
condition	3	6	50.0
subroutine	8	8	100.0
pod	1	1	100.0
total	46	49	93.8

package LWPx::ParanoidHandler;
use strict;
use warnings;
use 5.008008;
our $VERSION = '0.07';
use parent qw/Exporter/;
use Net::DNS::Paranoid;

our @EXPORT = qw/make_paranoid/;

sub make_paranoid {
    my ($ua, $paranoid) = @_;
    $ua->add_handler(request_send => _paranoid_handler($paranoid));
}

sub _paranoid_handler {
    my ($paranoid) = @_;
    $paranoid ||= Net::DNS::Paranoid->new();

    sub {
        my ($request, $ua, $h) = @_;
        $request->{_time_begin} ||= time();

        my $host = $request->uri->host;
        my ($addrs, $errmsg) = $paranoid->resolve($host, $request->{_time_begin});
        if ($errmsg) {
            my $err_res = HTTP::Response->new(403, "Unauthorized access to blocked host($errmsg)");
            $err_res->request($request);
            $err_res->header("Client-Warning" => "Internal response");
            $err_res->header("Content-Type" => "text/plain");
            $err_res->content("403 Unauthorized access to blocked host\n");
            return $err_res;
        }
        return; # fallthrough
    }
}

1;
__END__