in reply to Re: Handling badly behaved system calls in threads
in thread Handling badly behaved system calls in threads

Thanks for giving me something to chew on. I modified your script to run some of these corner cases and everything seems to behave correctly. I'm confused however why your script correctly collects all children when my attempt killed the shell but not the badly behaved grandchild. My code was something like (it has since been deleted, single-threaded version):

my $pid = open my $calc, '-|', "$command 2>&1" or die "Pipe failed on +open: $!\n"; local $SIG{ALRM} = sub { kill 9, $pid; die "Calculation call failed to return with $timeout seconds\n"; }; alarm $timeout; local $/; # Slurp my $content = <$calc>; close $calc; alarm 0;

Is there an obvious behavioral difference? I'm pretty sure this is very close to what I had between Re: killing a program called with system() if it takes too long? and Re^2: Killing children's of children.

Replies are listed 'Best First'.
Re^3: Handling badly behaved system calls in threads
by BrowserUk (Patriarch) on Aug 26, 2010 at 23:23 UTC
    Is there an obvious behavioral difference?

    I missed: 2>&1.

    You're starting a shell, that redirects stderr to stdout and runs perl, that run the script. Hence the pid returned to you from open is the shell, not perl.

    The simplest solution, given the script is yours, is to do that redirection within the script. Optionally, make the redirection dependant upon a command line parameter used for testing only.

    Something like:

    open STDEER, '&=', fileno( STDOUT ) or ... if $TESTING;

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      By "redirection within the script", do you mean perform the redirection in the worker thread or in the called utility?

      Worker: I already redirect STDERR and STDOUT into buffers (local scalars) in every worker so that families of computations have their results contiguously located in the final report. I tried this as well as a bidirectional pipe (Bidirectional Communication with Yourself) but it fails to catch the error output by the child w/o the explicit command line redirect. I suppose I could implement it with IPC::Open3.

      Utility: While the utility is developed by my group, I am not the programmer responsible. It's a C binary (heavy computation) and I philosophically I think it uses channels correctly. Plus the large number of issues my testing script has uncovered in the previous month has not left me as that gentleman's favorite person.

        By "redirection within the script", do you mean perform the redirection in the worker thread or in the called utility?

        Sorry. I thought it was a perl script you were testing, not an executable.

        However, you ought to be able to do the redirection in the parent. This is (a lot) more complex, but in part that's because I had to use Win32::Process in order to get a real pid, whilst avoiding perl *nix emulation invoking a shell.

        As posted it will obviously only run on Windows, but you should be able to tweak my qxx() routine:

        sub qxx { my( $cmd, @args ) = @_; my( $rout, $rerr, $wout, $werr, $proch ); open my $stdout, '>&', \*STDOUT or tcroak( $! ); pipe $rout, $wout or tcroak( $! ); binmode $rout, ':crlf'; open STDOUT, '>&', $wout or tcroak( $! ); open my $stderr, '>&', \*STDERR or tcroak( $! ); pipe $rerr, $werr or tcroak( $! ); binmode $rerr, ':crlf'; open STDERR, '>&', $werr or tcroak( $! ); Win32::Process::Create( $proch, $cmd, join( ' ', $cmd, @args ), 1, NORMAL_PRIORITY_CLASS, "." ) or tcroak( $^E ); close $_ for $wout, $werr; open STDOUT, '>&', $stdout or tcroak( $! ); open STDERR, '>&', $stderr or tcroak( $! ); return $proch->GetProcessID(), $rout, $rerr; }

        (eXtend qx//, that captures both stdout and stderr using seperate pipes.), to use fork/exec in the usual *nix fashion.

        Note also that I've made tprint()/tcroak() use a separate file handle open to the console, so that I can safely log messages whilst stdout and stderr are redirected.

        #! perl -slw use strict; use Data::Dump qw[ pp ]; use Win32::Process qw( NORMAL_PRIORITY_CLASS ); use Time::HiRes qw[ sleep ]; use threads; use threads::shared; use Thread::Queue; our $TIMEOUT //= 10; our $THREADS //= 16; our $PROCESSES //= 100; open DEBUGOUT, '>', 'CON' or die $!; select DEBUGOUT; $|++; select STDOUT; my $semDEBUGOUT :shared; sub tprint{ my $tid = threads->tid; lock $semDEBUGOUT; printf DEBUGOUT "%3d: %s\n", $tid, @_; } sub tcroak{ tprint( @_ ); die scalar caller(); }; sub qxx { my( $cmd, @args ) = @_; my( $rout, $rerr, $wout, $werr, $proch ); open my $stdout, '>&', \*STDOUT or tcroak( $! ); pipe $rout, $wout or tcroak( $! ); binmode $rout, ':crlf'; open STDOUT, '>&', $wout or tcroak( $! ); open my $stderr, '>&', \*STDERR or tcroak( $! ); pipe $rerr, $werr or tcroak( $! ); binmode $rerr, ':crlf'; open STDERR, '>&', $werr or tcroak( $! ); Win32::Process::Create( $proch, $cmd, join( ' ', $cmd, @args ), 1, NORMAL_PRIORITY_CLASS, "." ) or tcroak( $^E ); close $_ for $wout, $werr; open STDOUT, '>&', $stdout or tcroak( $! ); open STDERR, '>&', $stderr or tcroak( $! ); return $proch->GetProcessID(), $rout, $rerr; } sub worker { my $Q = shift; while( defined( my $time = $Q->dequeue ) ) { my $pid :shared; my( $th ) = threads->create( sub { my( $rout, $rerr ); ( $pid, $rout, $rerr ) = qxx( 'c:/perl64/bin/perl.exe', qq[ -le"warn qq/a warning\n/; sleep 1, print for 1 .. +$time; print \$\$, ' done'"] ); tcroak 'Failed to exec' unless $pid; my $out = join( '', <$rout> ) // ''; my $err = join( '', <$rerr> ) // ''; return $out, $err; } ); sleep 1; $th->join && tcroak "Process failed to start" unless $pid; tprint "Started pid $pid for $time seconds"; my $t = 0; sleep 0.1 while kill( 0, $pid ) and $t++ < ( 10 * $TIMEOUT ); if( kill( 9, $pid ) ) { tprint "$pid timed out; killed"; } else { tprint "$pid completed sucessfully"; } my( $out, $err ) = $th->join; tprint "pid $pid returned:\nout:'$out'\nerr:'$err'"; ## Check result; } } my $Q = new Thread::Queue; my @workers = map async( \&worker, $Q ), 1 .. $THREADS; $Q->enqueue( map int( rand 2 * $TIMEOUT ), 1 .. $PROCESSES ); $Q->enqueue( (undef) x $THREADS ); $_->join for @workers;

        An example run:

        c:\test>857569-2 -THREADS=4 -PROCESSES=6 -TIMEOUT=3 1: Started pid 4724 for 5 seconds 2: Started pid 4992 for 3 seconds 3: Started pid 3088 for 4 seconds 4: Started pid 4456 for 3 seconds 1: 4724 timed out; killed 1: pid 4724 returned: out:'' err:'a warning ' 2: 4992 completed sucessfully 3: 3088 timed out; killed 2: pid 4992 returned: out:'1 2 3 4992 done ' err:'a warning ' 4: 4456 completed sucessfully 3: pid 3088 returned: out:'' err:'a warning ' 4: pid 4456 returned: out:'1 2 3 4456 done ' err:'a warning ' 1: Started pid 1924 for 4 seconds 2: Started pid 4784 for 2 seconds 1: 1924 timed out; killed 1: pid 1924 returned: out:'' err:'a warning ' 2: 4784 completed sucessfully 2: pid 4784 returned: out:'1 2 4784 done ' err:'a warning '

        Note that when the child process is killed because of timeout, the "a warning" is still captured from stderr as it is unbuffered and occurs early in the run, but the stdout output is buffered, unflushed and so not captured.


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.