Teergrube für böse Bots?

Code: Alles auswählen

#!/usr/bin/perl
$|++;
use strict;
use warnings;
use diagnostics;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
use Fcntl qw(:flock);
use File::Spec;

my $max_bots    = 10;   # maximale Anzahl der eingesperrten Bots
my $max_time    = 600;  # Einsperren fuer X Sekunden
my $next_grube  = '';   # naechste Grube wenn die eigene voll ist
                        # z.B. 'http://www.teergrubing.de/cgi-bin/teergrubing.cgi?domain='
my $shrink_time = 'on'; # on / off reduziert die $max_time bei steigender Bot-Zahl
my $log_file    = File::Spec->catfile($ENV{'DOCUMENT_ROOT'},'teergrube','log.txt');   # Log-File
my $counter     = File::Spec->catfile($ENV{'DOCUMENT_ROOT'},'teergrube','count.txt'); # Counter fuer Insassen

my($bot_count,$sleep_count);

sub _log_it($);
sub _count_bot($);
my $emacs_need_this = {};

$SIG{'USR1'} = \&sig_handler();
$SIG{'TERM'} = \&sig_handler();
$SIG{'PIPE'} = 'IGNORE';

my $query  = new CGI;
my $domain = $query->param('domain');

_log_it("Catched BadBot $ENV{'REMOTE_ADDR'} / $ENV{'HTTP_USER_AGENT'} from $domain at " . scalar(localtime()) . "\n");
$bot_count = _count_bot(1);

if($shrink_time eq 'on'){
    $max_time  -= (($max_time / $max_bots) * ($bot_count - 1));
}

if&#40;$bot_count <= $max_bots&#41;&#123;
    print $query->header&#40;&#41;;
    print $query->start_html&#40;-title => 'Teergrube'&#41;;
    $sleep_count = 0;
    while&#40;$sleep_count < $max_time&#41;&#123;
	last unless&#40;print "       \n"&#41;;
	sleep 1;
	$sleep_count++;
    &#125;
    print $query->end_html&#40;&#41;;
&#125;else&#123;
    if&#40;length&#40;$next_grube&#41;&#41;&#123;
	print $query->redirect&#40;'-url' => $next_grube . $domain&#41;;
    &#125;else&#123;
	print $query->redirect&#40;'-url' => 'http&#58;//' . $ENV&#123;'REMOTE_ADDR'&#125;&#41;;
    &#125;
&#125;


END&#123;
    $bot_count = _count_bot&#40;-1&#41;;
    _log_it&#40;"Lost BadBot $ENV&#123;'REMOTE_ADDR'&#125; / $ENV&#123;'HTTP_USER_AGENT'&#125; from $domain at " . scalar&#40;localtime&#40;&#41;&#41; . "\n"&#41;;
&#125;
sub _log_it&#40;$&#41;&#123;
    my $text = shift;
    open&#40;LOG, ">> $log_file"&#41; or die&#40;"open&#40;LOG, >> $log_file&#41; failed $!"&#41;;
    flock&#40;LOG, LOCK_EX&#41;;
    print LOG $text;
    close&#40;LOG&#41; or die&#40;"close&#40;LOG&#41; failed $!"&#41;;
    return;
&#125;
sub _count_bot&#40;$&#41;&#123;
    my $value = shift;
    open&#40;CNT, "+>> $counter"&#41; or die&#40;"open&#40;CNT, >> $counter&#41; failed $!"&#41;;
    flock&#40;CNT, LOCK_EX&#41;;
    seek&#40;CNT,0,0&#41;;
    my $is_count = <CNT> || 0;
    $is_count += $value;
    chomp&#40;$is_count&#41;;
    seek&#40;CNT,0,0&#41;;
    truncate&#40;CNT,0&#41;;
    print CNT $is_count . "\n";
    close&#40;CNT&#41; or die&#40;"close&#40;CNT&#41; failed $!"&#41;;
    return $is_count;
&#125;
sub sig_handler&#40;&#41;&#123;
    return unless&#40;defined $bot_count&#41;;
    warn 'SIGNAL received at ' . scalar&#40;localtime&#41;;
    $bot_count = _count_bot&#40;-1&#41;;
    _log_it&#40;"Lost BadBot from $ENV&#123;'REMOTE_ADDR'&#125; at " . scalar&#40;localtime&#40;&#41;&#41; . "\n"&#41;;
    exit&#40;&#41;;
&#125;

__END__

Code: Alles auswählen

$next_grube  = '';

Code: Alles auswählen

$next_grube = 'http://www.teergrubing.de/';

Code: Alles auswählen

RewriteRule ^.* - [F]

Code: Alles auswählen

RewriteRule ^.*	/cgi-bin/scriptname.cgi?domain=diese.domain.de	   [L]

Code: Alles auswählen

RewriteRule ^.*	http://www.teergrubing.de/www.domain.de/   [R,L]

Code: Alles auswählen

$next_grube  = '';   # naechste Grube wenn die eigene voll ist