package Slowloris; use strict; use warnings; use Test::SharedFork; our $WriteBytes = 1; our $SleepBeforeWrite = 0; our $SleepBeforeRead = 0; package Slowloris::Socket; use parent qw(IO::Socket::INET); use Time::HiRes qw(sleep); sub syswrite { my($sock, $buff, $len, $off) = @_; sleep $SleepBeforeWrite if $SleepBeforeWrite; my $w = $off; while($off < $len) { my $n = $sock->SUPER::syswrite($buff, $Slowloris::WriteBytes, $off); defined($n) or return undef; $off += $n; } return $off - $w; } sub sysread { my $sock = shift; sleep $SleepBeforeRead if $SleepBeforeRead; return $sock->SUPER::sysread(@_); } package Slowloris::Server; use parent qw(HTTP::Server::PSGI); sub setup_listener { my $self = shift; $self->SUPER::setup_listener(@_); bless $self->{listen_sock}, 'Slowloris::Socket'; } 1;