http://qs321.pair.com?node_id=1187069

processor has asked for the wisdom of the Perl Monks concerning the following question:

Hy Monks i am new in perl world. i created TCP relay a week ago using Perl EV 4.22. the script always die after 1 days running and there is no warning and error generated from the script. i hope someone can figureout what is the problem. Here is my full code:

#!/usr/bin/env perl use strict; use warnings; use Socket qw(IPPROTO_TCP TCP_NODELAY); use IO::Socket; use EV; use Fcntl; $| = 1; my $all_data = {}; my $server = IO::Socket::INET->new(Listen => SOMAXCONN, LocalAddr => '0.0.0.0', LocalPort => 8080, Proto => 'tcp', Reuse => 1, Blocking => 0 ) or die "ERROR in Socke +t Creation : $!\n"; $server->autoflush(1); print "Server listening on socket 8080\n"; $server->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1); my $w_server; $w_server = EV::io $server, EV::READ, \&create_client; EV::run; sub all_error{ my ($fh) = @_; my $data = delete $all_data->{$fh}; $data->{keep_alive}->stop; undef $data->{keep_alive}; $data->{client_w}->stop; $data->{client_r}->stop; $data->{agent_w}->stop if $data->{agent_w}; $data->{agent_r}->stop if $data->{agent_r}; $data->{agent}->shutdown(2) if $data->{agent}; $data->{client}->shutdown(2); close $data->{agent} if $data->{agent}; close $data->{client}; undef $data->{client_w} ; undef $data->{client_r} ; undef $data->{agent_w} ; undef $data->{agent_r} ; %{$data} = (); undef %{$data}; #push @cache_data, $data; }; sub create_agent{ my ($data,$host, $port) = @_ ; my $agent = IO::Socket::INET->new(PeerAddr => "$host", PeerPort => $port, Proto => 'tcp', Blocking => 0); if(!$agent){ all_error $data->{client_r}->fh; return 1; }; $agent->autoflush(1); $agent->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1); $data->{agent} = $agent; $data->{agent_w} = EV::io $agent, EV::WRITE, sub { my ($w, $event) = @_ ; $w->stop; if($w->data->{agent_connected}){ my $ln = syswrite $w->fh, $w->data->{agent_wdata}; if(!$ln){ #print "1\n"; all_error $w->data->{client}; return 1; }; $w->data->{client_r}->start; } else { if($w->fh->connected){ $w->data->{client_wdata} = "HTTP/1.1 200 OK\r\nHost: 123 +.xl.co.id/min_balance7\r\n\r\n"; $w->data->{client_w}->start; $w->data->{agent_connected} = 1; #$w->data->{agent_r}->start; $w->data->{client_r}->start; } else { #print "2"; all_error $w->data->{client}; return 1; }; }; }; $data->{agent_r} = EV::io_ns $agent, EV::READ, sub { my ($w, $event) = @_ ; my $buf; $w->stop; my $ln = sysread $w->fh, $buf, 8192; if(!$ln){ #print "3"; all_error $w->data->{client}; return 1; } else{ $w->data->{client_wdata} = $buf; $w->data->{client_w}->start; }; }; $data->{agent_r}->data($data); $data->{agent_w}->data($data); }; sub create_client{ my ($w, $event) = @_ ; my $client = $server->accept; fcntl($client, F_SETFL, O_NONBLOCK) ; if(!$client){ undef $w; return 1; }; $client->autoflush(1); $client->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1); my $data; $data->{agent_connected} = 0; $data->{agent_count} = 0; $data->{client_count} = 0; $data->{client} = $client; $all_data->{$client} = $data; $data->{keep_alive} = EV::timer_ns 120, 0, sub { my $w = shift; #print "5"; all_error $w->data->{client}; return 1; }; $data->{client_w} = EV::io_ns $client, EV::WRITE, sub { my ($w, $event) = @_ ; $w->stop; if($w->data->{client_wdata}){ my $ ln = syswrite $w->fh, $w->data->{client_wdata} +; if(!$ln){ #print "6"; all_error $w->data->{client}; return 1; }; }; $w->data->{agent_r}->start if $data->{agent_r}; $w->data->{keep_alive}->stop; $w->data->{keep_alive}->set(120,0); $w->data->{keep_alive}->start; }; $data->{client_r} = EV::io $client, EV::READ, sub { my ($w, $event) = @_ ; my ($buf, $ln); $w->stop; $ln = sysread $w->fh, $buf, 8192; if(!$ln){ #print "7"; all_error $w->data->{client}; return 1; } else{ $w->data->{keep_alive}->stop; $w->data->{keep_alive}->set(120,0); $w->data->{keep_alive}->start; if($w->data->{client_count} == 0){ if($ln < 15){ all_error $w->data->{client}; return 1; }; my @uri = split " ",$buf,3 ; if(scalar @uri < 3){ all_error $w->data->{client}; return 1; } my ($dummy,$pass, $command, $host, $port, $dum +my2) = split "/", $uri[1]; if($pass && $pass eq "4pr1l" && $host && $port + && $command){ create_agent $w->data, $host, $port; } else { #print "8"; all_error $w->data->{client_r}->fh; return 1; }; } # elsif($w->data->{client_count} == 1){ else{ my @data = map{ $_ = sprintf("%s",chr(sprintf("%d",ord($_ +)) ^ 0x01)) }split("",$buf); $w->data->{agent_wdata} =join "",@data; $w->data->{agent_w}->start; # print join "", @data; }; # else{ # $w->data->{agent_wdata} = $buf; # $w->data->{agent_w}->start; # }; }; $w->data->{client_count} = 2; }; $data->{keep_alive}->data($data); $data->{client_r}->data($data); $data->{client_w}->data($data); $data->{keep_alive}->start; };

