view release on metacpan or  search on metacpan

script/block-web-flooders  view on Meta::CPAN

sub action_unblock_all {
    _init();

    local @ARGV = keys %Blocked;
    _block_or_unblock_ips("unblock");
    _set_need_reload(1);
}

sub action_run {
    #require Term::Size;
    require Time::Duration;

    #my ($columns, $rows) = Term::Size::chars *STDOUT{IO};

    my $last_check_spanel_log_time;
    my ($spanel_http_log_name, $spanel_https_log_name);

    my $last_update_output_time;
    my $last_unblock_time;
    my $last_reload_data_time;
    my $num_lines = 0;

    _init();

    local *INPUT;
    if (defined $Opts{spanel_site}) {
        require Tie::Handle::TailSwitch;
        my $dir = "/s/$Opts{spanel_site}/syslog";
        tie *INPUT, 'Tie::Handle::TailSwitch', (
            globs => ["$dir/https_access.*.log", "$dir/http_access.*.log"],
        );
    } else {
        *INPUT = \*STDIN;
    }

  LINE:
    while (1) {
        my $line = <INPUT>;
        if (!defined($line) || !length($line)) {
            sleep 0.5;
            next;
        }

        my $now = time();
        $num_lines++;
        chomp $line;
        $line =~ /\A($RE{ipv4})\s/ or do {
            warn "$PROG: Line '$line': Can't parse IP address, skipped\n";
            next;
        };
        my $ip = $1;
        next if $Blocked{$ip};

      OUTPUT:
        {
            last unless !$last_update_output_time ||
                $last_update_output_time <= $now-2;
            print "\e[2J\e[;H"; # clear screen + put cursor at top (0,0)
            printf "Blocked IPs: %s%4d%s | Log lines: %s%6d%s | Running for: %s%s%s\n",
                color('bold'), (scalar keys %Blocked), color('reset'),
                color('bold'), $num_lines, color('reset'),
                color('bold'), Time::Duration::concise(Time::Duration::duration($now-$^T, 2)), color('reset');
            $last_update_output_time = $now;
            printf "Top IPs:\n";
            my $i = 0;
            for my $ip (sort { scalar(@{ $Ips{$b} }) <=> scalar(@{ $Ips{$a} }) } keys %Ips) {
                last if $i++ >= 10;
                printf "  %15s (%4d)\n", $ip, scalar(@{ $Ips{$ip} });
            }
            printf "Last messages:\n";
            $i = 0;
            for my $msg (@Messages) {
                last if $i++ >= 5;
                print "  $msg\n";
            }
        } # OUTPUT

      UNBLOCK:
        {
            last unless !$last_unblock_time ||
                $last_unblock_time <= $now-60;
            for (keys %Blocked) {
                next unless $Blocked{$_} < $now - $Opts{block_period};
                unblock_ip($_);
            }
            $last_unblock_time = $now;
        } # UNBLOCK

      RELOAD_DATA:
        {
            last unless !$last_reload_data_time ||
                $last_reload_data_time <= $now-5;
            _reload_data_from_db();
            $last_reload_data_time = $now;
        }

        for my $has (@{ $Opts{has} }) {
            next LINE unless index($line, $has) >= 0;
        }
        for my $lacks (@{ $Opts{lacks} }) {
            next LINE if index($line, $lacks) >= 0;
        }
        for my $pat (@{ $Opts{has_pattern} }) {
            next LINE unless $line =~ $pat;
        }
        for my $pat (@{ $Opts{lacks_pattern} }) {
            next LINE if $line =~ $pat;
        }

        $Ips{$ip} //= do {
            tie my @ary, "Tie::Array::Expire", $Opts{period};
            \@ary;
        };
        push @{ $Ips{$ip} }, 1;
        if (@{ $Ips{$ip} } > $Opts{limit} && !$Whitelisted{$ip}) {
            block_ip($ip);
            delete $Ips{$ip};
        }
    } # loop
}

# MAIN