Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re^3: Pre-Forking Daemon with Parallel::ForkManager

by tybalt89 (Parson)
on Oct 20, 2019 at 00:08 UTC ( #11107715=note: print w/replies, xml ) Need Help??


in reply to Re^2: Pre-Forking Daemon with Parallel::ForkManager
in thread Pre-Forking Daemon with Parallel::ForkManager

Ok, that's the simpler version. I don't know if it can be done with Parallel::ForkManager ( and don't really care ), so here's a version using my own Forking::Amazing. There are some tune-able parameters that can be adjusted for best performance in your situation. It is pretty simple with a good forking package :)

#!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11107627 use warnings; use IO::Socket; use Forking::Amazing; my $maxforks = 20; # tune these ... my $clientsperchild = 300; my $port = 6666; my $listen = IO::Socket::INET->new(LocalPort => $port, Listen => 20, Reuse => 1) or die "$@ on listen create"; Forking::Amazing::run $maxforks, sub { print "child $$\n"; process( scalar $listen->accept or return [] ) for 1 .. $clientspe +rchild; return []; }, sub { push @Forking::Amazing::ids, 1 }, (1) x $maxforks; sub process # custom code goe +s in here { my $socket = shift; my $query = <$socket> // return []; # read query print $socket "prefork $$ is answering: $query"; # reply }

And here's the program I used to stress test it. I've been running it with 100 forks and 100 transactions per fork for a total of 10,000 transactions.

#!/usr/bin/perl use strict; use warnings; use IO::Socket; use Forking::Amazing; my $forks = shift // 1; my $sends = shift // 1; my $totalerrors = 0; my $transactions = 0; Forking::Amazing::run $forks, sub { my $errors = 0; my $trans = 0; for ( 1 .. $sends ) { my $s = IO::Socket::INET->new('localhost:6666') or die; my $key = join '', map +('a'..'z')[rand 26], 1 .. 10; print $s "foo|$key\n"; my $answer = join '', <$s>; $answer =~ /$key/ or $errors++; print $answer; close $s; $trans++; } return [ $errors, $trans ]; }, sub { $totalerrors += $_[1][0] // 0; $transactions += $_[1][1] // 0; }, 1 .. $forks; print "total errors: $totalerrors transactions: $transactions\n";

And here's the Forking::Amazing module

package Forking::Amazing; use strict; use warnings; sub run ($&&@) { ( my $maxforks, my $childcallback, my $resultcallback, our @ids ) = +@_; use Storable qw( freeze thaw ); use IO::Select; my @fh2id; my $sel = IO::Select->new; while( @ids or $sel->count ) # unstarted or active { for my $id ( splice @ids, 0, $maxforks - $sel->count ) # allowed f +orks { if( my $pid = open my $fh, '-|' ) # forking open { $sel->add( $fh ); # parent $fh2id[$fh->fileno] = $id; } elsif( defined $pid ) # child { print freeze do {local *STDOUT; open STDOUT, '>&STDERR'; $childcallback-> +($id) }; exit; } else { $resultcallback->( $id, $childcallback->($id) ); } } for my $fh ( $sel->can_read ) # collecting child data { $sel->remove( $fh ); $resultcallback->($fh2id[$fh->fileno], thaw do { local $/; <$fh> + }); } } } 1; __END__ =head1 NAME Forking::Amazing - a fork manager =head1 SYNOPSIS use Forking::Amazing; # small example program use Data::Dump 'dd'; Forking::Amazing::run( 5, # max forks sub { +{id => pop, pid => $$} }, # runs in child sub {dd pop}, # act on result of child in paren +t 'a'..'z'); # ids (one fork for each id) =head1 DESCRIPTION A simple fork manager that runs a limited number of forks at a time, It does callbacks for the code to be run in the children, and the code to be run in the parent when a child exits and returns a +value. =head1 CALLING SEQUENCE Forking::Amazing::run( $maxforks, \&childcallback, \&returncallback, @ +ids); The childcallback runs in a child. The childcallback gets an id as argument, and must return a value that can be processed by Storable::freeze (basically a ref). In the childcallback, STDOUT is redirected to STDERR, The resultcallback runs in the parent. The resultcallback get two arguments, an id and the value returned by a childcallback. @ids can be any scalar including numbers, strings, or refs. @ids can be used to pass starting parameters to a child, for example, to pass two parameters to a child use [ $param1, $param2 ] as + an id. Additional ids can be added by pushing them to @Forking::Amazing::ids =head1 RETURN VALUE Forking::Amazing::run returns after all forked children have finished. There is no return value. =cut

And if you've read this far, here's a version that does variable numbers of children depending on how busy it gets. This version tests OK, but there my be some corner cases I haven't discovered yet. It also has parameters that will probably need tweaking.

#!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11107627 use warnings; use IO::Socket; use Forking::Amazing; my $maxforks = 10; # tune these ... my $forks = my $minforks = 2; my $clientsperchild = 1000; my $lifetime = 10; my $port = 6666; my $listen = IO::Socket::INET->new(LocalPort => $port, Listen => 20, Reuse => 1) or die "$@ on listen create"; Forking::Amazing::run $maxforks, sub { print "child $$\n"; my $idle = 0; $SIG{ALRM} = sub { $idle = 1 }; alarm $lifetime; for (1 .. $clientsperchild) { process( scalar $listen->accept or return [ 1 ] ); $idle and return [ 1 ]; # idle alarm $lifetime; # reset time +out } return [ 0 ]; # not idle }, sub { my $idle = pop()->[0]; if( $idle and $forks > $minforks ) { $forks--; print "forks: $forks\n"; } elsif( ! $idle and $forks < $maxforks ) { push @Forking::Amazing::ids, 1, 1; $forks++; print "forks: $forks\n"; } else { push @Forking::Amazing::ids, 1; } }, (1) x $minforks; sub process # custom code goe +s in here { my $socket = shift; my $query = <$socket>; # read query # select undef, undef, undef, 0.001; print $socket "prefork $$ is answering: $query"; # reply }

Replies are listed 'Best First'.
Re^4: Pre-Forking Daemon with Parallel::ForkManager
by enemyofthestate (Scribe) on Oct 21, 2019 at 17:28 UTC

    I have to say that I like that. It is similar to what I already use but I didn't split my fork code off as a module. Do you mind if I "borrow" some of your code?

      Not at all. If I did, I wouldn't post it here :)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://11107715]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (9)
As of 2019-12-11 08:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?