Regard
Processor

#sorry for bad english

Replies are listed 'Best First'.
Re: Perl EV script always closed with no warnings and error
by Krambambuli (Curate) on Apr 05, 2017 at 11:01 UTC
    Is the server 'just dying', even when doing nothing and just sitting there?
    Are there any requests hitting the server, do you maye monitor (tcpdump?) port 8080?
    On what platform are you?

    Your code compiles and runs without any hickup on my WS (Linux, Fedora 25), but I'm not sure how to try to reproduce what might be hitting you.

      I have test it 10 times with nodejs script 10k concurrent connection and every connection sending http request to google.com. It doesn't have problem. But if i tunnel data from my client pc, the server "just die" after 1 day running. i use linux debian jessie, perl5.25, perl5.20.
        Maybe you can track it down a little bit by logging 'everything'.

        I'd start by letting tcpdump log everything on input, everything on output into a file.

        Once the server dies, the final parts of the logs might help finding out what is wrong.
        Even if there is some bug to be found - I'd suspect some bad request - being able to reproduce the issue at will would be a huge help for debugging.

        Also, monitor the server's size while running. Maybe it runs out of memory if there are some sort of memory leaks...?

        Simply looking on the code and find what might be wrong is really hard, most of the time.
Re: Perl EV script always closed with no warnings and error
by processor (Initiate) on Apr 07, 2017 at 11:49 UTC
    Dear monks,

    After 2 days running my script, i have found what causing my script dying after 1 days. The problem is not from the script. The problem comes from nohup. Before, I run the script using nohup on ssh session. The script run at pseudo terminal which dying after 1 day. now i run the script using "su - user -c 'nohup script'" to remove the pts. Everything fine now. Thank you for all help. Below is my full code after some modification, maybe someone want to use it as an example for "simple server and client socket in perl EV with forking and xor decrypt".

    #!/usr/bin/env perl use strict; use warnings; use Socket qw(IPPROTO_TCP TCP_NODELAY); use IO::Socket; use EV; use Fcntl; $| = 1; my $server = IO::Socket::INET->new(Listen => SOMAXCONN, LocalAddr => '0.0.0.0', LocalPort => 8080, Proto => 'tcp', Reuse => 1, Blocking => 0 ) or die "ERROR in Socke +t Creation : $!\n"; $server->autoflush(1); print "Server listening on socket 8080\n"; $server->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1); my $pid = fork ; my $i = 1; my $xor = "\x01"; while($i < 8192){ $xor = $xor . "\x01"; ++$i; }; my $all_data = {}; my $w_server; $w_server = EV::io $server, EV::READ, \&create_client; my $server_data = { sock => $server, ev => $w_server }; $all_data->{$server} = $server_data; EV::run; sub all_error{ my ($fh) = shift; my $data = delete $all_data->{$fh}; $data->{keep_alive}->stop; undef $data->{keep_alive}; $data->{client_w}->stop; $data->{client_r}->stop; $data->{agent_w}->stop if $data->{agent_w}; $data->{agent_r}->stop if $data->{agent_r}; $data->{agent}->shutdown(2) if $data->{agent}; $data->{client}->shutdown(2); close $data->{agent} if $data->{agent}; close $data->{client}; undef $data->{client_w} ; undef $data->{client_r} ; undef $data->{agent_w} ; undef $data->{agent_r} ; %{$data} = (); undef %{$data}; #push @cache_data, $data; }; sub create_agent{ my ($data,$host, $port) = @_ ; my $agent = IO::Socket::INET->new(PeerAddr => "$host", PeerPort => $port, Proto => 'tcp', Blocking => 0); if(!$agent){ all_error $data->{client}; return 1; }; $agent->autoflush(1); $agent->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1); $data->{agent} = $agent; $data->{agent_w} = EV::io $agent, EV::WRITE, sub { my ($w, $event) = @_ ; $w->stop; if($w->data->{agent_connected}){ my $ln = syswrite $w->fh, $w->data->{agent_wdata}; if(!$ln){ #print "1\n"; all_error $w->data->{client}; return 1; } $w->data->{client_r}->start; } else { if($w->fh->connected){ $w->data->{client_wdata} = "HTTP/1.1 200 OK\r\nHost: 123 +.xl.co.id/min_balance7\r\n\r\n"; $w->data->{client_w}->start; $w->data->{agent_connected} = 1; #$w->data->{agent_r}->start; $w->data->{client_r}->start; } else { #print "2"; all_error $w->data->{client}; return 1; }; }; }; $data->{agent_r} = EV::io_ns $agent, EV::READ, sub { my ($w, $event) = @_ ; my $buf; $w->stop; my $ln = sysread $w->fh, $buf, 8192; if(!$ln){ #print "3"; all_error $w->data->{client}; return 1; } else{ $w->data->{client_wdata} = $buf; $w->data->{client_w}->start; }; }; $data->{agent_r}->data($data); $data->{agent_w}->data($data); }; sub create_client{ my ($w, $event) = @_ ; my $client = $server->accept; if(!$client){ return 1; }; fcntl($client, F_SETFL, O_NONBLOCK) ; $client->autoflush(1); $client->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1); my $data; $data->{agent_connected} = 0; $data->{agent_count} = 0; $data->{client_count} = 0; $data->{client} = $client; $all_data->{$client} = $data; $data->{keep_alive} = EV::timer_ns 120, 0, sub { my $w = shift; #print "5"; all_error $w->data->{client}; return 1; }; $data->{client_w} = EV::io_ns $client, EV::WRITE, sub { my ($w, $event) = @_ ; $w->stop; if($w->data->{client_wdata}){ my $ ln = syswrite $w->fh, $w->data->{client_wdata} +; if(!$ln){ #print "6"; all_error $w->data->{client}; return 1; }; }; $w->data->{agent_r}->start if $data->{agent_r}; $w->data->{keep_alive}->stop; $w->data->{keep_alive}->set(120,0); $w->data->{keep_alive}->start; }; $data->{client_r} = EV::io $client, EV::READ, sub { my ($w, $event) = @_ ; my ($buf, $ln); $w->stop; $ln = sysread $w->fh, $buf, 8192; if(!$ln){ #print "7"; all_error $w->data->{client}; return 1; } else{ $w->data->{keep_alive}->stop; $w->data->{keep_alive}->set(120,0); $w->data->{keep_alive}->start; if($w->data->{client_count} == 0){ if($ln < 15){ all_error $w->data->{client}; return 1; }; # print $buf; my ($pass, $proto, $host, $port) = auth($buf); if($pass && $pass eq "4pr1l" && $host && $port + && $proto){ create_agent $w->data, $host, $port; } else { #print "8"; all_error $w->data->{client}; return 1; }; } # elsif($w->data->{client_count} == 1){ else{ my $enc = substr $xor,0,length($buf); $w->data->{agent_wdata} = $buf ^ $enc; $w->data->{agent_w}->start; }; # else{ # $w->data->{agent_wdata} = $buf; # $w->data->{agent_w}->start; # }; }; $w->data->{client_count} = 2; }; $data->{keep_alive}->data($data); $data->{client_r}->data($data); $data->{client_w}->data($data); $data->{keep_alive}->start; }; sub auth{ my ($buf) = @_; my ($pass, $proto, $host, $port) = ("","","",""); my $i = 0; my $status = 0; while($i < length $buf){ my $tmp = substr $buf,$i,1; if($tmp eq "/"){ ++$status; ++$i; if($status == 5){ last; } next; } if($status == 1){ $pass = $pass . $tmp; } elsif($status == 2){ $proto = $proto . $tmp; } elsif($status == 3){ $host = $host. $tmp; } elsif($status == 4){ $port = $port . $tmp; } ++$i; } return ($pass, $proto, $host, $port); };
Re: Perl EV script always closed with no warnings and error
by karlgoethebier (Abbot) on Apr 05, 2017 at 10:27 UTC

    BTW, did you read this?

    «The Crux of the Biscuit is the Apostrophe»

    Furthermore I consider that Donald Trump must be impeached as soon as possible

      What is this mean?

        Perhaps that the author as well as EV could be problematic.

        «The Crux of the Biscuit is the Apostrophe»

        Furthermore I consider that Donald Trump must be impeached as soon as possible