/usr/local/CPAN/SpamMonkey/SpamMonkey/Test/check_uridnsbl.pm


package SpamMonkey::Test::check_uridnsbl;
use strict;
use SpamMonkey::Utils;
sub init {
    my ($self, $conf) = @_;
    $conf->{settings}{uridnsbl} = [ $conf->{settings}{uridnsbl} ]
        unless ref $conf->{settings}{uridnsbl};
    $conf->{settings}{uridnsbl} = {
        map { 
            my ($name, $url, $type) = split /\s+/, $_, 3;
            $name => { url => $url, type => $type }
        } @{$conf->{settings}{uridnsbl}}
    };
    $conf->{settings}{uridnsbl_skip_domain} = { 
        map { map { $_ => 1 } split /\s+/, $_  }
        @{$conf->{settings}{uridnsbl_skip_domain}}};
}

sub test {
    my ($class, $monkey, $text_r, $bl) = @_;
    $monkey->get_uris($text_r);
    my $settings = $monkey->{conf}{settings};
    return unless my $bl_stuff= $settings->{uridnsbl}->{$bl};
    #my $hits = 0;
    my @uris = $monkey->uris;
    return unless @uris;
    while ($settings->{uridnsbl_max_domains} > 0 and 
            @uris > $settings->{uridnsbl_max_domains}) {
        splice @uris, rand(@uris),1;
    }
    URL: for (@uris) {
        my $uri = URI->new($_);
        next if $uri->isa("URI::mailto");
        for (keys %{$settings->{uridnsbl_skip_domain}}) {
            next URL if $uri->host =~ /$_\$/;
        }
        my @bits = SpamMonkey::Utils->host_to_ip($uri->host);
        return 1 unless @bits; # Dead hosts are a threat in themselves
        my $ip = join ".", (reverse(@bits), $bl_stuff->{url});
        if (SpamMonkey::Utils->rbl_check($ip, $bl_stuff->{type},
                $settings->{uridnsbl_timeout})) {
            #$hits++;
            return 1;
        }
    }
    return;
    #return (1) x $hits;
}
1;