IkiWiki/Plugin/blogspam.pm

   1 #!/usr/bin/perl
   2 package IkiWiki::Plugin::blogspam;
   3
   4 use warnings;
   5 use strict;
   6 use IkiWiki 3.00;
   7 require RPC::XML;
   8 require RPC::XML::Client;
   9
  10 my $defaulturl='http://test.blogspam.net:8888/';
  11
  12 sub import {
  13         hook(type => "getsetup", id => "blogspam",  call => \&getsetup);
  14         hook(type => "checkcontent", id => "blogspam", call => \&checkcontent);
  15 }
  16
  17 sub getsetup () {
  18         return
  19                 plugin => {
  20                         safe => 1,
  21                         rebuild => 0,
  22                 },
  23                 blogspam_pagespec => {
  24                         type => 'pagespec',
  25                         example => 'postcomment(*)',
  26                         description => 'PageSpec of pages to check for spam',
  27                         link => 'ikiwiki/PageSpec',
  28                         safe => 1,
  29                         rebuild => 0,
  30                 },
  31                 blogspam_options => {
  32                         type => "string",
  33                         example => "blacklist=1.2.3.4,blacklist=8.7.6.5,max-links=10",
  34                         description => "options to send to blogspam server",
  35                         link => "http://blogspam.net/api/testComment.html#options",
  36                         safe => 1,
  37                         rebuild => 0,
  38                 },
  39                 blogspam_server => {
  40                         type => "string",
  41                         default => $defaulturl,
  42                         description => "blogspam server XML-RPC url",
  43                         safe => 1,
  44                         rebuild => 0,
  45                 },
  46 }
  47
  48 sub checkcontent (@) {
  49         my %params=@_;
  50
  51         if (exists $config{blogspam_pagespec}) {
  52                 return undef
  53                         if ! pagespec_match($params{page}, $config{blogspam_pagespec},
  54                                 location => $params{page});
  55         }
  56
  57         my $url=$defaulturl;
  58         $url = $params{blogspam_server} if exists $params{blogspam_server};
  59         my $client = RPC::XML::Client->new($url);
  60
  61         my @options = split(",", $params{blogspam_options})
  62                 if exists $params{blogspam_options};
  63
  64         # Allow short comments and whitespace-only edits, unless the user
  65         # has overridden min-words themselves.
  66         push @options, "min-words=0"
  67                 unless grep /^min-words=/i, @options;
  68         # Wiki pages can have a lot of urls, unless the user specifically
  69         # wants to limit them.
  70         push @options, "exclude=lotsaurls"
  71                 unless grep /^max-links/i, @options;
  72         # Unless the user specified a size check, disable such checking.
  73         push @options, "exclude=size"
  74                 unless grep /^(?:max|min)-size/i, @options;
  75         # This test has absurd false positives on words like "alpha"
  76         # and "buy".
  77         push @options, "exclude=stopwords";
  78
  79         # blogspam API does not have a field for author url, so put it in
  80         # the content to be checked.
  81         if (exists $params{url}) {
  82                 $params{content}.="\n".$params{url};
  83         }
  84
  85         my $res = $client->send_request('testComment', {
  86                 ip => $ENV{REMOTE_ADDR},
  87                 comment => $params{content},
  88                 subject => defined $params{subject} ? $params{subject} : "",
  89                 name => defined $params{author} ? $params{author} : "",
  90                 options => join(",", @options),
  91                 site => $config{url},
  92                 version => "ikiwiki ".$IkiWiki::version,
  93         });
  94
  95         if (! ref $res || ! defined $res->value) {
  96                 debug("failed to get response from blogspam server ($url)");
  97                 return undef;
  98         }
  99         elsif ($res->value =~ /^SPAM:(.*)/) {
 100                 return gettext("Sorry, but that looks like spam to <a href=\"http://blogspam.net/\">blogspam</a>: ").$1;
 101         }
 102         elsif ($res->value ne 'OK') {
 103                 debug(gettext("blogspam server failure: ").$res->value);
 104                 return undef;
 105         }
 106         else {
 107                 return undef;
 108         }
 109 }
 110
 111 1