tcp_server hang

[Eduard Ivanov]

Hello,

Can someone help me with my problem?
I'm writing a simple http server with anyEvent tcp_server.
And my script hangs after processing 1018 requests.
I tested it with ab.

#!/usr/bin/perl -w
#
# Simple HTTP server with anyEvent
#

use strict;
use POSIX;
use Getopt::Std;
use Socket;
use IO::Socket;
use AnyEvent;
use AnyEvent::Socket qw/tcp_server/;
use AnyEvent::Handle;

use constant DEFAULT_PORT => 1080;

my $DIRECTORY_ROOT = "/home/test/simple-http-server";

my %commands = (
        "GET"   => \&command_get,
    );

my %status = (
        "200"   => "OK",
        "404"   => "NOT FOUND",
    );

# Parsing command line options
my %opts;
getopts('hdl:p:', \%opts);

if ($opts{'h'}) {
    Usage();
    exit(0);
}

my $log_level = 0;
if ( exists($opts{'l'}) ) {
    $log_level = $opts{'l'};
    $log_level =~ s/\D//g;
}
$log_level = 1 if ($log_level !~ /\d/);

my $port;
if ($opts{'p'}) {
    $port = $opts{'p'};
    $port =~ s/\D//g;
}
$port = DEFAULT_PORT if (!$port);

if ($opts{'d'}) {
    #Turn off log if run as a daemon
    $log_level = 0;
    daemonize();
}

my $condvar = AnyEvent->condvar;

my %input_data = ();
my $clients_count = 0;
my $requests_total = 0;

# Concurrent requests 128 is hardcoded in the AnyEvent::Socket module
print_log(1, "Start new server on $port.\nMax of concurrent requests
128\n");
my $guard = tcp_server "0", $port,
    sub {
        my ($fh, $host, $port) = @_;
        print_log(1, "new connect $fh, $host, $port\n");
        $clients_count++;
        $requests_total++;
        print_log(2, "Active clients count: $clients_count\nTotal processed
requests: $requests_total\n");
        my $hdl = AnyEvent::Handle->new(
            fh => $fh,
            on_error => sub {
                my ($hdl, $fatal, $msg) = @_;
                delete $input_data{"$host:$port"};
                shutdown($fh, 2);
                $hdl->destroy;
                $clients_count--;
            }
        );
        my $id = "$host:$port";
        my $reader;
        $reader = sub {
            if ($_[1]) {
                $input_data{$id} .= $_[1] . "\n";
            } else {
                process_client($fh, $host, $port);
                print_log(2, "close connection $fh, $host, $port\n");
                shutdown($fh, 1);
                delete $input_data{$id};
                $hdl->destroy;
                $clients_count--;
            }
            $hdl->push_read( line => $reader );
        };
        $hdl->push_read( line => $reader );
    },
    sub {
    };

#main loop
AnyEvent->condvar->recv;

=item process_client

=cut
sub process_client {
    my ($client, $host, $port) = @_;

    my $id = "$host:$port";
    print_log(2, "$client $id\n");

    if ( exists($input_data{$id}) ) {
        my @request_headers = ();
        foreach ( split(/\n/, $input_data{$id}) ) {
            push @request_headers, $_;
        }
        foreach ( @request_headers ) {
            my ($command, $param) = split(/ /, $_);
            if (exists($commands{$command})) {
                $commands{$command}->($client, $param);
            }
        }
    }
}

=item command_get

=cut
sub command_get {
    my $client = shift;
    my $param = shift;

    my $content = "";
    $param =~ s/\.\.//g;
    my $status_code;
    my $file;
    my $file_name = $DIRECTORY_ROOT . $param;
    if ( -f $file_name && open($file, $file_name)) {
        $status_code = "200";
        {
            local $/ = undef;
            $content = <$file>;
        }
        close($file);
    } else {
        $status_code = "404";
        $content = "";
    }
    syswrite($client, "HTTP/1.0 " . $status_code . " " .
$status{$status_code} . "\n" );
    syswrite($client, "Content-type: text/html\n");
    syswrite($client, "Content-lenght: " . length($content) . "\n\n");
    syswrite($client, $content);
}

=item print_log
print log info
=cut
sub print_log {
    my $level = shift;
    print STDERR join(" ", @_) if ($level <= $log_level);
}

=item daemonize
run program as a daemon
=cut
sub daemonize {
   setsid() or die "Can't call setsid: $!";
   my $pid = fork() // die "Can't call fork: $!";
   exit(0) if $pid;

   open (STDIN, "</dev/null");
   open (STDOUT, ">/dev/null");
   open (STDERR, ">&STDOUT");
 }

=item Usage
print help screen
=cut
sub Usage {
    print <<EOF
Usage $0 [-h] | [-d] [-l LogLevel] [-p Port]
  -h  display this help and exit
  -d  run as a daemon
  -l  set log level of the messages. 1 by default. 0 to turn off.
  -p  listen on Port

EOF
}



-- 
Eduard Ivanov
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.schmorp.de/pipermail/anyevent/attachments/20180918/47ff28b5/attachment.html>