comment on

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;        
};
[download]

Regard
Processor

#sorry for bad english

In reply to Perl EV script always closed with no warnings and error by processor

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


"be consistent"
	PerlMonks