4
\$\begingroup\$

Here is the function which does exactly what is specified by its name:

sub runCmd_getStdoutStderrAndExitCode(@)
{
  my @cmd = @_;

  # fork a child
  my ($child_pid, $child_stdout, $child_stderr);
  eval
  {
    $child_pid = open3(\*STDIN, # is /dev/null when collectl is a daemon, UPDATE: can pass 'undef' here
                       $child_stdout,
                       $child_stderr,
                       @cmd);
  };
  if ($@ =~ /^open3:/)
  {
    syslog(LOG_ERR, 'Error in "%s" : %s', "@cmd", $@);
    return (undef, undef, -1);
  }

   # result buffers
  my $stdout = '';
  my $stderr = '';

  # read into result buffers avoid blocking
  my $selector = IO::Select->new();
  $selector->add($child_stdout, $child_stderr);
  while (my @ready = $selector->can_read(SOME_TIMEOUT_CONSTANT))
  {
    foreach my $fh (@ready) {
      my $target_buf = ($fh == $child_stdout)
                     ? \$stdout
                         : \$stderr;
      if (!sysread($fh, $$target_buf, 4096, length($$target_buf)))
      {
        $selector->remove($fh);
        close $fh;
      }
    }
  }
  close $_ for ($selector->handles());

  my $finished = waitpid($child_pid, WNOHANG);
  return ($stdout, $stderr, $?) if $finished;

  if (kill 'TERM' => $child_pid) {
    # hang until SIGTERM is processed then bury child process
    waitpid($child_pid, 0);
  } else {
    syslog(LOG_WARNING, 'Error sending TERM to child process "%s"', "@cmd");
  }
  return ($stdout, $stderr, -1);
}

After the script successfully completes its job and before Perl interpreter exits, I get this message in the terminal:

stty: standard input: Bad file descriptor

It would be nice to have your opinion about the code correctness, and get a piece of advice about how to avoid that message, as a bonus.

UPDATE: The message mentioned gone away when I replaced '\*STDIN' arg with 'undef'.

Major update: It appears that this code is not functioning properly. It mixes stderr and stdout from child process, and returns everything back as stdout. I have no clue, why it is so, and I started looking towards replacing my own bicycle with IPC::Run.

UPDATE 2: Finally, here is valid and working replacement of aforementioned bicycle masterpiece. The only disadvantage, in my opition, is that IPC::Run is not part of standard Perl distribution:

sub _runCmd_getStdoutStderrAndExitCode(@)
{
  use IPC::Run qw(run timeout);

  my @cmd = @_;
  my ($out, $err, $ok);

  my @args = (\@cmd, \*STDIN, \$out, \$err);
  push @args, timeout(SOME_TIMEOUT_CONSTANT) if SOME_TIMEOUT_CONSTANT;
  eval{ $ok = run @args };
  if ($@)                    
  {
    return ($out, $err, -1);
  }
  else
  {
    return ($out, $err, ($ok? 0 : $?));
  }
}

Thanks for your comments!

\$\endgroup\$
3
  • \$\begingroup\$ Could that message be related to this bug perhaps? As long as the code works as intended (which is sounds like it does) this should still be on-topic regardless of that message, I think. \$\endgroup\$ Commented Mar 19, 2015 at 16:52
  • \$\begingroup\$ By before Perl interpreter exists, do you mean before the Perl interpreter exits? \$\endgroup\$ Commented Mar 19, 2015 at 16:59
  • \$\begingroup\$ That message makes some sense if your STDIN is /dev/null, as stated in your comment. \$\endgroup\$ Commented Mar 19, 2015 at 17:02

1 Answer 1

5
\$\begingroup\$

as it say in the IPC::Open3 documentation, the filehandle for STDERR cannot be autovivified. You need to

use Symbol qw/ gensym /; my $stderr = gensym;

to create a file handle before opening your command.

\$\endgroup\$

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.