modules/ban-contributors.pl

   1 # Copyright (C) 2013  Alex Schroeder <alex@gnu.org>
   2
   3 # This program is free software: you can redistribute it and/or modify it under
   4 # the terms of the GNU General Public License as published by the Free Software
   5 # Foundation, either version 3 of the License, or (at your option) any later
   6 # version.
   7 #
   8 # This program is distributed in the hope that it will be useful, but WITHOUT
   9 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  10 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along with
  13 # this program. If not, see <http://www.gnu.org/licenses/>.
  14
  15 =head1 Ban Contributors Extension
  16
  17 This module adds "Ban contributors" to the administration page. If you
  18 click on it, it will list all the recent contributors to the page
  19 you've been looking at. Each contributor (IP or hostname) will be
  20 compared to the list of regular expressions on the C<BannedHosts> page
  21 (see C<$BannedHosts>). If the contributor is already banned, this is
  22 mentioned. If the contributor is not banned, you'll see a button
  23 allowing you to ban him or her immediately. If you click the button,
  24 the IP or hostname will be added to the C<BannedHosts> page for you.
  25
  26 =cut
  27
  28 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/ban-contributors.pl">ban-contributors.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Ban_Contributors_Extension">Ban Contributors Extension</a></p>';
  29
  30 push(@MyAdminCode, \&BanMenu);
  31
  32 sub BanMenu {
  33   my ($id, $menuref, $restref) = @_;
  34   if ($id and UserIsAdmin()) {
  35     push(@$menuref, ScriptLink('action=ban;id=' . UrlEncode($id),
  36                                T('Ban contributors')));
  37   }
  38 }
  39
  40 $Action{ban} = \&DoBanHosts;
  41
  42 sub IsItBanned {
  43   my ($it, $regexps) = @_;
  44   my $re = undef;
  45   foreach my $regexp (@$regexps) {
  46     eval { $re = qr/$regexp/i; };
  47     if (defined($re) && $it =~ $re) {
  48       return $it;
  49     }
  50   }
  51 }
  52
  53 sub DoBanHosts {
  54   my $id = shift;
  55   my $content = GetParam('content', '');
  56   my $host = GetParam('host', '');
  57   if ($content) {
  58     SetParam('text', GetPageContent($BannedContent)
  59              . $content . " # " . CalcDay($Now) . " "
  60              . NormalToFree($id) . "\n");
  61     SetParam('summary', NormalToFree($id));
  62     DoPost($BannedContent);
  63   } elsif ($host) {
  64     $host =~ s/\./\\./g;
  65     SetParam('text', GetPageContent($BannedHosts)
  66              . "^" . $host . " # " . CalcDay($Now) . " "
  67              . NormalToFree($id) . "\n");
  68     SetParam('summary', NormalToFree($id));
  69     DoPost($BannedHosts);
  70   } else {
  71     ValidIdOrDie($id);
  72     print GetHeader('', Ts('Ban Contributors to %s', NormalToFree($id)));
  73     SetParam('rcidonly', $id);
  74     SetParam('all', 1);
  75     SetParam('showedit', 1);
  76     my %contrib = ();
  77     for my $line (GetRcLines()) {
  78       $contrib{$line->[4]}->{$line->[5]} = 1 if $line->[4];
  79     }
  80     my @regexps = ();
  81     foreach (split(/\n/, GetPageContent($BannedHosts))) {
  82       if (/^\s*([^#]\S+)/) { # all lines except empty lines and comments, trim whitespace
  83         push(@regexps, $1);
  84       }
  85     }
  86     print '<div class="content ban">';
  87     foreach (sort(keys %contrib)) {
  88       my $name = $_;
  89       delete $contrib{$_}{''};
  90       $name .= " (" . join(", ", sort(keys(%{$contrib{$_}}))) . ")";
  91       if (IsItBanned($_, \@regexps)) {
  92         print $q->p(Ts("%s is banned", $name));
  93       } else {
  94         print GetFormStart(undef, 'get', 'ban'),
  95           GetHiddenValue('action', 'ban'),
  96           GetHiddenValue('id', $id),
  97           GetHiddenValue('host', $_),
  98           GetHiddenValue('recent_edit', 'on'),
  99           $q->p($name, $q->submit(T('Ban!'))), $q->end_form();
 100       }
 101     }
 102   }
 103   PrintFooter();
 104 }
 105
 106 =head2 Rollback
 107
 108 If you are an admin and rolled back a single page, this extension will
 109 list the URLs your rollback removed (assuming that those URLs are part
 110 of the spam) and it will allow you to provide a regular expression
 111 that will be added to BannedHosts.
 112
 113 =cut
 114
 115 *OldBanContributorsWriteRcLog = *WriteRcLog;
 116 *WriteRcLog = *NewBanContributorsWriteRcLog;
 117
 118 sub NewBanContributorsWriteRcLog {
 119   my ($tag, $id, $to) = @_;
 120   if ($tag eq '[[rollback]]' and $id and $to > 0
 121       and $OpenPageName eq $id and UserIsAdmin()) {
 122     # we currently have the clean page loaded, so we need to reload
 123     # the spammed revision (there is a possible race condition here)
 124     my ($old) = GetTextRevision($Page{revision}-1, 1);
 125     my %urls = map {$_ => 1 } $old =~ /$UrlPattern/og;
 126     # we open the file again to force a load of the despammed page
 127     foreach my $url ($Page{text} =~ /$UrlPattern/og) {
 128       delete($urls{$url});
 129     }
 130     # we also remove any candidates that are already banned
 131     my @regexps = ();
 132     foreach (split(/\n/, GetPageContent($BannedContent))) {
 133       if (/^\s*([^#]\S+)/) { # all lines except empty lines and comments, trim whitespace
 134         push(@regexps, $1);
 135       }
 136     }
 137     foreach my $url (keys %urls) {
 138       delete($urls{$url}) if IsItBanned($url, \@regexps);
 139     }
 140     if (keys %urls) {
 141       print $q->p(Ts("These URLs were rolled back. Perhaps you want to add a regular expression to %s?",
 142                      GetPageLink($BannedContent)));
 143       print $q->pre(join("\n", sort keys %urls));
 144       print GetFormStart(undef, 'get', 'ban'),
 145             GetHiddenValue('action', 'ban'),
 146             GetHiddenValue('id', $id),
 147             GetHiddenValue('recent_edit', 'on'),
 148             $q->p($q->label({-for=>'content'}, T('Regular expression:')), " ",
 149                   $q->textfield(-name=>'content', -size=>30), " ",
 150                   $q->submit(T('Ban!'))),
 151             $q->end_form();
 152     };
 153     print $q->p(T("Consider banning the hostname or IP number as well: "),
 154                 ScriptLink('action=ban;id=' . UrlEncode($id), T('Ban contributors')));
 155   };
 156   return OldBanContributorsWriteRcLog(@_);
 157 }