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

Parallel::ForkManager or something like that?

by Sascha2018 (Acolyte)
on Aug 11, 2017 at 19:30 UTC ( [id://1197270]=perlquestion: print w/replies, xml ) Need Help??

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

Hello. If have a little Server programmed in IO::Socket and with Module Parallel::ForkManager 
#!/usr/bin/perl

use strict;
no strict 'refs';
use warnings;

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

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

our %clients = ();
our $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";

our $pm = Parallel::ForkManager->new(10);
$pm->run_on_finish(sub{
                   my($pid,$exitcode,$ident,$exitsignal,$coredump,$get
+)=@_;
                   my $sock = $get->{socket};
                   my $ip = $get->{ip};
                   my $id = $get->{ident};
                   $clients{$sock}->{socket} = $sock;
                   $clients{$sock}->{ip} = $ip;
                   $clients{$sock}->{ident} = $id;
});
$server->autoflush(1); 
$select->add($server);


while(!$die){
foreach our $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();
                 $select->add($bay);
                 $pm->start and next;
                 select($bay);
                 $|=1;
                 my @phrase = ("a" .."z","A".."Z",0..9);
                 my $ident = join '', map { $phrase[int rand @phrase] 
+} 1..10; 
                 foreach my $client( keys %clients ){
                    print "Connection from $clients{$client}->{ip} wit
+h Ident $clients{$client}->{ident} and Socket $clients{$client}->{soc
+ket} ... OK\n";
                 }
                 my $data = $pm->finish(0, { ip => $ip, ident => $iden
+t, socket => \*{ $bay } });
           }
}
           $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]
I want to update the %clients Hash in the kind process. Later ( in the kind ) i want to write to each socket in %clients like my $sock = $clients{"WHAT"}->{socket}; $sock->syswrite("hello world"); 
But now i get an error: Cant store GLOB Items in ForkManager.pm

[download]
What i do wrong?

Replies are listed 'Best First'.
Re: Parallel::ForkManager or something like that?
by ikegami (Patriarch) on Aug 12, 2017 at 00:09 UTC

    Handles are tokens that are only meaningful in one process. Passing handles from one process to another can only be done via a very specialized call.

[reply]
Re: Parallel::ForkManager or something like that?
by marioroy (Prior) on Aug 12, 2017 at 02:40 UTC

    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

[reply]
[d/l]
[select]
      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]
        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]

Back to 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: perlquestion [id://1197270]
Approved by thanos1983
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2024-04-23 19:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found