Bug 1393888 - Write httpd access handler to block by ip address stored in memcached

4 files changed, 127 insertions, 0 deletions

diff --git a/Bugzilla/ModPerl.pm b/Bugzilla/ModPerl.pm
index 7c367ed2e..142df63d4 100644
--- a/Bugzilla/ModPerl.pm
+++ b/Bugzilla/ModPerl.pm
@@ -19,6 +19,8 @@ use Carp ();
 # (and there might be side-effects, since this code is loaded very early in the httpd startup)
 use Template ();
 
+use Bugzilla::ModPerl::BlockIP;
+
 sub apache_config {
     my ($class, $cgi_path) = @_;
 
@@ -72,6 +74,7 @@ __DATA__
 # the built-in rand(), even though we never use it in Bugzilla itself,
 # so we need to srand() both of them.)
 PerlChildInitHandler "sub { Bugzilla::RNG::srand(); srand(); }"
+PerlAccessHandler Bugzilla::ModPerl::BlockIP
 
 # It is important to specify ErrorDocuments outside of all directories.
 # These used to be in .htaccess, but then things like "AllowEncodedSlashes no"
diff --git a/Bugzilla/ModPerl/BlockIP.pm b/Bugzilla/ModPerl/BlockIP.pm
new file mode 100644
index 000000000..4e9a4be5c
--- /dev/null
+++ b/Bugzilla/ModPerl/BlockIP.pm
@@ -0,0 +1,65 @@
+package Bugzilla::ModPerl::BlockIP;
+use 5.10.1;
+use strict;
+use warnings;
+
+use Apache2::RequestRec ();
+use Apache2::Connection ();
+
+use Apache2::Const -compile => qw(OK);
+use Cache::Memcached::Fast;
+
+use constant BLOCK_TIMEOUT => 60*60;
+
+my $MEMCACHED = Bugzilla::Memcached->_new()->{memcached};
+my $STATIC_URI = qr{
+    ^/
+     (?: extensions/[^/]+/web
+       | robots\.txt
+       | __heartbeat__
+       | __lbheartbeat__
+       | __version__
+       | images
+       | skins
+       | js
+       | errors
+     )
+}xms;
+
+sub block_ip {
+    my ($class, $ip) = @_;
+    $MEMCACHED->set("block_ip:$ip" => 1, BLOCK_TIMEOUT) if $MEMCACHED;
+}
+
+sub unblock_ip {
+    my ($class, $ip) = @_;
+    $MEMCACHED->delete("block_ip:$ip") if $MEMCACHED;
+}
+
+sub handler {
+    my $r = shift;
+    return Apache2::Const::OK if $r->uri =~ $STATIC_URI;
+
+    my $ip = $r->headers_in->{'X-Forwarded-For'};
+    if ($ip) {
+        $ip = (split(/\s*,\s*/ms, $ip))[-1];
+    }
+    else {
+        $ip = $r->connection->remote_ip;
+    }
+
+    if ($MEMCACHED && $MEMCACHED->get("block_ip:$ip")) {
+        __PACKAGE__->block_ip($ip);
+        $r->status_line("429 Too Many Requests");
+        # 500 is used here because apache 2.2 doesn't understand 429.
+        # the above line and the return value together mean we produce 429.
+        # Any other variation doesn't work.
+        $r->custom_response(500, "Too Many Requests");
+        return 429;
+    }
+    else {
+        return Apache2::Const::OK;
+    }
+}
+
+1;
diff --git a/scripts/block-ip.pl b/scripts/block-ip.pl
new file mode 100644
index 000000000..b767a1fd5
--- /dev/null
+++ b/scripts/block-ip.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+# This Source Code Form is "Incompatible With Secondary Licenses", as
+# defined by the Mozilla Public License, v. 2.0.
+
+use strict;
+use warnings;
+use lib qw(. lib local/lib/perl5);
+
+use Bugzilla;
+use Bugzilla::Constants;
+use Bugzilla::ModPerl::BlockIP;
+use Getopt::Long;
+
+Bugzilla->usage_mode(USAGE_MODE_CMDLINE);
+
+my $unblock;
+GetOptions('unblock' => \$unblock);
+
+pod2usage("No IPs given") unless @ARGV;
+
+if ($unblock) {
+    Bugzilla::ModPerl::BlockIP->unblock_ip($_) for @ARGV;
+} else {
+    Bugzilla::ModPerl::BlockIP->block_ip($_) for @ARGV;
+}
+
+=head1 NAME
+
+block-ip.pl -- block or unlock ip addresses from Bugzilla's IP block list
+
+=head1 SYNOPSIS
+
+block-ip.pl [--unblock] ip1 [ip2 ...]
+
+    Options:
+        --unblock   instead of blocking, unblock the listed IPs
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--unblock>
+
+If passed, the IPs will be unblocked instead of blocked. Use this to remove IPs from the blocklist.
+
+=back
+
+=head1 DESCRIPTION
+
+This is just a simple CLI inteface to L<Bugzilla::ModPerl::BlockIP>.
diff --git a/t/001compile.t b/t/001compile.t
index f8ba8d1c7..30b83da1d 100644
--- a/t/001compile.t
+++ b/t/001compile.t
@@ -39,6 +39,10 @@ sub compile_file {
         skip "$file: extensions not tested",  1;
         return;
     }
+    if ($file =~ /ModPerl/) {
+       skip "$file: ModPerl stuff not tested", 1;
+       return;
+    }
 
     if ($file =~ s/\.pm$//) {
         $file =~ s{/}{::}g;