antred
antred

Reputation: 3884

Redirecting STDOUT and STDERR for all child processes that will be started by the parent process

In Perl (using version 5.30.0), is it possible to programmatically (i.e. within my Perl code) change some setting that would cause STDOUT and STDERR to be redirected to a text file for any child processes that my Perl process will start from that point on? The difficulty here is that I do not control the code that actually starts those child processes (if I did, this would be extremely trivial). My hope is that there exists some kind of IO flag that I can set in my Perl process that would cause all newly started child processes to redirect their STDOUT / STDERR channels to a destination of my choice (unless the system() / exec() / whatever call used to start them explicitly supplies another STDOUT / STDERR destination).

The (highly simplified) use case I need this for is the following. I have written a generic library function that performs a task specified by the caller and, among other things, stores all STDOUT / STDERR output generated by that user-provided task in a text file. The task is provided in the shape of a Perl function reference. So far I have merely managed to redirect the STDOUT / STDERR output generated by my Perl process:

    local *STDOUT;
    local *STDERR;

    open( STDOUT, '>', $buildLogFilePath ) or die sprintf(
        "ERROR: [%s] Failed to redirect STDOUT to \"%s\"!\n",
        $messageSubject,
        $buildLogFilePath
    );

    open ( STDERR, '>&', STDOUT ) or die sprintf(
        "ERROR: [%s] Failed to redirect STDERR to \"%s\"!\n",
        $messageSubject,
        $buildLogFilePath
    );

So as long as the user-provided function doesn't start any child processes, my feature works as desired, but the moment it does start a child process, that process's output will just go to the default STDOUT / STDERR channels, effectively breaking my feature.

EDIT: I ended up using the STDOUT / STDERR repointing trick described by ikegami below. To allow easier re-use of this trick, I wrapped the code in a little utility class that redirects STDOUT / STDERR in the constructor and then restores them to their original values in the destructor:

package TemporaryOutputRedirector;

use strict;
use warnings FATAL => 'all';

use Carp::Assert;

sub new
{
    my ( $class, $newDest ) = @_;

    open( my $savedStdout, '>&', STDOUT ) or die sprintf(
        "ERROR: Failed to save original STDOUT in process %i!\n",
        $$
    );

    open( STDOUT, '>', $newDest ) or die sprintf(
        "ERROR: Failed to redirect STDOUT to \"%s\" in process %i!\n",
        $newDest,
        $$
    );

    open( my $savedStderr, '>&', STDERR ) or die sprintf(
        "ERROR: Failed to save original STDERR in process %i!\n",
        $$
    );

    open ( STDERR, '>&', STDOUT ) or die sprintf(
        "ERROR: Failed to redirect STDERR in process %i!\n",
        $$
    );

    my %memberData = (
        'newDest'     => $newDest,
        'savedStdout' => $savedStdout,
        'savedStderr' => $savedStderr
    );

    return bless \%memberData, ref $class || $class;
}

sub DESTROY
{
    my ( $self ) = @_;

    my $savedStdout = $$self{ 'savedStdout' };
    assert( defined( $savedStdout ) );

    open( STDOUT, '>&', $savedStdout ) or warn sprintf(
        "ERROR: Failed to restore original STDOUT in process %i!\n",
        $$
    );

    my $savedStderr = $$self{ 'savedStderr' };
    assert( defined( $savedStderr ) );

    open( STDERR, '>&', $savedStderr ) or warn sprintf(
        "ERROR: Failed to restore original STDERR in process %i!\n",
        $$
    );
}

1;

This way, one only needs to create an instance of TemporaryOutputRedirector, execute the code that should have its output redirected, and then let the TemporaryOutputRedirector fall out of scope and have its destructor restore the original STDOUT / STDERR channels.

Upvotes: 3

Views: 680

Answers (1)

ikegami
ikegami

Reputation: 385565

When you open a file handle, it uses the next available file descriptor. STDIN, STDOUT and STDERR are normally associated with fd 0, 1 and 2 respectively. If there are no other open handles in the process, the next handle created by open will use file descriptor 3.

If you associate fd 3 with STDOUT, many things will keep working. That's because Perl code usually deals with Perl file handles rather than file descriptors. For example, print LIST is effectively print { select() } LIST, which is the same as print STDOUT LIST by default. So your change mostly works within Perl.

However, when you execute a program, all that it gets are the file descriptors. It gets fd 0, 1 and 2. It might even get fd 3, but it doesn't care about that. It will output to fd 1.


A simple solution is to remove local *STDOUT; local *STDERR;.

*STDOUT is a glob, a structure that contains *STDOUT{IO}, the handle in question.

By using local *STDOUT, you are replacing the glob with an empty one. The original one isn't destroyed —it will be restored when the local goes out of scope— so the Perl file handle associated with the now-anonymous glob won't be closed, so the fd associated with that handle won't be closed, so the subsequent open can't reuse that fd.

If you avoid doing local *STDOUT, it means you are passing an open handle to open. open behaves specially in that circumstance: It will "reopen" the fd already associated with the Perl handle rather than creating a new fd.

$ perl -e'
   open( local *STDOUT, ">", "a" ) or die;
   open( local *STDERR, ">&", STDOUT ) or die;
   print(fileno(STDOUT), "\n");
   system("echo foo");
'
foo

$ cat a
3

$ perl -e'
   open( STDOUT, ">", "a" ) or die;
   open( STDERR, ">&", STDOUT ) or die;
   print(fileno(STDOUT), "\n");
   system("echo foo");
'

$ cat a
1
foo

If you want the redirection to be temporary. You have to play with the file descriptors.

$ perl -e'
   open( local *SAVED_STDOUT, ">&", STDOUT) or die;
   open( STDOUT, ">", "a" ) or die;
   print(fileno(STDOUT), "\n");
   system("echo foo");

   open( STDOUT, ">&", SAVED_STDOUT) or die;
   print(fileno(STDOUT), "\n");
   system("echo bar");
'
1
bar

$ cat a
1
foo

Upvotes: 3

Related Questions