Question
Why is nothing printed when using anonymous pipe, unless I print the actual data from pipe ?
Example
use strict;
use warnings;
my $child_process_id = 0;
my $vmstat_command = 'vmstat 7|';
$child_process_id = open(VMSTAT, $vmstat_command) || die "Error when executing \"$vmstat_command\": $!";
while (<VMSTAT>) {
print "hi" ;
}
close VMSTAT or die "bad command: $! $?";
Appears to hang
use strict;
use warnings;
my $child_process_id = 0;
my $vmstat_command = 'vmstat 7|';
$child_process_id = open(VMSTAT, $vmstat_command) || die "Error when executing \"$vmstat_command\": $!";
while (<VMSTAT>) {
print "hi" . $_ ;
# ^^^ Added this
}
close VMSTAT or die "bad command: $! $?";
Prints
hiprocs -----------memory---------- ---swap-- -----io---- -system-- -----cpu------
hi r b swpd free buff cache si so bi bo in cs us sy id wa st
hi 1 0 0 7264836 144200 307076 0 0 0 1 0 14 0 0 100 0 0
etc...
Expected behaviour
Would be to print hi for every line of output of vmstat for the first example.
Versions
perl, v5.10.0
GNU bash, version 3.2.51
Misc
It also appears to hang when using chomp before printing the line (which i thought only removes newlines).
I feel like i'm missing something fundamental to how the pipe is read and processed but could not find a similar question. If there is one then dupe this and I'll have a look at it.
Any further information needed just ask.
Alter
print "hi";
to
print "hi\n";
and it also "works"
the reason it fails is that output is line buffered by default
setting $| will flush the buffer straight away
If set to nonzero, forces a flush right away and after every write or print on the currently selected output channel. Default is 0 (regardless of whether the channel is really buffered by the system or not; "$|" tells you only whether you've asked Perl explicitly to flush after each write). STDOUT will typically be line buffered if output is to the terminal and block buffered otherwise. Setting this variable is useful primarily when you are outputting to a pipe or socket, such as when you are running a Perl program under rsh and want to see the output as it's happening. This has no effect on input buffering. See the getc entry in the perlfunc manpage for that. (Mnemonic: when you want your pipes to be piping hot.)
Related
I'm trying to capture the output my perl code generates both from print and similar statements and external commands.
Due to design constraints I can't use solutions like Capture::Tiny. I need to forward the output to the buffer variable as soon as it is generated and I need to be able to differentiate between STDOUT and STDERR. Ideally a solution for external commands would essentially work just like system apart from being able to capture STDOUT and STDERR instead of printing them.
My code is supposed to:
Save the old STDOUT/STDERR file handles.
Create a new ones for both STDERR and STDOUT.
Redirect all the output to this place.
Print a couple of things.
Restore the old filehandles.
Do something with the captured output, e.g. print it.
However I'm unable to capture the output generated from external commands. I can't do it with IPC::Run3 nor with IPC::Open3.
#!/usr/bin/perl -CSDAL
use warnings;
use strict;
use IPC::Open3;
#use IPC::Run3;
# Save old filehandles
open(my $oldout, ">&STDOUT") or die "Can't dup STDOUT: $!";
open(my $olderr, ">&STDERR") or die "Can't dup STDERR: $!";
my $buffer = "";
close(STDOUT);
close(STDERR);
open(STDOUT, '>', \$buffer) or die "Can't redirect STDOUT: $!";
*STDERR = *STDOUT; # In this example STDOUT and STDERR are printed to the same buffer.
print "1: Test\n";
#run3 ["date"], undef, \*STDOUT, \*STDERR; # This doesn't work as expected
my $pid = open3("<&STDIN", ">&STDOUT", ">&STDERR", "date");
waitpid($pid,0); # Nor does this.
print STDERR "2: Test\n";
open(STDOUT, ">&", $oldout) or die "Can't dup \$oldout: $!";
open(STDERR, ">&", $olderr) or die "Can't dup \$olderr: $!";
print "Restored!\n";
print $buffer;
Expected result:
Restored!
1: Test
Mo 25. Mär 13:44:53 CET 2019
2: Test
Actual result:
Restored!
1: Test
2: Test
I don't have a solution to offer you, however I can provide some explanations as to the behavior you are seeing.
First, IPC::Open3 is not supposed to work when your filehandles are variables; see this question for more explanations.
Now, why isn't IPC::Run3 working? First, notice that if don't redirect STDERR and run
run3 ["date"], undef, \$buffer, { append_stdout => 1 };
instead of
run3 ["date"], undef, \*STDOUT;
then it works as expected. (you need to add { append_stdout => 1 } or your previous outputs to $buffer will be overwritten)
To understand what's happening, in your program, after
open(STDOUT, '>', \$buffer) or die "Can't redirect STDOUT: $!";
Add
print STDERR ref(\$buffer), "\n"
print STDERR ref(\*STDOUT), "\n"
Which will print
SCALAR
GLOB
That's exactly what IPC::Run3::run3 will do to know what to do with the "stdout" you give it (see the source: _fh_for_child_output, which is called by run3):
if it's a scalar, then a temporary file is used (the corresponding line is $fh = $fh_cache{$what} ||= tempfile, where tempfile is a function from File::Temp.
On the other hand, when stdout is a GLOB (or tied to IO::Handle), that filehandle is used directly (that's this line of code).
Which explains why when you call run3 with \$buffer it works, but not with \*STDOUT.
When redirecting STDERR as well, and calling
run3 ["date"], undef, \$buffer, \$buffer, { append_stdout => 1, append_stderr => 1 };
, things start to appear weird. I don't understand what's happening, but I'll share here what I found, and hopefully someone will make sense of it.
I modified the source of IPC::Run3 and added
open my $FP, '>', 'logs.txt' or die "Can't open: $!";
at the beginning of the sub run3. When running, I only see
Restored!
1: Test
on STDOUT (my terminal), but logs.txt contains the date (something in the lines of Mon Mar 25 17:49:44 CET 2019).
Investing a bit reveals that fileno $FP returns 1 (which, unless I mistaken, is usually STDOUT (but you closed it, so I'm no so surprised that its descriptor can be reused)), and fileno STDOUT returns 2 (this might depend on your Perl version and other opened filehandles though). What seems to be happening is that system assumes that STDOUT is the file descriptor 1 and thus prints to $FP instead of STDOUT (I'm just guessing though).
Please feel free to comment/edit if you understand what's happening.
I ended up with the following code:
#!/usr/bin/perl -CSDAL
use warnings;
use strict;
use IPC::Run3;
use IO::Scalar;
use Encode;
use utf8;
# Save old filehandles
open(my $oldout, ">&STDOUT") or die "Can't dup STDOUT: $!";
open(my $olderr, ">&STDERR") or die "Can't dup STDERR: $!";
open(my $FH, "+>>:utf8", undef) or die $!;
$FH->autoflush;
close(STDOUT);
close(STDERR);
open(STDOUT, '>&', $FH) or die "Can't redirect STDOUT: $!";
open(STDERR, '>&', $FH) or die "Can't redirect STDOUT: $!";
print "1: Test\n";
run3 ["/bin/date"], undef, $FH, $FH, { append_stdout => 1, append_stderr => 1 };
print STDERR "2: Test\n";
open(STDOUT, ">&", $oldout) or die "Can't dup \$oldout: $!";
open(STDERR, ">&", $olderr) or die "Can't dup \$olderr: $!";
print "Restored!\n";
seek($FH, 0, 0);
while(<$FH>)
{
# No idea why this is even required
print Encode::decode_utf8($_);
}
close($FH);
This is far from what I originally wanted, but appears to be working at least.
The issues I have with this are:
I need an anonymous file handle creating clutter on the hard disk.
For some reason I need to fix the encoding manually.
Thank you very much to the people who dedicated their time helping me out here.
Is there a reason you need to use the parent's STDOUT and STDERR? IPC::Open3 is easily capable of redirecting the child's STDOUT and STDERR to unrelated handles in the parent which you can read from.
use strict;
use warnings;
use IPC::Open3;
my $pid = open3 undef, my $outerr, undef, 'date';
my $output = do { local $/; readline $outerr };
waitpid $pid, 0;
my $exit = $? >> 8;
This will read STDOUT and STDERR together, if you want to read them separately you need to pass my $stderr = Symbol::gensym as the third argument (as shown in the IPC::Open3 docs), and use a non-blocking loop to avoid deadlocking when reading both handles. IO::Async::Process or similar can fully automate this for you, but IPC::Run3 provides a much simpler solution if you only need to store the output in scalar variables. IPC::Run3 and Capture::Tiny can also both easily be fatpacked for deployment in scripts.
This is not an answer yet, but it seems like open3 requires STDOUT to be a regular tty file handle at the time you call open3, for example:
use feature qw(say);
use strict;
use warnings;
use IPC::Open3;
use Symbol 'gensym';
{
local *STDOUT; # <-- if you comment out this line open3 works as expected
my ($chld_in, $chld_out);
my $chld_err = gensym;
my $pid;
eval {
$pid = open3($chld_in, $chld_out, $chld_err, "date");
};
if ( $# ) {
say "IPC::Open::open3 failed: '$#'";
}
print "-> $_" for <$chld_out>;
waitpid $pid, 0;
# say "Cannot print to invalid handle..";
}
say "ok";
Output:
ma. 25. mars 16:00:01 +0100 2019
ok
Note that the arrow -> in the beginning of the line is missing,
so nothing can be read from $chld_out in this case. However, if I comment out the line:
local *STDOUT;
The output is:
-> ma. 25. mars 16:01:10 +0100 2019
ok
I don't have much experience with perl, and would appreciate any/all feedback....
[Before I start: I do not have access/authority to change the existing perl scripts.]
I run a couple perl scripts several times a day, but I would like to begin capturing their output in a file.
The first perl script does not take any arguments, and I'm able to "tee" its output without issue:
/asdf/loc1/rebuild-stuff.pl 2>&1 | tee $mytmpfile1
The second perl script hangs with this command:
/asdf/loc1/create-site.pl --record=${newsite} 2>&1 | tee $mytmpfile2
FYI, the following command does NOT hang:
/asdf/loc1/create-site.pl --record=${newsite} 2>&1
I'm wondering if /asdf/loc1/create-site.pl is trying to process the | tee $mytmpfile2 as additional command-line arguments? I'm not permitted to share the entire script, but here's the beginning of its main routine:
...
my $fullpath = $0;
$0 =~ s%.*/%%;
# Parse command-line options.
...
Getopt::Long::config ('no_ignore_case','bundling');
GetOptions ('h|help' => \$help,
'n|dry-run|just-print' => \$preview,
'q|quiet|no-mail' => \$quiet,
'r|record=s' => \$record,
'V|noverify' => \$skipverify,
'v|version' => \$version) or exit 1;
...
Does the above code provide any clues? Other than modifying the script, do you have any tips for allowing me to capture its output in a file?
It's not hanging. You are "suffering from buffering". Like most programs, Perl's STDOUT is buffered by default. Like most programs, Perl's STDOUT is flushed by a newline when connected to a terminal, and block buffered otherwise. When STDOUT isn't connected to a terminal, you won't get any output until 4 KiB or 8 KiB of output is accumulated (depending on your version of Perl) or the program exits.
You could add $| = 1; to the script to disable buffering for STDOUT. If your program ends with a true value or exits using exit, you can do that without changing the .pl file. Simply use the following wrapper:
perl -e'
$| = 1;
$0 = shift;
do($0);
my $e = $# || $! || "$0 didn\x27t return a true value\n";
die($e) if $e;
' -- prog args | ...
Or you could fool the program into thinking it's connected to a terminal using unbuffer.
unbuffer prog args | ...
I am using Net::OpenSSH
my $ssh = Net::OpenSSH->new("$linux_machine_host")
Using the SSH object, fews commands are executed multiple times for N hours.
At times I need to look for any error messages, such as Timeout, in the var/adm/message file.
My suggestion
$ssh->capture2("echo START >> /var/adm/messages");
$ssh->capture2("some command which will be run in background for n hours");
$ssh->capture2("echo END >> /var/adm/messages");
Then read all lines between START and END and grep for the required error message.
$ssh->capture2("grep -A 100000 "START" /var/adm/messages | grep -B 100000 END");`
Without writing START and END into the message file, can I tail the var/adm/message file at some point and capture any new messages appearing afterwards.
Are there any Net::OpenSSH methods which would capture new lines and write them into a file?
You can read the messages file via SFTP (see Net::SFTP::Foreign):
# untested!
use Net::SFTP::Foreign::Constants qw(:flags);
...
my $sftp = $ssh->sftp;
# open the messages file creating it if it doesn't exist
# and move to the end:
my $fh = $sftp->open("/var/adm/messages",
SSH2_FXF_READ|SSH2_FXF_CREAT)
or die $sftp->error;
seek($fh, 0, 2);
$ssh->capture2("some command which...");
# look for the size of /var/adm/messages now so that we
# can ignore any lines that may be appended while we are
# reading it:
my $end = (stat $fh)[7];
# and finally read any lines added since we opened it:
my #msg;
while (1) {
my $pos = tell $fh;
last if $pos < 0 or $pos >= $end;
my $line = <$fh>;
last unless defined $line;
push #msg, $line;
}
Note that you are not taking into account that the messages file may be rotated. Handling that would require more convoluted approaches.
When a CHLD signal handler is used in Perl, even uses of system and backticks will send the CHLD signal. But for the system and backticks sub-processes, neither wait nor waitpid seem to set $? within the signal handler on SuSE 11 linux. Is there any way to determine the return code of a backtick command when a CHLD signal handler is active?
Why do I want this? Because I want to fork(?) and start a medium length command and then call a perl package that takes a long time to produce an answer (and which executes external commands with backticks and checks their return code in $?), and know when my command is finished so I can take action, such as starting a second command. (Suggestions for how to accomplish this without using SIGCHLD are also welcome.) But since the signal handler destroys the backtick $? value, that package fails.
Example:
use warnings;
use strict;
use POSIX ":sys_wait_h";
sub reaper {
my $signame = shift #_;
while (1) {
my $pid = waitpid(-1, WNOHANG);
last if $pid <= 0;
my $rc = $?;
print "wait()=$pid, rc=$rc\n";
}
}
$SIG{CHLD} = \&reaper;
# system can be made to work by not using $?, instead using system return value
my $rc = system("echo hello 1");
print "hello \$?=$?\n";
print "hello rc=$rc\n";
# But backticks, for when you need the output, cannot be made to work??
my #IO = `echo hello 2`;
print "hello \$?=$?\n";
exit 0;
Yields a -1 return code in all places I might try to access it:
hello 1
wait()=-1, rc=-1
hello $?=-1
hello rc=0
wait()=-1, rc=-1
hello $?=-1
So I cannot find anywhere to access the backticks return value.
This same issue has been bugging me for a few days now. I believe there are 2 solutions required depending on where you have your backticks.
If you have your backticks inside the child code:
The solution was to put the line below inside the child fork. I think your statement above "if I completely turn off the CHLD handler around the backticks then I might not get the signal if the child ends" is incorrect. You will still get a callback in the parent when the child exits because the signal is only disabled inside the child. So the parent still gets a signal when the child exits. It's just the child doesn't get a signal when the child's child (the part in backticks) exits.
local $SIG{'CHLD'} = 'DEFAULT'
I'm no Perl expert, I have read that you should set the CHLD signal to the string 'IGNORE' but this did not work in my case. In face I believe it may have been causing the problem. Leaving that out completely appears to also solve the problem which I guess is the same as setting it to DEFAULT.
If you have backticks inside the parent code:
Add this line to your reaper function:
local ($!, $?);
What is happening is the reaper is being called when your code inside the backticks completes and the reaper is setting $?. By making $? local it does not set the global $?.
So, building on MikeKull's answer, here is a working example where the fork'd child uses backticks and still gets the proper return code. This example is a better representation of what I was doing, while the original example did not use forks and could not convey the entire issue.
use warnings;
use strict;
use POSIX ":sys_wait_h";
# simple child which returns code 5
open F, ">", "exit5.sh" or die "$!";
print F<<EOF;
#!/bin/bash
echo exit5 pid=\$\$
exit 5
EOF
close F;
sub reaper
{
my $signame = shift #_;
while (1)
{
my $pid = waitpid(-1, WNOHANG);
print "no child waiting\n" if $pid < 0;
last if $pid <= 0;
my $rc = $? >> 8;
print "wait()=$pid, rc=$rc\n";
}
}
$SIG{CHLD} = \&reaper;
if (!fork)
{
print "child pid=$$\n";
{ local $SIG{CHLD} = 'DEFAULT'; print `./exit5.sh`; }
print "\$?=" . ($? >> 8) . "\n";
exit 3;
}
# sig CHLD will interrupt sleep, so do multiple
sleep 2;sleep 2;sleep 2;
exit 0;
The output is:
child pid=32307
exit5 pid=32308
$?=5
wait()=32307, rc=3
no child waiting
So the expected return code 5 was received in the child when the parent's reaper was disabled before calling the child, but as indicated by ikegami the parent still gets the CHLD signal and a proper return code when the child exits.
i want to use O_ASYNC option and when the pipe can read ,
the SIGIO's handler will run .
but the following code are not work . any one can help me ?
#!/bin/env perl
use Fcntl;
$SIG{IO}= sub {
print "catch SIGIO!\n";
};
my $flags=0;
open(FH,"-|","sleep 4 ;echo aaa") or die "$!";
fcntl(FH,F_GETFL,$flags) or die "$!";
fcntl(FH,F_SETFL,$flags | O_NONBLOCK | O_ASYNC) or die "$!";
sleep(5);
print "complete\n";
my perl version is 5.16.1 , operation system is Redhat 5u4 ,kernel 2.6.18, x86_64
Under Linux, you must both request asynchronous notification (O_ASYNC) and specify a recipient (F_SETOWN). So, you need only add one line to your example to make it work:
#!/bin/env perl
use Fcntl;
$SIG{IO}= sub {
print "catch SIGIO!\n";
};
my $flags=0;
open(FH,"-|","sleep 4 ;echo aaa") or die "$!";
fcntl(FH,F_GETFL,$flags) or die "$!";
fcntl(FH,F_SETFL,$flags | O_NONBLOCK | O_ASYNC) or die "$!";
fcntl(FH,F_SETOWN,0 + $$) or die "$!"; # <-- Note that we force $$ to be numeric
sleep(5);
print "complete\n";
Running the above:
$ perl so-12640993.pl
catch SIGIO!
complete
SIGIO based asynchronous IO is edge-triggered, not level triggered.
Before any filehandle will send you a SIGIO you must first "arm" it. To do that, you need to perform whatever is the operation - sysread() in this case - until you get an undef/EAGAIN. At that point the filehandle will now be armed for SIGIO and will send a signal when it is next read-ready. You can then read it until it yields EAGAIN, which will arm it once more.