Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re: Parallel::ForkManager or something like that?

by marioroy (Prior)
on Aug 12, 2017 at 02:40 UTC ( [id://1197292]=note: print w/replies, xml ) Need Help??


in reply to Parallel::ForkManager or something like that?

Hello Sascha2018,

See IO::FDPass for passing a handle to a process. Another way is storing the handle into a hash and use $ident as the key. I'm passing $dent to $pm->start($ident). That sets the identification for the process. Inside the on_finish block, remove the entry from the hash.

Well, something like the following. Please adjust the _uid function accordingly, to your specification.

#!/usr/bin/perl

use strict;
use warnings;
use feature 'state';

no strict 'refs';

use IO::Socket;
use IO::Select;
use Parallel::ForkManager;

my $die = 0;
my %lkup;

sub _uid {
    state $uid = 0;
    $uid = 1 if ++$uid > 2e9;
    $uid;
}

$SIG{INT} = sub { $die = 1; exit; };

my %clients = ();
my $select = IO::Select->new;

my $server = IO::Socket::INET->new(
    LocalHost => 'localhost',
    LocalPort => 2222,
    Proto     => 'tcp',
    Listen    => 10000,
    Reuse     => 1,
) or die "Sock Error: $!\n";

my $pm = Parallel::ForkManager->new(10);
$pm->set_waitpid_blocking_sleep(0);

$pm->run_on_finish( sub {
    my ($pid,$exitcode,$ident,$exitsignal,$coredump,$get) = @_;
    $clients{$ident}->{ident}  = $ident;
    $clients{$ident}->{ip}     = $get->{ip};
    $clients{$ident}->{socket} = delete $lkup{$ident};
});

$server->autoflush(1);
$select->add($server);

while (!$die) {
    foreach my $key ($select->can_read()) {  # foreach
        if ($key eq $server) {  # if $bay eq $server
            next if $key eq "";

            my $bay   = $server->accept or next;
            my $ip    = $bay->peerhost();
            my $ident = _uid();

            $lkup{$ident} = $bay;
            $select->add($bay);

            $pm->start($ident) and next;
            select($bay); $| = 1;

            foreach my $client (keys %clients) {
                print "Connection from $clients{$client}->{ip} with Id
+ent $clients{$client}->{ident} and Socket $clients{$client}->{socket}
+ ... OK\n";
            }

            $pm->finish(0, { ip => $ip });
        }
    }

    $pm->wait_all_children;
}

sub sendHeader {
    my $sock = shift;
my $header =<<"EOT";
HTTP/1.0 200 OK
Content-type: text/html
EOT
    $sock->syswrite($header);
}

[download]

Regards, Mario

Replies are listed 'Best First'.
Re^2: Parallel::ForkManager or something like that?
by Sascha2018 (Acolyte) on Aug 12, 2017 at 11:58 UTC
    Hello Mario. Thank you for your answer. I have modified the script a little bit, but if i want to send a http Header to $bay and open the site on http://127.0.0.1:2222 the browser shows me nothing or only if i have luck the script code. But not HTML ... What i do wrong ? 
    #!/usr/bin/perl

use strict;
use warnings;
use feature 'state';

no strict 'refs';

use IO::Socket;
use IO::Select;
use Parallel::ForkManager;

my $die = 0;
my %lkup;
$|=1;

sub _uid {
    state $uid = 0;
    $uid = 1 if ++$uid > 2e9;
    $uid;
}

$SIG{INT} = sub { $die = 1; exit; };

my %clients = ();
my $select = IO::Select->new;

my $server = IO::Socket::INET->new(
    LocalHost => '127.0.0.1',
    LocalPort => 2222,
    Proto     => 'tcp',
    Listen    => 10000,
    Reuse     => 1,
) or die "Sock Error: $!\n";

my $pm = Parallel::ForkManager->new(10);
$pm->set_waitpid_blocking_sleep(0);

$pm->run_on_finish( sub {
    my ($pid,$exitcode,$ident,$exitsignal,$coredump,$get) = @_;
    $clients{$ident}->{ident}  = $ident;
    $clients{$ident}->{ip}     = $get->{ip};
    $clients{$ident}->{socket} = delete $lkup{$ident};
});

$server->autoflush(1);
$select->add($server);

while (!$die) {
    foreach my $key ($select->can_read()) {  # foreach
        if ($key eq $server) {  # if $bay eq $server
            next if $key eq "";

            my $bay   = $server->accept or next;
            my $ip    = $bay->peerhost();
            my $ident = _uid();

            $lkup{$ident} = $bay;
            $select->add($bay);
            my $buffer = <$bay>;
            if( $buffer =~ m/^GET\s\/\sHTTP\/1\.1/ ){
              print "OK";
              sendHeader($bay);
my $html=<<"EOT";
<html>
<head>
</head>
<body style='background-color: blue'>
</body>
</html>
EOT

              $bay->syswrite($html);
            }
            $pm->start($ident) and next;
            print "$buffer\n";
            $pm->finish(0, { ip => $ip });
        }
    }

    $pm->wait_all_children;
}

sub sendHeader {
    my $sock = shift;
my $header =<<"EOT";
HTTP/1.0 200 OK
Content-type: text/html
EOT
    for( 1.. 10 ){
      $sock->syswrite("<!-- Server 2017 //-->\n");
    }
    $sock->syswrite($header);
}

    [download]
[reply]
[d/l]
      Now it works :) And how can i solve it that the processes are not blocking? If i open the address and port through the browser and open another browser where i connect to it, i can see the page only in one windows, till i close the browser. Then i can see the other page. Regards
[reply]
[reply]

        Hi Sascha2018. Run $pm->start before $select->add.

        while (!$die) {
    foreach my $key ($select->can_read()) {  # foreach
        if ($key eq $server) {  # if $bay eq $server
            next if $key eq "";

            my $bay   = $server->accept or next;
            my $ip    = $bay->peerhost();
            my $ident = _uid();

            $lkup{$ident} = $bay;

            $pm->start($ident) and next;    # <-- spawn worker here
            $select->add($bay);
            my $buffer = <$bay>;

            if ($buffer =~ m/^GET\s\/\sHTTP\/1\.1/) {
                print "OK";
                sendHeader($bay);
my $html=<<"EOT";
<html>
<head>
</head>
<body style='background-color: blue'>
</body>
</html>
EOT
                $bay->syswrite($html);
            }
            print "$buffer\n";
            $pm->finish(0, { ip => $ip });
        }
    }

    $pm->wait_all_children;
}

        [download]

        Regards, Mario

[reply]
[d/l]
[select]
      Hello. In another script i have IO::Socket::SSL If i fork() with $pm->start($ident) and next; and call the IO::Socket::SSL->start_SSL() routine later, i only get 
      
DEBUG: .../IO/Socket/SSL.pm:1492: new ctx 44788592
DEBUG: .../IO/Socket/SSL.pm:938: start handshake
DEBUG: .../IO/Socket/SSL.pm:505: starting sslifying

      [download]
      in the console. The handshake does not finish if a client connects. If i make Strg+C on the console i get the rest , but only then. 
      DEBUG: .../IO/Socket/SSL.pm:1528: free ctx 44788592 open=44788592
DEBUG: .../IO/Socket/SSL.pm:1533: free ctx 44788592 callback
DEBUG: .../IO/Socket/SSL.pm:1536: OK free ctx 44788592

      [download]
      Nothing happens in the browser :( What do i wrong?
[reply]
[d/l]
[select]
        Whats wrong with this code ? I get no handshake .... Only i get this message in the console: 
        DEBUG: .../IO/Socket/SSL.pm:1492: new ctx 32253824
DEBUG: .../IO/Socket/SSL.pm:938: start handshake
DEBUG: .../IO/Socket/SSL.pm:505: starting sslifying
DEBUG: .../IO/Socket/SSL.pm:545: Net::SSLeay::accept -> 0
DEBUG: .../IO/Socket/SSL.pm:1203: SSL connect accept failed because of
+ handshake problemserror:00000000:lib(0):func(0):reason(0)

DEBUG: .../IO/Socket/SSL.pm:1528: free ctx 32253824 open=32253824
DEBUG: .../IO/Socket/SSL.pm:1533: free ctx 32253824 callback
DEBUG: .../IO/Socket/SSL.pm:1536: OK free ctx 32253824
SSL accept failed: SSL connect accept failed because of handshake prob
+lemserror:00000000:lib(0):func(0):reason(0) at testserver.pl line 101
+.

        [download]
        use strict;
use warnings;
use feature 'state';

no strict 'refs';


my %lkup;
our %config;
our %language;
our $dbh;

our %srv_modes;
our $HOST = $config{server};
our $PORT = $config{port};
our $last_RnR = time;
our $last_UPDATE = time;
our( %srvban, %loggedin, %rooms) = ((),(),(),());
my $uid;
my $die = 0;


require "config.cfg";
require 5.002;
use IO::Socket::SSL 'inet4';
use IO::Select;
$IO::Socket::SSL::DEBUG = 3;
use Time::HiRes;
use HTML::Template;
use  Text::Wrap;
use Fcntl ':flock';
use strict;
no strict 'refs';
$SIG{INT} = sub{ exit; };

use Parallel::ForkManager;

$|=1;

sub _uid {
    state $uid = 0;
    $uid = 1 if ++$uid > 2e9;
    $uid;
}


my %clients = ();
my $select = IO::Select->new;

my $server = IO::Socket::INET->new(
    LocalHost => 'host',
    LocalPort => 63027,
    Proto     => 'tcp',
    Listen    => 10000,
    Reuse     => 1,
) or die "Sock Error: $!\n";

my $pm = Parallel::ForkManager->new(500);
$pm->set_waitpid_blocking_sleep(0);

$pm->run_on_finish( sub {
    my ($pid,$exitcode,$ident,$exitsignal,$coredump,$get) = @_;
    $clients{$ident}->{ident}  = $ident;
    $clients{$ident}->{ip}     = $get->{ip};
    $clients{$ident}->{socket} = delete $lkup{$ident};
    my $killsock = $get->{killing} || 0;
    my $sock = $clients{$ident}->{socket};
    if($killsock){ 
      delete $clients{$ident};
      $select->remove($sock);
    }
});

$server->autoflush(1);
$select->add($server);

while (1) {
    foreach my $key ($select->can_read()) {  # foreach
        if ($key eq $server) {  # if $bay eq $server
            next if $key eq "";

            our $bay   = $server->accept or next;
            my $ip    = $bay->peerhost();
            our $ident = _uid();

            $lkup{$ident} = $bay;
            $select->add($bay);
            my $buffer = <$bay>;
            $pm->start($ident) and next;
            IO::Socket::SSL->start_SSL($bay,
                                      PeerAddr => $config{server},
                                      SSL_verify_mode => SSL_VERIFY_PE
+ER,
                                      verify_hostname => 1,
                                      SSL_hostname => $config{server},
                                      SSL_port     => $PORT,
                                      SSL_server => 1,
                                         SSL_ca_file => $config{ca_fil
+e},
                                        SSL_ca_path => $config{ca_path
+},
                                      SSL_verifycn_name => 'host',
                                      SSL_verifycn_scheme => 'http',
                                      SSL_cert_file => $config{cert_fi
+le},
                                      SSL_key_file => $config{key_file
+},
                                     ) or die "SSL accept failed: $SSL
+_ERROR";
            my $killing = 0;

            if( defined $buffer && $buffer =~ m/^GET\s\/\?sid=12\sHTTP
+\/1\.1\s/ ){
              print "$buffer";
              sendHeader($bay);
              print "OK";
              for( 1 .. 30 ){ # Firefox and other browsers
              $bay->syswrite("<!-- //--><!-- //--><!-- //--><!-- //-->
+<!-- //-->\n\n");
              }
my $html=<<"EOT";
<html>
<head>
<title>hallo</title>
</head>
<body style='background-color: darkblue; color: #FFFFFF'>
hello world
</body>
</html>
EOT

              $bay->syswrite($html);
            }elsif( defined $buffer && $buffer =~ m/^GET\s\/\?printoal
+l=1\sHTTP\/1\.1\s/ ){
                foreach my $client( keys %clients ){
                    print "$buffer";
                    my $socket = $clients{$client}->{socket};
                    $socket->syswrite("The sun is shining\n");
                    print "Conntected: \n" . keys %clients;
                   
                }
                $killing = 1;
            }
            
            $pm->finish(0, { ip => $ip, killing => $killing });
        }
    }

    $pm->wait_all_children;
}

sub sendHeader {
    my $client = shift;
    if( defined $client ) {
my $header =<<"EOT";
HTTP/1.1 200 OK
Content-type: text/html\n\n
EOT
      $client->syswrite($header);
    }
}

        [download]
        Please help thanks.. Regards Sascha
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://1197292]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others imbibing at the Monastery: (6)
As of 2024-04-23 08:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found