summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/blogspam.pm
blob: da63d3edbfae57dd2d94da5f82da768e60ae65b0 (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki::Plugin::blogspam;
  3. use warnings;
  4. use strict;
  5. use IkiWiki 3.00;
  6. my $defaulturl='http://test.blogspam.net:8888/';
  7. sub import {
  8. hook(type => "getsetup", id => "blogspam", call => \&getsetup);
  9. hook(type => "checkconfig", id => "blogspam", call => \&checkconfig);
  10. hook(type => "checkcontent", id => "blogspam", call => \&checkcontent);
  11. }
  12. sub getsetup () {
  13. return
  14. plugin => {
  15. safe => 1,
  16. rebuild => 0,
  17. },
  18. blogspam_pagespec => {
  19. type => 'pagespec',
  20. example => 'postcomment(*)',
  21. description => 'PageSpec of pages to check for spam',
  22. link => 'ikiwiki/PageSpec',
  23. safe => 1,
  24. rebuild => 0,
  25. },
  26. blogspam_options => {
  27. type => "string",
  28. example => "blacklist=1.2.3.4,blacklist=8.7.6.5,max-links=10",
  29. description => "options to send to blogspam server",
  30. link => "http://blogspam.net/api/testComment.html#options",
  31. safe => 1,
  32. rebuild => 0,
  33. },
  34. blogspam_server => {
  35. type => "string",
  36. default => $defaulturl,
  37. description => "blogspam server XML-RPC url",
  38. safe => 1,
  39. rebuild => 0,
  40. },
  41. }
  42. sub checkconfig () {
  43. # This is done at checkconfig time because printing an error
  44. # if the module is missing when a spam is posted would not
  45. # let the admin know about the problem.
  46. eval q{
  47. use RPC::XML;
  48. use RPC::XML::Client;
  49. };
  50. error $@ if $@;
  51. }
  52. sub checkcontent (@) {
  53. my %params=@_;
  54. if (exists $config{blogspam_pagespec}) {
  55. return undef
  56. if ! pagespec_match($params{page}, $config{blogspam_pagespec},
  57. location => $params{page});
  58. }
  59. my $url=$defaulturl;
  60. $url = $config{blogspam_server} if exists $config{blogspam_server};
  61. my $client = RPC::XML::Client->new($url);
  62. my @options = split(",", $config{blogspam_options})
  63. if exists $config{blogspam_options};
  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. my %req=(
  79. ip => $ENV{REMOTE_ADDR},
  80. comment => $params{content},
  81. subject => defined $params{subject} ? $params{subject} : "",
  82. name => defined $params{author} ? $params{author} : "",
  83. link => exists $params{url} ? $params{url} : "",
  84. options => join(",", @options),
  85. site => $config{url},
  86. version => "ikiwiki ".$IkiWiki::version,
  87. );
  88. my $res = $client->send_request('testComment', \%req);
  89. if (! ref $res || ! defined $res->value) {
  90. debug("failed to get response from blogspam server ($url)");
  91. return undef;
  92. }
  93. elsif ($res->value =~ /^SPAM:(.*)/) {
  94. eval q{use Data::Dumper};
  95. debug("blogspam server reports ".$res->value.": ".Dumper(\%req));
  96. return gettext("Sorry, but that looks like spam to <a href=\"http://blogspam.net/\">blogspam</a>: ").$1;
  97. }
  98. elsif ($res->value ne 'OK') {
  99. debug("blogspam server failure: ".$res->value);
  100. return undef;
  101. }
  102. else {
  103. return undef;
  104. }
  105. }
  106. 1