I have a perl script which emulates a tee command so I can get output written to the terminal and a log file. It works something like this (error checking &c omitted).
$pid = open(STDOUT, '-|');
# Above is perl magic that forks a process and sets up a pipe with the
# child's STDIN being one end of the pipe and the parent's STDOUT (in
# this case) being the other.
if ($pid == 0)
{
# Child.
# Open log file
while (<STDIN>)
{
# print to STDOUT and log file
}
#close log files
exit;
}
# parent
open STDERR, '>&STDOUT';
# do lots of system("...") calls
close STDERR;
close STDOUT;
exit;
This sometimes hangs, and invariably if you look at the processes and the stacks of said processes, the parent is hanging in one of the closes, waiting for the child to exit, whereas the child is hanging reading something from a file (which has to be STDIN, because there's no other file).
I'm rather at a loss as to how to deal with this. The problem seems to happen if you are running the program from a shell that isn't attached to a console - running the script in a normal shell works fine - and the only piece of code that has changed recently in that script is the addition of an open/close of a file just to touch it (and it's before the script gets to this 'tee' code).
Has anybody had problems like this before and/or have a suggestion as to what I can do to fix this? Thanks.
Well, after some experimentation it seems that opening STDOUT directly appears to be at least part of the reason. My code now reads like this:
$pid = open($handle, '|-');
if ($pid == 0)
{
# Child.
# Open log file
while (<STDIN>)
{
# print to STDOUT and log file
}
#close log files
exit;
}
# parent
open my $oldout, '>&STDOUT';
open my $olderr, '>&STDERR';
open STDOUT, '>&', $handle;
open STDERR, '>&', $handle;
# do lots of system("...") calls
open STDOUT, '>&', $oldout;
open STDERR, '>&', $olderr;
close $handle or die "Log child exited unexpectedly: $!\n";
exit;
which if nothing else, looks cleaner (but still messier than I'd like as I don't know what to do if any of those dups has an error). But I'm still unclear as to why opening and closing a handle much earlier in the code made such a difference to this bit.
Related
I'm trying to figure this out but haven't been able to wrap my head around it. I need to open a piped subprocess and read from its output. Originally I was using the standard open() call like this:
#!/usr/bin/perl;
use warnings;
use strict;
use Scalar::Util qw(openhandle);
use IPC::Open3;
my $fname = "/var/log/file.log.1.gz";
my $pid = open(my $fh, "-|:encoding(UTF-8)", "gunzip -c \"$fname\" | tac");
# Read one line from the file
while (my $row = <$fh>) {
print "Row: $row\n";
last; # Bail out early
}
# Check if the PID is valid and kill it if so
if (kill(0, $pid) == 1) {
kill(15, $pid);
waitpid($pid, 0);
$pid = 0;
}
# Close the filehandle if it is still open
if (openhandle($fh)) {
close $fh;
}
The above works, except that I get errors from tac in the logs saying:
tac: write error
From what I can tell from various testing and research that I've done, this is happening because killing the PID returned from open() just kills the first child process (but not the second) and so when I then close the filehandle, tac is still writing to it, thus the "write error" due to the broken pipe. The strange thing is, at times when I check ($? >> 8) if the close() call returns false, it will return 141, indicating it received a SIGPIPE (backing up my theory above). However, other times it returns 0 which is strange.
Furthermore, if I run the same command but without a double-pipe (only a single one), like this (everything else the same as above):
my $pid = open(my $fh, "-|:encoding(UTF-8)", "gunzip -c \"$fname\"");
...I'll get an error in the logs like this:
gzip: stdout: Broken pipe
...but in this case, gunzip/gzip was the only process (which I killed via the returned PID), so I'm not sure why it would still be writing to the pipe when I close the filehandle (since it was supposed to be killed already, AND waited for with waitpid()).
I'm trying to repro this in the Perl debugger but its difficult because I can't get the stderr of the child process with plain open() (the way I'm seeing the external process' stderr in prod is in the apache2 logs - this is a CGI script).
I understand from reading the docs that I can't get the PID of all child processes in a multi-piped open with open(), so I decided to try and resort to a different method so that I could close all processes cleanly. I tried open3(), and interestingly, without making any changes (literally running basically the same exact scenario as above but with open3() instead of open()):
my $pid = open3(my $in, my $fh, undef, "gunzip -c \"$fname\"");
...and then killing it just like I did above, I don't get any errors. This holds true for both the single piped process as shown above, as well as the double-piped process that involves piping to "tac".
Therefore, I'm wondering what I am missing here? I know there are differences in the way open() and open3() work, but are there differences in the way that child processes are spawned from them? In both cases I can see that the initial child (the PID returned) is itself a child of the Perl process. But its almost as if the process spawned by open(), is not getting properly killed and/or cleaned up (via waitpid()) while the same process spawned by open3() is, and that's the part I can't figure out.
And, more to the bigger picture and the issue at hand - what is the suggestion for the best way to cleanly close a multi-piped process in this sort of scenario? Am I spending more time than is warranted on this? The script itself works as it should aside from these errors, so if it turns out that the tac and gzip errors I'm seeing are inconsequential, should I just live with them and move on?
Any help is much appreciated!
If you just want to read the last line of a gzipped file, it's easy to do it in pure perl without calling an external program:
#!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;
use IO::Uncompress::Gunzip qw/$GunzipError/;
my $fname = 'foo.txt.gz';
my $z = new IO::Uncompress::Gunzip $fname or die "Couldn't open file: $GunzipError\n";
my $row;
while (<$z>) {
$row = $_;
}
say "Row: $row";
This happens because either your perl script or its parent is ignoring the SIGPIPE signal, and the ignore signal dispositions are inherited by the children.
Here is a simpler testcase for your condition:
$ perl -e '$SIG{PIPE}="IGNORE"; open my $fh, "-|", "seq 100000 | tac; true"; print scalar <$fh>'
100000
tac: write error
$ (trap "" PIPE; perl -e 'open my $fh, "-|", "seq 100000 | tac"; print scalar <$fh>')
100000
tac: write error
$ (trap "" PIPE; perl -e 'my $pid = open my $fh, "-|", "seq 100000 | tac"; print scalar <$fh>; kill 15, $pid; waitpid $pid, 0')
100000
$ tac: write error
The latter version does the same kill as the version from the OP, which will not kill either the right or left side of the pipeline, but the shell running and waiting for both (some shells will exec through the left side of a pipeline; with such shells, a ; exit $? could be appended to the command in order to reproduce the example).
A case where SIGPIPE is ignored upon entering a perl script is when run via fastcgi -- which sets the SIGPIPE disposition to ignore, and expects the script to handle it. In that case simply setting an SIGPIPE handler instead of IGNORE (even an empty handler) would work, since in that case the signal disposition will be reset to default upon executing external commands:
$SIG{PIPE} = sub { };
open my $fh, '-|', 'trap - PIPE; ... | tac';
When run as a standalone script it could be some setup bug (I've see it happen in questions related to containerization on Linux), or someone trying to exploit buggy programs running with elevated privileges not bothering to handle write(2) errors (EPIPE in this case).
my $pid = open3(my $in, my $fh, undef, "gunzip -c \"$fname\"");
...and then killing it just like I did above, I don't get any errors.
Where should you get the errors from, if you're redirecting its stderr to the same $fh you only read the first line from?
The thing is absolutely no different with open3:
$ (trap "" PIPE; perl -MIPC::Open3 -e 'my $pid = open3 my $in, my $out, my $err, "seq 100000 | tac 2>/dev/tty"; print scalar <$out>')
100000
$ tac: write error
A common functions script that our systems use uses a simple STDERR redirect in order to create user-specific error logs. it goes like this
# re-route standard out to text file
close STDERR;
open STDERR, '>>', 'd:/output/Logs/STDERR_' . &parseUsername($ENV{REMOTE_USER}) . '.txt'
or die "couldn't redirect STDERR: $!";
Now, I copy-pasted this to my own functions script for a system-specific error log, and while it'll compile, it breaks the scripts that require it. Oddly enough, it doesn't even print the error that the children script are throwing. My slightly modified version looks like,
close STDERR;
open (STDERR, '>>', 'err/STDERR_SPORK.txt')
or die print "couldn't redirect STDERR: $!";
everything compiles fine in command prompt, -c returns ok, and if I throw a warn into the function script, and compile, it outputs properly. I still do not understand why though this kills the children. I cut out the redirect, and sure enough they work. Any thoughts?
die (and warn) writes to STDERR. If you close STDERR and then need to die as you attempt to reopen it, where would you expect to see the error message?
Since this is Perl, there are many ways to address this issue. Here are a couple.
open the file first to a tmp filehandle, reassign it to STDERR if everything goes ok
if (open my $tmp_fh, '>>',
'd:/output/Logs/STDERR_' . &parseUsername($ENV{REMOTE_USER}) . '.txt') {
close STDERR;
*STDERR = *$tmp_fh;
} else {
die "couldn't redirect STDERR: $!";
}
Use con. For programs that you run from a command line, most systems have a concept of "the current terminal". In Unix systems, it's /dev/tty and on Windows, it's con. Open an output stream to this terminal pseudo-file.
open STDERR, '>>',
'd:/output/Logs/STDERR_' . &parseUsername($ENV{REMOTE_USER}) . '.txt'
or do {
open my $tty_fh, '>', 'con';
print $tty_fh "couldn't redirect STDERR: $!";
exit 1;
};
After changing nothing in the script, and poking around in the server, and changing nothing, it now works as expected. I don't know what to say to be honest.
I've been using Daemon::Simple to quickly Daemonise some scripts and also make them start/stop capable. However, some of these scripts are written in python, so I generally call Daemon::Simple::Init() then exec() the python script.
However, I've found that Daemon::Simple::Init() closes STDOUT and STDERR, and it seems as a result of this the python scripts break (just exit) when they write to STDOUT and STDERR. Reopening STDOUT and STDERR and redirecting them to a file before the exec does not help.
What I've found does help is changing the source of Daemon::Simple from this:
close(STDOUT);
close(STDERR);
to:
open STDOUT, "/dev/null"
open STDERR, "/dev/null"
If I then again open STDOUT and STDERR and redirect them to real files after calling Daemon::Simple:Init() like before, this time it works. It seems that closing STDOUT and STDERR and reopening somehow breaks them post exec(), but opening them to /dev/null and reopening them works fine.
Is there anyway I can reopen or keep open STDOUT and STDERR without modifying Daemon::Simple which survives an exec()?
Are those the same lines you were using to try to reopen STDERR and STDOUT? If so the problem is likely that you're opening them for reading not for writing. Try using
open STDOUT, '>', '/dev/null';
Does this work for you?
use Daemon::Simple;
open(SAVEOUT, ">&STDOUT");
open(SAVEIN, "<&STDIN");
Daemon::Simple::init("daemon");
open(STDOUT, ">&SAVEOUT");
open(STDIN, "<&SAVEIN");
exec("python-script") or die "exec failed: $!";
I want to fork a child ( which is my C executable ) and share a pipe between perl and C process,
Is it possible to have STDOUT and STDIN to use as pipe.
Tried with following code but child process keep continue running.
use IPC::Open2;
use Symbol;
my $CHILDPROCESS= "chile.exe";
$WRITER = gensym();
$READER = gensym();
my $pid = open2($READER,$WRITER,$CHILDPROCESS);
while(<STDIN>)
{
print $WRITER $_;
}
close($WRITER);
while(<$READER>)
{
print STDOUT "$_";
}
The Safe Pipe Opens section of the perlipc documentation describes a nice feature for doing this:
The open function will accept a file argument of either "-|" or "|-" to do a very interesting thing: it forks a child connected to the filehandle you've opened. The child is running the same program as the parent. This is useful for safely opening a file when running under an assumed UID or GID, for example. If you open a pipe to minus, you can write to the filehandle you opened and your kid will find it in his STDIN. If you open a pipe from minus, you can read from the filehandle you opened whatever your kid writes to his STDOUT.
But according to the perlport documentation
open
open to |- and -| are unsupported. (Win32, RISC OS)
EDIT: This might only work for Linux. I have not tried it for Windows. There might be a way to emulate it in Windows though.
Here is what you want I think:
#Set up pipes to talk to the shell.
pipe(FROM_PERL, TO_C) or die "pipe: $!\n";
pipe(FROM_C, TO_PERL) or die "pipe: $!\n";
#auto flush so we don't have (some) problems with deadlocks.
TO_C->autoflush(1);
TO_PERL->autoflush(1);
if($pid = fork()){
#parent
close(FROM_PERL) or die "close: $!\n";
close(TO_PERL) or die "close: $!\n";
}
else{
#child
die "Error on fork.\n" unless defined($pid);
#redirect I/O
open STDIN, "<&FROM_PERL";
open STDOUT, ">&TO_PERL";
open STDERR, ">&TO_PERL";
close(TO_C) or die "close: $!\n";
close(FROM_C) or die "close $!\n";
exec("./cprogram"); #start program
}
Now you can communicate to the shell via FROM_C and TO_C as input and output, respectively.
This Q&A over on Perlmonks suggests that open2 runs fine on Windows, provided you manage it carefully enough.
With the open command in Perl, you can use a filehandle. However I have trouble getting back the exit code with the open command in Perl.
With the system command in Perl, I can get back the exit code of the program I'm running. However I want to just redirect the STDOUT to some filehandle (no stderr).
My stdout is going to be a line-by-line output of key-value pairs that I want to insert into a mao in perl. That is why I want to redirect only my stdout from my Java program in perl. Is that possible?
Note: If I get errors, the errors get printed to stderr. One possibility is to check if anything gets printed to stderr so that I can quite the Perl script.
Canonically, if you're trying to get at the text output of a forked process, my understanding is that's what the backticks are for. If you need the exit status as well, you can check it with the $? special variable afterward, e.g.:
open my $fh, '>', "output.txt" or die $!;
print {$fh} `echo "Hello!"`;
print "Return code: $?\n";
Output to STDERR from the command in backticks will not be captured, but will instead be written directly to STDERR in the Perl program it's called from.
You may want to check out IPC::System::Simple -- it gives you many options for executing external commands, capturing its output and return value, and optionally dying if a bad result is returned.
This is one of the ways to do it.
open my $fh, '>', $file;
defined(my $pid = fork) or die "fork: $!";
if (!$pid) {
open STDOUT, '>&', $fh;
exec($command, #args);
}
waitpid $pid, 0;
print $? == 0 ? "ok\n" : "nok\n";
Use open in -| mode. When you close the filehandle, the exit status will be in $?.
open my $fh, '-|', "$command"; # older version: open my $fh, "$command |";
my #command_output = <$fh>;
close $fh;
my $command_status = $?;
From perldoc -f close
If the file handle came from a piped open, "close" will
additionally return false if one of the other system calls
involved fails, or if the program exits with non-zero status.
(If the only problem was that the program exited non-zero, $!
will be set to 0.) Closing a pipe also waits for the process
executing on the pipe to complete, in case you want to look at
the output of the pipe afterwards, and implicitly puts the exit
status value of that command into $? and
"${^CHILD_ERROR_NATIVE}".