tcp_server hang

[Mons Anderson]

It’s kinda bad http server. No checks for result of syswrite, no use
of AnyEvent::Handle for this.
Take a look at the source of AnyEvent::HTTP, AnyEvent::HTTPD or
AnyEvent::HTTP::Server (only on github)
On Wed, Sep 19, 2018 at 2:05 AM Eduard Ivanov <houspi at gmail.com> wrote:
>
> 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
> _______________________________________________
> anyevent mailing list
> anyevent at lists.schmorp.de
> http://lists.schmorp.de/mailman/listinfo/anyevent



-- 
Best wishes,
Vladimir V. Perepelitsa aka Mons Anderson
<inthrax at gmail.com>, <mons at cpan.org>
http://github.com/Mons