root/trunk/plagger/lib/Plagger/Plugin/Filter/URLBL.pm

Revision 60 (checked in by miyagawa, 13 years ago)

moved URLBL filter into update.fixup phase. Fixes #26

  • Property svn:keywords set to Id Revision
Line 
1 package Plagger::Plugin::Filter::URLBL;
2 use strict;
3 use base qw( Plagger::Plugin );
4
5 our $VERSION = '0.10';
6
7 use Net::DNS::Resolver;
8 use URI::Find;
9 use URI;
10
11 sub register {
12     my($self, $context) = @_;
13     $context->register_hook(
14         $self,
15         'update.fixup' => \&filter,
16     );
17 }
18
19 sub filter {
20     my($self, $context, $args) = @_;
21
22     for my $feed ($context->update->feeds) {
23         for my $entry ($feed->entries) {
24             $self->urlbl_filter($context, $entry);
25         }
26     }
27 }
28
29 sub urlbl_filter {
30     my($self, $context, $entry) = @_;
31
32     my @urls;
33     my $finder = URI::Find->new(
34         sub {
35             my($uri, $orig_uri) = @_;
36             if ($orig_uri =~ m!^https?://!) {
37                 push @urls, $uri;
38             }
39             return $orig_uri;
40         },
41     );
42
43     my $content = $entry->text;
44     $finder->find(\$content);
45
46     my $res = Net::DNS::Resolver->new;
47     my $dnsbl = $self->conf->{dnsbl};
48        $dnsbl = [ $dnsbl ] unless ref $dnsbl;
49
50     for my $url (@urls) {
51         my $uri = URI->new($url);
52         my $domain = $uri->host;
53         $domain =~ s/^www\.//;
54
55         next if $self->{__done}->{$domain}++;
56
57         for my $dns (@$dnsbl) {
58             $context->log(debug => "looking up $domain.$dns");
59             my $q = $res->search("$domain.$dns");
60             if ($q && $q->answer) {
61                 my $rate = $self->conf->{rate} || -1;
62                 $context->log(warn => "$domain.$dns found. Add rate $rate");
63                 $entry->add_rate($rate);
64             }
65         }
66     }
67 }
68
69 1;
Note: See TracBrowser for help on using the browser.