develooper Front page | perl.ithreads | Postings from April 2008

Timeout of detached threads to prevent DOS Attack

Thread Next
From:
Stefan Donoval
Date:
April 5, 2008 19:22
Subject:
Timeout of detached threads to prevent DOS Attack
Message ID:
20080405112338.22235.qmail@lists.develooper.com
Hi,

i wrote a prethreading server deamon that also reuse finished threads.
However I have a problem with possibel DOS attacks.
$fh is the

my $STATUS       = '';
my %STATUSTIME   = 0;
my $ACCEPT_LOCK  = '';
my %STATUS       = ();
my $DONE         = 0;
share(%STATUS);
share(%STATUSTIME);
share($ACCEPT_LOCK);

$SIG{INT} = $SIG{TERM} = sub { $DONE++ };
$SIG{ALRM} = sub {};

#MAIN Webserver with Multithreading
print "Binding socket on $ip_listen Port $port_listen\n";
#Bind Socket

my $socket = IO::Socket::INET->new( LocalPort => $port_listen,
                                     LocalAddr => $ip_listen,
                                     Listen    => 100,
                                     Reuse     => 1 ) or die "Can't 
create listen socket: $!";
my $SOCKIN = IO::Select->new($socket);

launch_thread($socket) for (1..$PRETHREAD);  # launch threads

while (!$DONE) {
   lock %STATUS;
   cond_wait %STATUS;
   warn join(' ', map {"$_=>$STATUS{$_}"} keys %STATUS),"\n" if DEBUG;
   my @idle = sort {$a <=> $b} grep {$STATUS{$_} eq 'idle'} keys %STATUS;
   my @busy = sort {$a <=> $b} grep {$STATUS{$_} eq 'busy'} keys %STATUS;
   if (@idle < $LO_WATER_MARK) {
     launch_thread($socket) for (0..$LO_WATER_MARK-@idle-1);     # bring 
the number up
   } elsif (@idle > $HI_WATER_MARK) {
     my @goners = @idle[0..@idle - $HI_WATER_MARK - 1];   # kill the 
oldest ones
     status($_ => 'goner') foreach @goners;
     warn "decomissioning @goners\n" if DEBUG;
   }
   if (scalar(@busy) > $threadsmaxbusy) {
     $threadsmaxbusy=scalar(@busy);
   }
}
warn "Server will terminate when last thread has finished...\n" if DEBUG;
status($_ => 'goner') foreach keys %STATUS;
exit 0;

sub do_thread {
   my $socket = shift;
   my $cycles = $MAX_REQUEST;
   my $tid = threads->self->tid;
   my $c;
   warn "Thread $tid: starting\n" if DEBUG;
   threads->self->detach;        # don't save thread status info
   $SIG{__DIE__} =  sub {&status($tid=>undef);close $c;};
   status($tid => 'idle');
   while (status($tid) ne 'goner' && $cycles > 0) {
     next unless $SOCKIN->can_read(1);
     {
       lock $ACCEPT_LOCK;
       next unless $c = $socket->accept();

     }
     $cycles--;
     status($tid => 'busy');
     $STATUSTIME{$tid}=time;
     warn "Thread $tid: handling connection\n" if DEBUG;
     new_connection($c);
     close $c;
     status($tid => 'idle');
   }
   warn "Thread $tid done\n" if DEBUG;
   status($tid=>undef);
   exit 1;
}

sub status {
   my $tid = shift;
   lock %STATUS;
   return $STATUS{$tid} unless @_;
   my $status = shift;
   if ($status) {
     $STATUS{$tid} = $status
       unless defined $STATUS{$tid} and $STATUS{$tid} eq 'goner';
   } else {
     delete $STATUS{$tid};
     delete $STATUSTIME{$tid};
   }
   cond_broadcast %STATUS;
}

sub new_connection {
	my $fh = shift;
	my $ip = "";
	my $port = "";
	my $iaddr = "";
   my $return = eval(($port, $iaddr) = sockaddr_in(getpeername($fh)));
   if ($return) {
     $ip=inet_ntoa($iaddr);
   	binmode $fh;
   	my $doexit = 0;
   	my %req;
   	$req{HEADER}={};

   	my $request_line = <$fh>; <== Here is the problem
....

if i write a simple cgi-script

use IO::Socket;
my $socket = new IO::Socket::INET( PeerAddr => $deamonserver, PeerPort 
=> 80, Proto => 'tcp', );
if ($socket)   {
   my $counter=0;
   while (1) {
     sleep 1;
     $counter++;
     print "$counter\n";
   }
   close($socket);
}
The server will never break out the thread

With forking servers I used to do it with ALRM signal,
but this doesn't work with threads.

Any solution?

I am searching arround the net now for more than one week,
and didn't didn't find any solution.
Neither socket timeout works nor any signal handler modul I tired.

Thank you for helping

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About