Fork (and exec) in a threaded script.

[Koszalek Opalek]

I know that one has to be cautious when using threads and forks in one
script/program (and that applies not only to perl). On the other hand,
a fork() followed immediately be exec() looks like a sensible thing to
do. Is there a way to do it safely in perl?

The script below uses two threads -- one spawns new processes and the
other watches the processes in the %PIDS hash. (It could be easily
rewritten without threads but that is beside the point). The script
usually crashes after just a few seconds under perl 5.8.9. (verified
on Linux/Fedora and FreeBSD). The crash happens also after commenting
out the warn statements.

Is it possible to fix this?


#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;

use POSIX ":sys_wait_h";

use constant {
RUNNING => 1,
ERROR => 2
};



my %PIDS : shared = ();
my $STATE : shared = RUNNING;

$| = 1;
$SIG{'CHLD'} = \&reaper;



sub reaper {
lock( %PIDS );
while( my $pid = waitpid( -1, WNOHANG ) ) {
if( WIFEXITED( $? )) {
delete $PIDS{$pid};
}
}
$SIG{'CHLD'} = \&reaper;
}

sub watcher_loop {
warn sprintf( "Thread created: %s", (caller 0)[3]);

my $state = RUNNING;
while( $state == RUNNING ) {
{
lock( %PIDS );
my( $pid, $time );
while (my( $pid, $time ) = ( each %PIDS )) {
if( ! kill 0, $pid ) {
warn sprintf( "Process %d disappeared from the
process list", $pid );
lock( $STATE );
$STATE = ERROR;
}
}
}
{
lock( $STATE );
$state = $STATE;
cond_timedwait( $STATE, 3 );
}
}
}

sub spawn_loop {
warn sprintf( "Thread created: %s", (caller 0)[3]);

my $state = RUNNING;
while( $state == RUNNING ) {
my $cnt;
{
lock( %PIDS );
$cnt = scalar( keys %PIDS );
}

if( $cnt < 3 ) {
warn "$cnt processes running. Will spawn a new process
now.";

my $pid;
if( $pid = fork ) {
lock( %PIDS );
$PIDS{$pid} = time;
}
else {
exec( '( ls -l; sleep 1 ) > /dev/null' );
}
}
{
lock( $STATE );
$state = $STATE;
cond_timedwait( $STATE, 3 );
}
}
}

my @threads = (
threads->new( \&watcher_loop ),
threads->new( \&spawn_loop ),
);

warn sprintf( "Joining %d threads.", scalar @threads );
for( @threads ) {
$_->join;
}

 

[Andrzej Adam Filip]

I know that one has to be cautious when using threads and forks in one
script/program (and that applies not only to perl). On the other hand,
a fork() followed immediately be exec() looks like a sensible thing to
do. Is there a way to do it safely in perl?

The script below uses two threads -- one spawns new processes and the
other watches the processes in the %PIDS hash. (It could be easily
rewritten without threads but that is beside the point). The script
usually crashes after just a few seconds under perl 5.8.9. (verified
on Linux/Fedora and FreeBSD). The crash happens also after commenting
out the warn statements.

Is it possible to fix this?
[...]

Wording of "man threads" suggest setting signals handlers *in threads*
themselves - you seem to set the handlers only in main thread.

 

[Koszalek Opalek]

Wording of "man threads" suggest setting signals handlers *in threads*
themselves - you seem to set the handlers only in main thread.

It only says it's possible to send signals to individual threads.

Anyway, I was unable to make this work for SIG{'CHLD'}. (Ignoring
the signal in one thread and handling it with waitpid in another
left me with zoombie processes.)

K.

 

[Koszalek Opalek]

I know that one has to be cautious when using threads and forks in one
script/program (and that applies not only to perl). On the other hand,
a fork() followed immediately be exec() looks like a sensible thing to
do. Is there a way to do it safely in perl?

I am unable to crash the script I posted on perl 5.12.

However, after a while it gets stuck and the following process tree:

$ ps -o pid,etime,state,args -t pts/18 --forest
PID ELAPSED S COMMAND
2775 35:36 S /bin/bash
9318 00:02 S \_ /usr/bin/perl ./aa.pl
9333 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9335 00:00 S | \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9339 00:00 S | \_ sleep 1
9334 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9338 00:00 S | \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9341 00:00 S | \_ sleep 1
9336 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9342 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9344 00:00 S \_ sleep 1

is changed into something like this:

$ ps -o pid,etime,state,args -t pts/18 --forest
PID ELAPSED S COMMAND
2775 35:31 S /bin/bash
9060 01:36 S \_ /usr/bin/perl ./aa.pl
9078 01:35 S \_ /usr/bin/perl ./aa.pl
9205 01:21 S \_ /usr/bin/perl ./aa.pl
9250 01:11 Z \_ [sh] <defunct>

So is it me or perl?

K.

 

[Rainer Weikusat]

I know that one has to be cautious when using threads and forks in one
script/program (and that applies not only to perl). On the other hand,
a fork() followed immediately be exec() looks like a sensible thing to
do. Is there a way to do it safely in perl?

I am unable to crash the script I posted on perl 5.12.

However, after a while it gets stuck and the following process tree:

$ ps -o pid,etime,state,args -t pts/18 --forest
PID ELAPSED S COMMAND
2775 35:36 S /bin/bash
9318 00:02 S \_ /usr/bin/perl ./aa.pl
9333 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9335 00:00 S | \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9339 00:00 S | \_ sleep 1
9334 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9338 00:00 S | \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9341 00:00 S | \_ sleep 1
9336 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9342 00:00 S \_ sh -c ( ls -l; sleep 1 ) > /dev/null
9344 00:00 S \_ sleep 1

is changed into something like this:

$ ps -o pid,etime,state,args -t pts/18 --forest
PID ELAPSED S COMMAND
2775 35:31 S /bin/bash
9060 01:36 S \_ /usr/bin/perl ./aa.pl
9078 01:35 S \_ /usr/bin/perl ./aa.pl
9205 01:21 S \_ /usr/bin/perl ./aa.pl
9250 01:11 Z \_ [sh] <defunct>

So is it me or perl?

You are quite obviously using POSIX threads and this means that a
signal sent to the process can be handled by any thread not currently
blocking it. This includes your 'main program' thread that blocks
forever in join.