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