I currently have a Perl script that runs an external command on the system, gathers the output, and performs some action based on what was returned. Right now, here is how I run this (where $cmd is a string with the command setup):
#output = `$cmd`;
I'd like to change this so if the command hangs and does not return a value after so much time then I kill the command. How would I go about running this asynchronously?
There's a LOT of ways to do this:
You can do this with a fork (perldoc -f fork)
or using threads (perldoc threads). Both of these make passing the returned information back to the main program difficult.
On systems that support it, you can set an alarm (perldoc -f alarm) and then clean up in the signal handler.
You can use an event loop like POE or Coro.
Instead of the backticks, you can use open() or respectively open2 or open3 (cf. IPC::Open2, IPC::Open3) to start a program while getting its STDOUT/STDERR via a file handle. Run non-blocking read operations on it. (perldoc -f select and probably google "perl nonblocking read")
As a more powerful variant of the openX()'s, check out IPC::Run/IPC::Cmd.
Probably tons I can't think of in the middle of the night.
If you really just need to put a timeout on a given system call that is a much simpler problem than asynchronous programming.
All you need is alarm() inside of an eval() block.
Here is a sample code block that puts these into a subroutine that you could drop into your code. The example calls sleep so isn't exciting for output, but does show you the timeout functionality you were interested in.
Output of running it is:
/bin/sleep 2 failure: timeout at
./time-out line 15.
$ cat time-out
#!/usr/bin/perl
use warnings;
use strict;
my $timeout = 1;
my #cmd = qw(/bin/sleep 2);
my $response = timeout_command($timeout, #cmd);
print "$response\n" if (defined $response);
sub timeout_command {
my $timeout = (shift);
my #command = #_;
undef $#;
my $return = eval {
local($SIG{ALRM}) = sub {die "timeout";};
alarm($timeout);
my $response;
open(CMD, '-|', #command) || die "couldn't run #command: $!\n";
while(<CMD>) {
$response .= $_;
}
close(CMD) || die "Couldn't close execution of #command: $!\n";
$response;
};
alarm(0);
if ($#) {
warn "#cmd failure: $#\n";
}
return $return;
}
If your external program doesn't take any input, look for the following words in the perlipc manpage:
Here's a safe backtick or pipe open for read:
Use the example code and guard it with an alarm (which is also explained in perlipc).
I coded below to run rsync on 20 directories simultaneously (in parallel instead of sequentially requiring me to wait hours for it to complete):
use threads;
for my $user ( keys %users ) {
my $host = $users{$user};
async {
system <<~ "SHELL";
ssh $host \\
rsync_user $user
SHELL
}
}
$ pgrep -lf rsync | wc -l
20
Not sure if it's best or even a good solution, but I was glad that it worked for my use case.
With this you get a mixed output on screen (what I ignored anyway), but it does its job successfully.
threads pragma exports the (very useful) async function by default.
rsync_user is my Perl script that wraps rsync command with options, and source and target directories set.
Ran on FreeBSD 13.1 with Perl 5.32.1
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
I am working on a capstone project and am hoping for some insight.
This is the first time I've worked with Perl and it's pretty much a basic Perl script to automate a few different Unix commands that need to be executed in a specific order. There are two lines throughout the script which executes a Unix command that needs to finish processing before it is acceptable for the rest of the script to run (data will be incorrect otherwise).
How am I able to use Perl (or maybe this is a Unix question?) to print a simple string once the Unix command has finished processing? I am looking into ways to read in the Unix command name but am not sure how to implement a way to check if the process is no longer running and to print a string such as "X command has finished processing" upon it's completion.
Example:
system("nohup scripts_pl/RunAll.pl &");
This runs a command in the background that takes time to process. I am asking how I can use Perl (or Unix?) to print a string once the process has finished.
I'm sorry if I didn't understand your asking context.
But couldn't you use perl process fork function instead of & if you would like to do parallel process?
# parent process
if (my $pid = fork) {
# this block behaves as a normal process
system("nohup scripts_pl/RunAll2.pl"); # you can call other system (like RunAll2.pl)
wait; # wait for the background processing
say 'finished both';
}
# child process
else {
# this block behaves as a background process
system("nohup scripts_pl/RunAll.pl"); # trim &
}
You could try to use IPC::Open3 instead of system:
use IPC::Open3;
my $pid = open3("<&STDIN", ">&STDOUT", ">&STDERR", 'nohup scripts_pl/RunAll.pl');
waitpid( $pid, 0 );
Or, if you need to run nohup through the shell:
my $pid = open3("<&STDIN", ">&STDOUT", ">&STDERR", 'bash','-c', 'nohup scripts_pl/RunAll.pl & wait');
Update: Thanks to #ikegami. A better approach if you would like STDIN to stay open after running the command:
open(local *CHILD_STDIN, "<&", '/dev/null') or die $!;
my $pid = open3("<&CHILD_STDIN", ">&STDOUT", ">&STDERR", 'nohup scripts_pl/RunAll.pl');
I'm trying to capture the output of the command executed as a different user using:
my $command = qq(sudo su - <username> -c '/usr/bin/whatever');
my $pid = open $cmdOutput, "-|", $command;
How can I capture the STDERR of /usr/bin/whatever?
I tried
$pid = open $cmdOutput, "-|", $command || die " something went wrong: $!";
but it looks like this is capturing the possible errors of "open" itself.
I also tried
my $command = qq(sudo su - <username> -c '/usr/bin/whatever' 2>/tmp/error.message);
which will redirect the STDERR to the file, which I can parse later, but I wanted some more straightforward solution.
Also, I only want to use core modules.
This is covered thoroughly in perlfaq8. Since you are using a piped open, the relevant examples are those that go by open3 from the core IPC::Open3 module.
Another option is to use IPC::Run for managing your processes, and the pump function will do what you need. The IPC::Open3 documentation says for IPC::Run
This is a CPAN module that has better error handling and more facilities than Open3.
With either of these you can manipulate STDOUT and STDERR separately or together, as needed. For convenient and complete output capture also see Capture::Tiny.
Other than 2>output redirection, there are no more elementary methods for the piped open.
If you don't mind mixing the streams or losing STDOUT altogether, another option is
my $command = 'cmd 2>&1 1>/dev/null' # Remove 1>/dev/null to have both
my $pid = open my $cmdOutput, "-|", $command;
while (<$cmdOutput>) { print } # STDERR only
The first redirection merges STDERR stream with STDOUT so you get them both, and mixed (with STDOUT subject to buffering, thus things may well come out of order). The second redirect sends the STDOUT away so with it in place you read only the command's STDERR from the handle.
The question is about running an external command using open but I'd like to mention that the canonical and simple qx (backticks) can be used in the same way. It returns the STDOUT so redirection just like above is needed to get STDERR. For completeness:
my $cmd = 'cmd_to_execute';
my $allout = qx($cmd 2>&1); # Both STDOUT and STDERR in $out, or
my $stderr = qx($cmd 2>&1 1>/dev/null); # Only STDERR
my $exit_status = $?;
The qx puts the child process exit code (status) in $?. This can then be inspected for failure modes; see a summary in the qx page or a very thorough discussion in I/O operators in perlop.
Note that the STDERR returned this way is from the command, if it ran. If the command itself couldn't be run (for a typo in command name, or fork failed for some reason) then $? will be -1 and the error will be in $!.
As suggested by zdim I used the IPC::Open3 module for the matter and I've got something like this doing the job for me
$instanceCommand = qq(sudo su - <username> -c '<command>');
my ($infh,$outfh,$errfh,$pid);
$errfh = gensym();
$pid = open3($infh, $outfh, $errfh, $instanceCommand);
my $sel = new IO::Select;
$sel->add($outfh,$errfh);
while (my #ready = $sel->can_read){
foreach my $fh (#ready){
my $line =<$fh>;
if (not defined $line){
$sel->remove($fh);
next;
}
if ($fh == $outfh){
chomp($line);
#<----- command output processing ----->
}
elsif ($fh == $errfh){
chomp $line;
#<----- command error processing ----->
}
else {
die "Reading from something else\n";
}
}
}
waitpid($pid, 0);
Maybe not completely bullet proof, but its working fine for me. Even whilst executing funny cascaded script as < command > .
The desired destination, opened for writing, could be dup()'ed to FD #2
I'm trying to get a perl script to loop very quickly (in Solaris).
I have something like this:
#! /bin/perl
while ('true')
{
use strict;
use warnings;
use Time::HiRes;
system("sh", "shell script.sh");
Time::HiRes::usleep(10);
}
I want the perl script to execute a shell script every 10 microseconds. The script doesn't fail but no matter how much I change the precision of usleep within the script, the script is still only being executed approx 10 times per second. I need it to loop much faster than that.
Am I missing something fundamental here? I've never used perl before but I can't get the sleep speed I want in Solaris so I've opted for perl.
TIA
Huskie.
EDIT:
Revised script idea thanks to user comments - I'm now trying to do it all within perl and failing miserably!
Basically I'm trying to run the PS command to capture processes - if the process exists I want to capture the line and output to a text file.
#! /bin/perl
while ('true')
{
use strict;
use warnings;
use Time::HiRes;
open(PS,"ps -ef | grep <program> |egrep -v 'shl|grep' >> grep_out.txt");
Time::HiRes::usleep(10);
}
This returns the following error:
Name "main::PS" used only once: possible typo at ./ps_test_loop.pl line 9.
This is a pure perl program (not launching any external process) that looks for processes running some particular executable:
#!/usr/bin/perl
use strict;
use warnings;
my $cmd = 'lxc-start';
my $cmd_re = qr|/\Q$cmd\E$|;
$| = 1;
while (1) {
opendir PROC, "/proc" or die $!;
while (defined(my $pid = readdir PROC)) {
next unless $pid =~ /^\d+$/;
if (defined(my $exe = readlink "/proc/$pid/exe")) {
if ($exe =~ $cmd_re) {
print "pid: $pid\n";
}
}
}
closedir PROC;
# sleep 1;
}
On my computer this runs at 250 times/second.
The bottleneck is the creation of processes, pipes, and opening the output file. You should be doing that at most once, instead of doing it in each iteration. That's why you need to do everything in Perl if you want to make this faster. Which means: don't call the ps command, or any other command. Instead, read from /proc or use Proc::ProcessTable, as the comments suggest.
Incidentally: the use statement is executed only once (it is essentially a shorthand for a require statement wrapped in a BEGIN { } clause), so you might as well put that at the top of the file for clarity.
I need to run two perl scripts from one in parallel. How can I accomplish this?
Currently, I have a file with
system("perl command1.pl command2.pl");
Commands are executed in sequence and until command1.pl is done command2.pl won't run.
I would like to run the two commands simultaneously.
PLEASE HELP!
`perl command1.pl &`;
`perl command2.pl &`;
..or use the perl fork() function
perldoc -f fork
..or use perl threading
perldoc threads
Or just use a shell script:
#!/bin/sh
./command1.pl &
./command2.pl &
Depends on the command interpreter. In Windows you use the start command to just launch a process without waiting. In most *nix command interpreters as I recall the relevant notation is to add an ampersand & at the end of the command.
You could use a piped open to the process, ala
use 5.013;
use warnings;
use autodie;
open my $cmd1_fh, '-|', 'dir';
open my $cmd2_fh, '-|', 'cls';
Or, if you don't care about the output, fork and then exec:
my #child_pids;
for my $cmd ('dir', 'cls') {
defined(my $child_pid = fork()) or die "Couldn't fork: $!";
if ($child_pid == 0) {
exec $cmd;
} else {
push #child_pids, $child_pid;
}
}
for my $pid (#child_pids) {
waitpid($pid, 0);
}
(If you do care about the output, fork and then backtick?)
Or use threads (I'm not proud of this example, and I haven't even written it yet. Look up an example using Thread::Queue for something much less awful)
use threads;
my #threads;
for my $cmd ('dir', 'cls') {
push #threads, threads->create(sub { system #_ }, $cmd);
}
$_->join for #threads;
There's also several modules that help you out with this one, such as Parallel::ForkManager and Win32::Job.
Depending on your skill level and what you want to do, you might be interested in POE::Wheel::Run.