use Coro;
use Coro::Semaphore;
use Coro::Event;
use Coro::Socket;
no utf8;
use bytes;
# at least on my machine, this thingy serves files
# quite a bit faster than apache, ;)
# and quite a bit slower than thttpd :(
$SIG{PIPE} = 'IGNORE';
sub slog {
my $level = shift;
my $format = shift;
printf "---: $format\n", @_;
}
my $connections = new Coro::Semaphore $MAX_CONNECTS;
my @newcons;
my @pool;
# one "execution thread"
sub handler {
while () {
my $new = pop @newcons;
if ($new) {
eval {
conn->new(@$new)->handle;
};
slog 1, "$@" if $@ && !ref $@;
$connections->up;
} else {
last if @pool >= $MAX_POOL;
push @pool, $Coro::current;
schedule;
}
}
}
my $http_port = new Coro::Socket
LocalAddr => $SERVER_HOST,
LocalPort => $SERVER_PORT,
ReuseAddr => 1,
Listen => 1,
or die "unable to start server";
push @listen_sockets, $http_port;
# the "main thread"
async {
slog 1, "accepting connections";
while () {
$connections->down;
push @newcons, [$http_port->accept];
#slog 3, "accepted @$connections ".scalar(@pool);
$::NOW = time;
if (@pool) {
(pop @pool)->ready;
} else {
async \&handler;
}
}
};
package conn;
use Socket;
use HTTP::Date;
use Convert::Scalar 'weaken';
our %conn; # $conn{ip}{fh} => connobj
our %blocked;
sub new {
my $class = shift;
my $peername = shift;
my $fh = shift;
my $self = bless { fh => $fh }, $class;
my (undef, $iaddr) = unpack_sockaddr_in $peername
or $self->err(500, "unable to decode peername");
$self->{remote_addr} = inet_ntoa $iaddr;
# enter ourselves into various lists
weaken ($conn{$self->{remote_addr}}{$self*1} = $self);
$self;
}
sub DESTROY {
my $self = shift;
delete $conn{$self->{remote_addr}}{$self*1};
delete $uri{$self->{uri}}{$self*1};
}
sub slog {
my $self = shift;
main::slog($_[0], "$self->{remote_addr}> $_[1]");
}
sub response {
my ($self, $code, $msg, $hdr, $content) = @_;
my $res = "HTTP/1.0 $code $msg\015\012";
$res .= "Connection: close\015\012";
$res .= "Date: ".(time2str $::NOW)."\015\012"; # slow? nah. :(
while (my ($h, $v) = each %$hdr) {
$res .= "$h: $v\015\012"
}
$res .= "\015\012$content" if defined $content;
print STDERR "$self->{remote_addr} \"$self->{uri}\" $code ".$hdr->{"Content-Length"}." \"$self->{h}{referer}\"\n";#d#
print {$self->{fh}} $res;
}
sub err {
my $self = shift;
my ($code, $msg, $hdr, $content) = @_;
unless (defined $content) {
$content = "$code $msg";
$hdr->{"Content-Type"} = "text/plain";
$hdr->{"Content-Length"} = length $content;
}
$self->response($code, $msg, $hdr, $content);
die bless {}, err::;
}
sub err_blocked {
my $self = shift;
my $ip = $self->{remote_addr};
my $time = time2str $blocked{$ip} = $::NOW + $::BLOCKTIME;
$self->err(403, "too many connections",
{
"Content-Type" => "text/html",
"Retry-After" => $::BLOCKTIME
},
<
You have been blocked because you opened too many connections. You
may retry at$time.
Until then, each new access will renew the block. You might want to have a look at the FAQ.