I am trying to run few child processes on different platforms in parallel. Parent should only proceed further once all the child processes have completed on respective platforms.
The problem is that when I use fork and then run the ‘exec’ command in the child process, it ends almost instantly. Also, the output isn't consistent. Almost every time the log shows only one line.
-bash-2.05b$ cat Agent.SOLSPARC
caught SIGTERM signal, cleaning up
or
-bash-2.05b$ cat Agent.SOLSPARC
Host: EBSO9SPC Login: esm2
Sometimes, there are few extra lines and at last the message, 'Killed by signal 15'. The command that i use in 'exec' actually calls a script which connects to remote boxes and runs make command on them. For testing purpose, i am currently passing only one platform i.e., SOLSPARC. Also, i'm only interested in knowing whether a command finished on any given platform.
I was not sure whether I was passing all the arguments to ‘exec’ correctly so I tried different combinations (after referring different links on the Internet) but to no avail. One important observation is that when i used strace to debug this issue, the command worked fine. I saw in the perldoc that exec uses /bin/sh -c on Unix platforms, but varies on other platforms. Is it that exec and strace use different shell?
Here’s the relevant portion of my code:
sub compile {
my %child_pids;
foreach $plat (0 .. $#plat_list) {
my $pid = fork;
# Didn't check the undef condition for child
if ($plat_list[$plat] eq "SOLSPARC") {
print "\nStarted Solaris build \n";
if ($pid == 0) {
print "Inside Child Process \n\n";
exec ( "${ROOT}/${REM_EXEC} -t 1200 -c \"make LANG=en_US distclean \" -b ${ROOT} -l Agent. $plat_list[$plat]" ) or die "exec failed";
} elsif ($pid > 0) {
$child_pids{"SOLSPARC"} = $pid;
}
} else {
print "\nStarted build for other platforms \n";
if ($pid == 0) {
print "Inside Child Process \n\n";
exec ( "${ROOT}/${REM_EXEC} -t 1200 -c \"make LANG=en_GB clean \" -b ${ROOT} -l Agent. $plat_list[$plat]" ) or die "exec failed";
} elsif ($pid > 0) {
$child_pids{"$plat_list[$plat]"} = $pid;
}
}
}
my %rev_child_pids = reverse %child_pids;
while ((my $kid = waitpid -1, WNOHANG) > 0) {
if ($rev_child_pids{$kid} eq "SOLSPARC") {
print "\nChild process completed for SOLARIS platform $rev_child_pids{$kid} \n";
print "Run some other command here \n";
} else {
print "\nChild process completed for other platform $rev_child_pids{$kid} \n";
print "No more commands to run \n";
}
}
}
Any suggestions?
Try using 'system' instead of 'exec'.
system `${ROOT}/${REM_EXEC} -t 1200 -c "make LANG=en_US distclean " -b ${ROOT} -l Agent. $plat_list[$plat]`
'system' works slightly differently in relation to fork so it might solve the problem.
Related
I have a Perl script, and in that script, I am executing the "make" command over the list of test cases. Now, I want to have the PID of each "make" command when it runs the test case so that I can monitor those PIDs.
Let's say, I have a test list
#array1 = ("/home/abc/test1/makefile", "/home/bcd/qwe/test2/makefile", "/home/PPP/makefile").
Now, when I run make on /home/abc/test1/makefile, I need the unique PID of this command (make /home/abc/test1/makefile).
Then, when I run make on /home/bcd/qwe/test2/makefile, I must get another unique ID, and similarly for other tests.
I would then use each PID to monitor for their time i.e. if a certain test executed using make (with a unique ID) reaches a time limit, then I would do something (that will be done via fork), but for that monitoring to happen, I would need the PIDs.
Code Snippet which I am using:
foreach my $i (#array1)
{
my $filehandle;
if ( ! open( $filehandle, "make $i 2>&1 |" ) ) {
die( "Failed to start process: $!" );
}
else {
print "Test started\n";
}
while ( defined( my $line = <$filehandle> ) ) {
print( $line );
}
}
How can I get the PIDs?
The pid of make is returned by open. perldoc -f open states:
Open returns nonzero on success, the undefined value otherwise.
If the "open" involved a pipe, the return value happens to be
the pid of the subprocess.
Getting the pid of processes spawned by make is a different question, and will require more effort.
open returns the PID of the process it creates. But the process being created is running sh. The PID you should receive is the PID of the shell you're launching, not that of make.[1]
If you weren't trying to execute a shell command, you could use the "list form" of open to avoid the shell. But that's not available to you since you want to use the shell to perform redirection.
There are ways to address this will still using open -|, but it's far simpler to use IPC::Run, and it handles the timeout trivially.
use IPC::Run qw( run timeout );
run [ "make", $i ],
">", \my $stdout, # Or whatever
"2>", \my $stderr, # Or whatever
timeout( 10 );
die( "make killed by signal ".( $? & 0x7F )."\n" ) if $? & 0x7F;
die( "make exited with error ".( $? >> 8 )."\n" ) if $? >> 8;
say "make successful.";
Perl sometimes optimizes the use of the shell away.
I am new to Perl and trying to write a code to keep executing an action until the match is found and else give an error.
I am trying to execute a command ps -ef and check if it has got any process running in the name of "box", if there is no process named "box" found, I want to repeat ps -ef command execution until it gets the "box" process and then proceed to next action.
#!/usr/bin/perl -w
open (FH, "ps -ef |") or die "Cannot run the command:$!\n";
$line = "box";
while (<FH>) {
if (/$line/i) { next; }
else {
print ("ps -ef |") or die "Cannot run the command:$!\n");
}
}
close (FH);
You need to use an infinite loop and an exit-condition. Your condition is that the ps -ef command contains the word box. There is no need to open a pipe to that command explicitly, you can just run it as a system call with the qx operator (same as backticks).
use strict;
use warnings;
my $ps;
PS: while (1) {
$ps = qx/ps -ef/;
last PS if $ps =~ m/box/i;
print '.'; # do something in every run
}
print $ps;
As this has come up in the comments as well as in in AdrianHHH's answer: it might make sense to sleep after every run to make sure you don't hog the CPU. Depending on the nature of the process you are looking for, either the sleep builtin or usleep from Time::HiRes might be appropriate. The latter let's your program rest for milliseconds, while the builtin only works with full seconds. These might be too long if the target box process is very quick.
Explanation of your code:
Note that you have some issues in your implementation. I'll explain what your code does. This is taken from the question, comments are mine.
#!/usr/bin/perl -w
# open a filehandle to the ps command
open (FH, "ps -ef |") or die "Cannot run the command:$!\n";
$line = "box";
# read the output of one run line by line, for each line execute
# the block
while (<FH>) {
# if there is 'box' case-insensitive, skip the line
if (/$line/i) { next; }
else {
# else output (not run!) the command
print ("ps -ef |") or die "Cannot run the command:$!\n");
}
}
close (FH);
After it went through all the lines of the output of your command once it will stop.
I would recommend using pgrep(1) instead of ps because it lets you do a more granular search. With ps -ef, you potentially have to deal with cases like:
boxford 6254 6211 0 08:23 pts/1 00:00:00 /home/boxford/box --bounding-box=123
It's hard to tell if you're matching a process being run by a user with box in their username, a process that has box somewhere in its path, a process named box, or a process with box somewhere in its argument list.
pgrep, on the other hand, lets you match against just the process name or the full path, a specific user or users, and more. The following prints a message when a process named box appears (this looks for an exact match, so it will not match processes named dropbox, for example):
use strict;
use warnings;
use 5.010;
use String::ShellQuote qw(shell_quote);
sub is_running {
my ($proc) = #_;
my $cmd = 'pgrep -x ' . shell_quote($proc) . ' >/dev/null 2>&1';
system($cmd);
if ($? == -1) {
die "failed to execute pgrep: $!";
}
elsif ($? & 127) {
die "pgrep died with signal ", $? & 127;
}
else {
my $status = $? >> 8;
die "pgrep exited with error: exit status $status" if $status > 1;
return $status == 0;
}
}
my $proc = 'box';
until ( is_running($proc) ) {
sleep 1;
}
say "Process '$proc' is running";
Note that pgrep doesn't have a case-insensitive flag, probably because process names in *nix are almost always lowercase. If you really need to do a case-insensitive match, you can pass [Bb][Oo][Xx] to the is_running function.
The ps command outputs the current list of processes, then it completes. The code in the question reads that output. Suppose that the first ps command that is executed does not contain the wanted line, then there is nothing in the code in the question to run the ps command again.
The next statement in the question makes the script move on to the next line in the output from ps, not to rerun the command. The else print ... after the next will probably be executed for the first line of the output from ps. The outcome is that the print is run for each line in the ps output that does not have the wanted text and that the next command has no significant effect. In the code print ... or die "..." the or die "..." part is not very useful, the print is unlikely to fail and even if it did the die message would be wrong.
Perhaps you should write some code in the following style. Here the ps is run repeatedly until the wanted text is found. Note the sleep call, without that the script will keep running without pause, possibly preventing real work or at least slowing it down.
# This code is not tested.
use strict;
use warnings;
my $found_wanted_line = 0; # Boolean, set to false
my $line = "box";
while ( ! $found_wanted_line ) {
open (my $FH, "ps -ef |") or die "Cannot run the command:$!\n";
while (<$FH>) {
if (/$line/i) {
$found_wanted_line = 1; # Boolean, set to true
last;
}
}
close ($FH);
if ( ! $found_wanted_line )
sleep 2; # Pause for 2 seconds, to prevent this script hogging the CPU.
}
}
Problem Statement --
I display a message to user using Perl and takes an input.On the basis of input I decide whether I need to do further processing or not.This processing takes a long time ( say 5 hour) and user run this process by logging into remote Unix/Linux system.Hence to make sure that network malfunctioning will not affect the process; I want to switch the process to background.
How can I switch such running Perl process to background?
or
Is it possible to take user input from current terminal( the terminal from where user run process as input need to be taken at very starting) if process is running into background?
OS - Linux variants
Yup, you want to daemonize your program after it finishes its interaction with the user. I would encourage you to use a module like Proc::Daemon to do the work, though: there are a bunch of subtleties in doing it correctly. The POD for Proc::Daemon gives a good description of its usage, but a simple usage can be as basic as
use Proc::Daemon;
# ... finished the interactive stuff
my $pid = Proc::Daemon::Init( { work_dir => '/var/run/my_program' })
exit 0 if ($pid == 0);
die "Error daemonizing, cannot continue: $!\n" if ($! != 0);
# ... now do the background processing
# note that STDOUT and STDERR are no longer connected to the user's terminal!
Here is a very, very simple example for my comment above...
#!/usr/bin/perl
use strict;
use warnings;
my $lcnt = 0;
if( !$ARGV[0] ) { # If no ARGS on the command line, get user input
print "How many lines do you want to print?";
chomp( $lcnt = <STDIN> );
if( $lcnt > 0 ) {
# when we are sure we have what we need
# call myself.pl and put it in the background with '&'
my $cmd = "./myself.pl ".$lcnt.' &';
system($cmd);
exit(0);
} else { die "Invalid input!\n"; }
} else { # Otherwise, lets do the processing
$lcnt = $ARGV[0];
for( my $x = 0; $x <= $lcnt; $x++ ) {
my $cmd = "echo 'Printing line: $lcnt' >> /tmp/myself.txt";
system($cmd);
sleep(1);
}
}
exit(0);
If you save this to a file called 'myself.pl' then run it. With no arguments on the command line, the script will ask you to input a number. Type in 20 and press enter. You'll see the script exit almost instantly. But if you quickly
tail -f /tmp/myself.txt
you'll see that the background process is still running, printing a new line to the file every second. Also, typing the 'ps' command on Linux systems, should show the spawned process running in the background:
jlb#linux-f7r2:~/test> ps
PID TTY TIME CMD
1243 pts/1 00:00:00 bash
4171 pts/1 00:00:00 myself.pl
4176 pts/1 00:00:00 ps
Demonise the process if the correct input:
#test input
if($inputsuccess) {
if(fork() = 0) {
#child
if(fork() = 0) {
#child
#background processing
}
} else {
wait();
}
}
I need to run a shell command with system() in Perl. For example,
system('ls')
The system call will print to STDOUT, but I want to capture the output into a variable so that I can do future processing with my Perl code.
That's what backticks are for. From perldoc perlfaq8:
Why can't I get the output of a command with system()?
You're confusing the purpose of system() and backticks (``). system()
runs a command and returns exit status information (as a 16 bit value:
the low 7 bits are the signal the process died from, if any, and the
high 8 bits are the actual exit value). Backticks (``) run a command
and return what it sent to STDOUT.
my $exit_status = system("mail-users");
my $output_string = `ls`;
See perldoc perlop for more details.
IPC::Run is my favourite module for this kind of task. Very powerful and flexible, and also trivially simple for small cases.
use IPC::Run 'run';
run [ "command", "arguments", "here" ], ">", \my $stdout;
# Now $stdout contains output
Simply use similar to the Bash example:
$variable=`some_command some args`;
That's all. Notice, you will not see any printings to STDOUT on the output because this is redirected to a variable.
This example is unusable for a command that interact with the user, except when you have prepared answers. For that, you can use something like this using a stack of shell commands:
$variable=`cat answers.txt|some_command some args`;
Inside the answers.txt file you should prepare all answers for some_command to work properly.
I know this isn't the best way for programming :) But this is the simplest way how to achieve the goal, specially for Bash programmers.
Of course, if the output is bigger (ls with subdirectory), you shouldn't get all output at once. Read the command by the same way as you read a regular file:
open CMD,'-|','your_command some args' or die $#;
my $line;
while (defined($line=<CMD>)) {
print $line; # Or push #table,$line or do whatever what you want processing line by line
}
close CMD;
An additional extended solution for processing a long command output without extra Bash calling:
my #CommandCall=qw(find / -type d); # Some example single command
my $commandSTDOUT; # File handler
my $pid=open($commandSTDOUT),'-|'); # There will be an implicit fork!
if ($pid) {
#parent side
my $singleLine;
while(defined($singleline=<$commandSTDOUT>)) {
chomp $line; # Typically we don't need EOL
do_some_processing_with($line);
};
close $commandSTDOUT; # In this place $? will be set for capture
$exitcode=$? >> 8;
do_something_with_exit_code($exitcode);
} else {
# Child side, there you really calls a command
open STDERR, '>>&', 'STDOUT'; # Redirect stderr to stdout if needed. It works only for child - remember about fork
exec(#CommandCall); # At this point the child code is overloaded by an external command with parameters
die "Cannot call #CommandCall"; # Error procedure if the call will fail
}
If you use a procedure like that, you will capture all procedure output, and you can do everything processing line by line. Good luck :)
I wanted to run system() instead of backticks because I wanted to see the output of rsync --progress. However, I also wanted to capture the output in case something goes wrong depending on the return value. (This is for a backup script). This is what I am using now:
use File::Temp qw(tempfile);
use Term::ANSIColor qw(colored colorstrip);
sub mysystem {
my $cmd = shift; # "rsync -avz --progress -h $fullfile $copyfile";
my ($fh, $filename) = tempfile();
# http://stackoverflow.com/a/6872163/2923406
# I want to have rsync progress output on the terminal AND capture it in case of error.
# Need to use pipefail because 'tee' would be the last cmd otherwise and hence $? would be wrong.
my #cmd = ("bash", "-c", "set -o pipefail && $cmd 2>&1 | tee $filename");
my $ret = system(#cmd);
my $outerr = join('', <$fh>);
if ($ret != 0) {
logit(colored("ERROR: Could not execute command: $cmd", "red"));
logit(colored("ERROR: stdout+stderr = $outerr", "red"));
logit(colored("ERROR: \$? = $?, \$! = $!", "red"));
}
close $fh;
unlink($filename);
return $ret;
}
# And logit() is something like:
sub logit {
my $s = shift;
my ($logsec, $logmin, $loghour, $logmday, $logmon, $logyear, $logwday, $logyday, $logisdst) = localtime(time);
$logyear += 1900;
my $logtimestamp = sprintf("%4d-%02d-%02d %02d:%02d:%02d", $logyear, $logmon+1, $logmday, $loghour, $logmin, $logsec);
my $msg = "$logtimestamp $s\n";
print $msg;
open LOG, ">>$LOGFILE";
print LOG colorstrip($msg);
close LOG;
}
The Perl wrapper below executes commands in parallel, saving STDOUT
and STDERR to /tmp files:
open(A,"|parallel");
for $i ("date", "ls", "pwd", "factor 17") {
print A "$i 1> '/tmp/$i.out' 2> '/tmp/$i.err'\n";
}
close(A);
How do I obtain the exit status values from the individual commands?
To get the exist status of the individual jobs, parallel would need to write the info somewhere. I don't know if it does or not. If it doesn't, you can do that yourself.
my %jobs = (
"date" => "date",
"ls" => "ls",
"pwd" => "pwd",
"factor" => "factor 17",
);
open(my $parallel, "|parallel");
for my $id (keys(%jobs)) {
print $parallel
$jobs{$id}
." 1> '/tmp/$id.out'"
." 2> '/tmp/$id.err' ; "
."echo \$?"
." > '/tmp/$id.exit'\n";
}
close($parallel);
my $exit_status = $? >> 8;
if ($exit_status >= 255) {
print("Failed\n");
} else {
printf("%d failed jobs\n", $exit_status);
}
for my $id (keys(%jobs)) {
...grab output and exit code from files...
}
Update:
I went and installed parallel.
It has an option called --joblog {file} which produces a report with exit codes. It accepts - for file name if you want it to output to STDOUT.
Note that parallel doesn't recognise abnormal death by signal, so this is not included in the --joblog report. Using the solution I posted above, a missing .exit file would indicate an abnormal death. (You must make sure it doesn't exist in the first place, though.)
Update:
#Ole Tange mentions that the limitation of --joblog {file} I mentioned above, the lack of logging of death by signal, has been addressed in version 20110722.
GNU Parallel 20110722 has exit val and signal in --joblog:
parallel --joblog /tmp/log false ::: a
cat /tmp/log
Seq Host Starttime Runtime Send Receive Exitval Signal Command
1 : 1311332758 0 0 0 1 0 false a
If you want to avoid the wrapper you could consider:
cat foo | parallel "{} >\$PARALLEL_SEQ.out 2>\$PARALLEL_SEQ.err; echo \$? >\$PARALLEL_SEQ.status"
Version 20110422 or later makes it even shorter:
cat foo | parallel "{} >{#}.out 2>{#}.err; echo \$? >{#}.status"
If your lines do no contain ' then this should work too:
cat foo | parallel "{} >'{}'.out 2>'{}'.err; echo \$? >'{}'.status"
Instead of wrapping parallel, you can use any of the tons of modules available from CPAN providing similar functionality.
For instance:
use Proc::Queue size => 10, qw(run_back);
my #pids;
for $i ("date", "ls", "pwd", "factor 17") {
push #pids, run_back {
open STDOUT, '>', '/tmp/$i.out';
open STDERR, '>', '/tmp/$i.err';
exec $i;
}
}
for (#pids) {
1 while waitfor($_, 0) <= 0;
say "process $_ exit code: ", ($? >> 8);
}