|
|
@@ -0,0 +1,198 @@
|
|
|
+# -*- mode: perl -*-
|
|
|
+# Copyright (C) 2023 Alex Schroeder <alex@gnu.org>
|
|
|
+
|
|
|
+# This program is free software: you can redistribute it and/or modify it under
|
|
|
+# the terms of the GNU Affero General Public License as published by the Free
|
|
|
+# Software Foundation, either version 3 of the License, or (at your option) any
|
|
|
+# later version.
|
|
|
+#
|
|
|
+# This program is distributed in the hope that it will be useful, but WITHOUT
|
|
|
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
|
+# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
|
|
|
+# details.
|
|
|
+#
|
|
|
+# You should have received a copy of the GNU Affero General Public License along
|
|
|
+# with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
+
|
|
|
+=encoding utf8
|
|
|
+
|
|
|
+=head1 NAME
|
|
|
+
|
|
|
+Oddmuse Network Blocker
|
|
|
+
|
|
|
+=head1 DESCRIPTION
|
|
|
+
|
|
|
+This module hooks into regular Oddmuse Surge Protection. It adds the following
|
|
|
+features:
|
|
|
+
|
|
|
+Repeated offenders are blocked for increasingly longer times.
|
|
|
+
|
|
|
+For every offender, we record the CIDR their IP number belongs to. Everytime an
|
|
|
+IP number is blocked, all the CIDRs of the other blocked IPs are checked: if
|
|
|
+there are three or more blocked IP numbers sharing the same CIDRs, the CIDR
|
|
|
+itself is blocked.
|
|
|
+
|
|
|
+CIDR blocking works the same way: Repeated offenders are blocked for
|
|
|
+increasingly longer times.
|
|
|
+
|
|
|
+=head2 Behind a reverse proxy
|
|
|
+
|
|
|
+Make sure your config file copies the IP number to the correct environment
|
|
|
+variable:
|
|
|
+
|
|
|
+ $ENV{REMOTE_ADDR} = $ENV{HTTP_X_FORWARDED_FOR};
|
|
|
+
|
|
|
+=head1 SEE ALSO
|
|
|
+
|
|
|
+<Oddmuse Surge Protection|https://oddmuse.org/wiki/Surge_Protection>
|
|
|
+
|
|
|
+=cut
|
|
|
+
|
|
|
+use strict;
|
|
|
+use v5.10;
|
|
|
+use Net::IP qw(:PROC);
|
|
|
+use Net::DNS qw(rr);
|
|
|
+
|
|
|
+AddModuleDescription('network-blocker.pl', 'Network Blocker Extension');
|
|
|
+
|
|
|
+our ($Now, $DataDir, $SurgeProtectionViews, $SurgeProtectionTime);
|
|
|
+
|
|
|
+{
|
|
|
+ no warnings 'redefine';
|
|
|
+ *OldNetworkBlockerDelayRequired = \&DelayRequired;
|
|
|
+ *DelayRequired = \&NewNetworkBlockerDelayRequired;
|
|
|
+}
|
|
|
+
|
|
|
+# Block for at least this many seconds.
|
|
|
+my $NetworkBlockerMinimumPeriod = 30;
|
|
|
+
|
|
|
+# Every violation doubles the current period until this maximum is reached (four weeks).
|
|
|
+my $NetworkBlockerMaximumPeriod = 60 * 60 * 24 * 7 * 4;
|
|
|
+
|
|
|
+# All the blocked networks. Maps CIDR to an array [expiry timestamp, expiry
|
|
|
+# period].
|
|
|
+my %NetworkBlockerList;
|
|
|
+
|
|
|
+# Candidates are remembered for this many seconds.
|
|
|
+my $NetworkBlockerCachePeriod = 600;
|
|
|
+
|
|
|
+# All the candidate networks for a block. Maps IP to an array [ts, cidr, ...].
|
|
|
+# Candidates are removed after $NetworkBlockerCachePeriod.
|
|
|
+my %NetworkBlockerCandidates;
|
|
|
+
|
|
|
+sub NetworkBlockerRead {
|
|
|
+ my ($status, $data) = ReadFile("$DataDir/network-blocks");
|
|
|
+ return unless $status;
|
|
|
+ my @lines = split(/\n/, $data);
|
|
|
+ while ($_ = shift(@lines)) {
|
|
|
+ my @items = split(/,/);
|
|
|
+ $NetworkBlockerList{shift(@items)} = \@items;
|
|
|
+ }
|
|
|
+ # an empty line separates the two sections
|
|
|
+ while ($_ = shift(@lines)) {
|
|
|
+ my @items = split(/,/);
|
|
|
+ $NetworkBlockerCandidates{shift(@items)} = \@items;
|
|
|
+ }
|
|
|
+ return 1;
|
|
|
+}
|
|
|
+
|
|
|
+sub NetworkBlockerWrite {
|
|
|
+ RequestLockDir('network-blocks') or return '';
|
|
|
+ WriteStringToFile(
|
|
|
+ "$DataDir/network-blocks",
|
|
|
+ join("\n\n",
|
|
|
+ join("\n", map {
|
|
|
+ join(",", $_, @{$NetworkBlockerList{$_}})
|
|
|
+ } keys %NetworkBlockerList),
|
|
|
+ join("\n", map {
|
|
|
+ join(",", $_, @{$NetworkBlockerCandidates{$_}})
|
|
|
+ } keys %NetworkBlockerCandidates)));
|
|
|
+ ReleaseLockDir('network-blocks');
|
|
|
+}
|
|
|
+
|
|
|
+sub NewNetworkBlockerDelayRequired {
|
|
|
+ my $ip = shift;
|
|
|
+ # If $ip is a name and not an IP number, parsing fails. In this case, run the
|
|
|
+ # regular code.
|
|
|
+ my $ob = new Net::IP($ip);
|
|
|
+ return OldNetworkBlockerDelayRequired($ip) unless $ob;
|
|
|
+ # Read the file. If the file does not exist, no problem.
|
|
|
+ NetworkBlockerRead();
|
|
|
+ # See if the current IP number is one of the blocked CIDR ranges.
|
|
|
+ for my $cidr (keys %NetworkBlockerList) {
|
|
|
+ # Perhaps this CIDR block can be expired.
|
|
|
+ if ($NetworkBlockerList{$cidr}->[0] < $Now) {
|
|
|
+ delete $NetworkBlockerList{$cidr};
|
|
|
+ next;
|
|
|
+ }
|
|
|
+ # Forget the CIDR if it cannot be turned into a range.
|
|
|
+ my $range = new Net::IP($cidr);
|
|
|
+ if (not $range) {
|
|
|
+ warn "CIDR $cidr is blocked but has no range: " . Net::IP::Error();
|
|
|
+ delete $NetworkBlockerList{$cidr};
|
|
|
+ next;
|
|
|
+ }
|
|
|
+ # If the CIDR overlaps with the remote IP number, it's a block.
|
|
|
+ warn "Checking whether $ip is in $cidr\n";
|
|
|
+ my $overlap = $range->overlaps($ob);
|
|
|
+ # $IP_PARTIAL_OVERLAP (ranges overlap) $IP_NO_OVERLAP (no overlap)
|
|
|
+ # $IP_A_IN_B_OVERLAP (range2 contains range1) $IP_B_IN_A_OVERLAP (range1
|
|
|
+ # contains range2) $IP_IDENTICAL (ranges are identical) undef (problem)
|
|
|
+ if (defined $overlap and $overlap != $IP_NO_OVERLAP) {
|
|
|
+ # Double the block period unless it has reached $NetworkBlockerMaximumPeriod.
|
|
|
+ if ($NetworkBlockerList{$cidr}->[1] < $NetworkBlockerMaximumPeriod / 2) {
|
|
|
+ $NetworkBlockerList{$cidr}->[1] *= 2;
|
|
|
+ } else {
|
|
|
+ $NetworkBlockerList{$cidr}->[1] = $NetworkBlockerMaximumPeriod;
|
|
|
+ }
|
|
|
+ $NetworkBlockerList{$cidr}->[0] = $Now + $NetworkBlockerList{$cidr}->[1];
|
|
|
+ # And we're done!
|
|
|
+ NetworkBlockerWrite();
|
|
|
+ ReportError(Ts('Too many connections by %s', $cidr)
|
|
|
+ . ': ' . Tss('Please do not fetch more than %1 pages in %2 seconds.',
|
|
|
+ $SurgeProtectionViews, $SurgeProtectionTime),
|
|
|
+ '503 SERVICE UNAVAILABLE');
|
|
|
+ }
|
|
|
+ }
|
|
|
+ # If the CIDR isn't blocked, let's see if Surge Protection wants to block it.
|
|
|
+ my $result = OldNetworkBlockerDelayRequired($ip);
|
|
|
+ warn "$ip was blocked\n" if $result;
|
|
|
+ # If the IP is to be blocked, determine its CIDRs and put them on a list. Sadly,
|
|
|
+ # routeviews does not support IPv6 at the moment!
|
|
|
+ if ($result and not ip_is_ipv6($ip) and not $NetworkBlockerCandidates{$ip}) {
|
|
|
+ my $reverse = $ob->reverse_ip();
|
|
|
+ $reverse =~ s/in-addr\.arpa\.$/asn.routeviews.org/;
|
|
|
+ my @candidates;
|
|
|
+ for my $rr (rr($reverse, "TXT")) {
|
|
|
+ next unless $rr->type eq "TXT";
|
|
|
+ my @data = $rr->txtdata;
|
|
|
+ push(@candidates, join("/", @data[1..2]));
|
|
|
+ }
|
|
|
+ warn "$ip is in @candidates\n";
|
|
|
+ $NetworkBlockerCandidates{$ip} = [$Now, @candidates];
|
|
|
+ # Expire any of the other candidates
|
|
|
+ for my $other_ip (keys %NetworkBlockerCandidates) {
|
|
|
+ if ($NetworkBlockerCandidates{$other_ip}->[0] < $Now - $NetworkBlockerCachePeriod) {
|
|
|
+ delete $NetworkBlockerCandidates{$other_ip};
|
|
|
+ }
|
|
|
+ }
|
|
|
+ # Determine if any of the CIDRs is to be blocked.
|
|
|
+ my $save;
|
|
|
+ for my $cidr (@candidates) {
|
|
|
+ # Count how often the candidate CIDRs show up for other IP numbers.
|
|
|
+ my $count = 0;
|
|
|
+ for my $other_ip (keys %NetworkBlockerCandidates) {
|
|
|
+ my @data = $NetworkBlockerCandidates{$other_ip};
|
|
|
+ for my $other_cidr (@data[1 .. $#data]) {
|
|
|
+ $count++ if $cidr eq $other_cidr;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ if ($count >= 3) {
|
|
|
+ $NetworkBlockerList{$cidr} = [$Now + $NetworkBlockerMinimumPeriod, $NetworkBlockerMinimumPeriod];
|
|
|
+ $save = 1;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ NetworkBlockerWrite() if $save;
|
|
|
+ }
|
|
|
+ return $result;
|
|
|
+}
|
Alex Schroeder