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}".
Related
The documented example in perldoc IPC::Open2 (read from parent STDIN and write to already open handle) is a simplified version of what I'm trying to achieve. Namely, parent writes a preamble to a output file, then a subprocess writes its output directly to the same file.
I've made a simple child script which reads input lines and prints to STDERR and STDOUT. The STDOUT being the the 'already open handle' from the parent.
#!/usr/bin/env perl
##parent.pl
use IPC::Open2;
# read from parent STDIN and write to already open handle
open my $file, '>', 'outfile.txt' or die "open failed: $!";
my $pid = open2($file, "<&STDIN", "./child.pl");
# reap zombie and retrieve exit status
waitpid( $pid, 0 );
my $child_exit_status = $? >> 8;
#!/usr/bin/env perl
##child.pl
while(<STDIN>){
print STDOUT "STDOUT: ",$_;
print STDERR "STDERR: ", $_;
}
print STDERR "END OF CHILD\n";
An example run of parent.pl:
Hello
^D
STDERR: Hello
STDERR: END OF CHILD
However, I don't see the expected "STDOUT: Hello" in the output file 'outfile.txt'
Is there some additional setup I've missed to get this example to work?
open my $file, '>', 'outfile.txt' or die "open failed: $!";
my $pid = open2($file, "<&STDIN", "./child.pl");
This will create a new pipe, and overwrite the $file variable with a handle refering to the read end of the pipe, closing the old file handle in the process ;-)
In order to pass an existing file handle to open2 or open3, you want to use the >&FILEHANDLE format, but I wasn't able to figure out any way to do that when FILEHANDLE is a local variable, as your my $file.
But the undocumented >&NUM or >&=NUM forms (where NUM is a file descriptor number) just work:
open my $file, '>', 'outfile.txt' or die "open failed: $!";
my $pid = open2('>&'.fileno($file), '<&STDIN', './child.pl');
Example:
$ perl -MIPC::Open2 -e '
open my $f, ">foo";
open2(">&".fileno($f), "<&STDIN", "echo bar")
'; cat foo
bar
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'm trying to test a piece of code ($code) that should make sure that only one instance of the program is running at a time:
#!/usr/bin/perl
# test_lock
use strict;
use warnings;
( my $code = <<'CODE') =~ s/^\s+//gm;
#!/usr/bin/perl
use strict;
use warnings;
use Fcntl qw(:flock);
# Make sure only one instance of the program is running at a time.
open our $Lock, '<', $0 or die "Can't lock myself $0: $!";
flock $Lock, LOCK_EX | LOCK_NB
or die "Another instance of $0 is already running. Exiting ...\n";
sleep(2);
CODE
my $progfile = '/tmp/x';
open my $fh, '>', $progfile or die $!;
print $fh $code;
close $fh;
$|++;
my $ex1 = system("perl $progfile &");
print "First system(): $ex1\n";
my $ex2 = system("perl $progfile");
print "Second system(): $ex2\n";
I expected that the second call to system() would return a non-zero value ($ex2) as it can't get the lock and dies. However I get:
$ perl test_lock
First system(): 0
Another instance of /tmp/x is already running. Exiting ...
Second system(): 0
What is wrong with my assumption? (Is there a better way to test the $code?)
I think it likely because you have a race condition. How do you know that error is actually coming from your second process?
Because if you for example, run:
perl /tmp/x & perl /tmp/x ; echo $?
You may get a zero return, because the 'winner' of the race may well be the latter process (which return code you're catching). (Try it a few times, and you'll see different results)
You also do have slight difference is what the shell is doing between the two commands - from the docs:
If there is only one scalar argument, the argument is checked for shell metacharacters, and if there are any, the entire argument is passed to the system's command shell for parsing (this is /bin/sh -c on Unix platforms, but varies on other platforms). If there are no shell metacharacters in the argument, it is split into words and passed directly to execvp , which is more efficient.
So actually you should see invocation of sh before perl in your first, which means it's actually more likely to take longer to get to the lock point.
That means your command is more like:
sh -c "perl /tmp/x"& perl /tmp/x; echo $?
Run that a few times and see how many times you get non-zero error codes. It's not often, because usually the 'delay' of the shell start up is enough to ensure that the second instance wins the race most of the time!
If you've linux - try strace -fTt yourscript which will trace the execution flow. Or you can make judicious use of $$ to report the process-pid when running.
In both cases, you are obtaining the exit code of the shell you launch. Roughly speaking, the shell returns the exit code of the last program it ran.
Since the shell created by system("perl $progfile &") doesn't wait for the child to end, it will virtually always return 0 since launching perl in the background is unlikely to result in an error.
So if the second instance of perl managed to obtain the lock first, you'll get the outcome you got. This race condition can be seem more clearly if you identify the source of the exception.
#!/usr/bin/perl
# test_lock
use strict;
use warnings;
( my $code = <<'CODE') =~ s/^\s+//gm;
#!/usr/bin/perl
use strict;
use warnings;
use Fcntl qw(:flock);
# Make sure only one instance of the program is running at a time.
open our $Lock, '<', $0 or die "Can't lock myself $0: $!";
flock $Lock, LOCK_EX | LOCK_NB
or die "$ARGV[0]: Another instance of $0 is already running. Exiting ...\n";
sleep(2);
CODE
my $progfile = 'b.pl';
open my $fh, '>', $progfile or die $!;
print $fh $code;
close $fh;
$|++;
my $ex1 = system("perl $progfile 1 &");
print "First system(): $ex1\n";
my $ex2 = system("perl $progfile 2");
print "Second system(): $ex2\n";
Output:
$ perl a.pl
First system(): 0
1: Another instance of b.pl is already running. Exiting ...
Second system(): 0
$ perl a.pl
First system(): 0
2: Another instance of b.pl is already running. Exiting ...
Second system(): 2816
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.