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\$
    – Phrancis
    Mar 19 '15 at 16:52
  • \$\begingroup\$ By before Perl interpreter exists, do you mean before the Perl interpreter exits? \$\endgroup\$ Mar 19 '15 at 16:59
  • \$\begingroup\$ That message makes some sense if your STDIN is /dev/null, as stated in your comment. \$\endgroup\$ Mar 19 '15 at 17:02
4
\$\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\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.