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();
}
}
Related
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.
}
}
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.
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;
}
I need to create a program that would run 3 processes at the same time in random sequence from a list and lock those processes with semaphore one by one so to avoid duplicates.
For example, you have a list of 3 programs:
#array = ( 1,2,3);
perl script.pl runs 2 at first;
By random tries to run 2 again and receives an error (because 2 is now locked with semaphore).
Runs 1.
Runs 3.
script.pl waits all of 1,2,3 to end work and then exit itself.
Here's my code so far:
#!/usr/bin/perl -w
use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR IPC_CREAT);
use IPC::Semaphore;
use Carp ();
print "Program started\n";
sub sem {
#semaphore lock code here
}
sub chooseProgram{
#initialise;
my $program1 = "./program1.pl";
my $program2 = "./program2.pl";
my $program3 = "./program3.pl";
my $ls = "ls";
my #programs = ( $ls, $program1, $program2, $program3 );
my $random = $programs[int rand($#programs+1)];
print $random."\n";
return $random;
}
#parent should fork child;
#child should run random processes;
#avoid process clones with semaphore;
sub main{
my $pid = fork();
if ($pid){
#parent here
}
elsif (defined($pid)){
#child here
print "$$ Child started:\n";
#simple cycle to launch and lock programs
for (my $i = 0; $i<10; $i++){
# semLock(system(chooseProgram()); #run in new terminal window
# so launched programs are locked and cannot be launched again
}
}
else {
die("Cannot fork: $!\n");
}
waitpid($pid, 0);
my $status = $?;
#print $status."\n";
}
main();
exit 0;
Problems:
Need to lock file; (I don't know how to work with semaphore. Failed some attempts to lock files so excluded that code.)
Child waits until first program ends before second start. How can I start three of programs at the same time with one child? (Is it possible or should I create one child for one program?).
Programs are non-gui and should run in terminal. How to run a program in new terminal window(tab)?
No correct check if all programs of #programs were launched yet. -- less important.
Your randomness requirement is very strange, but if I understood your requirements correctly, you don't need any sort of locking to do what you want. (So 1) in your question is gone)
Start by shuffling the program array, then start each command of that shuffled array (this deals with your 4)). Then only waitpid after you've started everything (which deals with your 2)).
The code below does that, starting various sleep instances in new terminals (I use urxvt, adapt depending on what terminal you want to spawn - this deals with your 3)).
#! /usr/bin/perl -w
use strict;
use warnings;
my #progs = ("urxvt -e sleep 5", "urxvt -e sleep 2", "urxvt -e sleep 1");
my #sgrop;
my #pids;
# Shuffle the programs
while (my $cnt = scalar(#progs)) {
push #sgrop, splice #progs, int(rand($cnt)), 1;
}
# Start the progs
foreach my $prog (#sgrop) {
my $pid = fork();
if (!$pid) {
exec($prog);
# exec does not return
} else {
print "Started '$prog' with pid $pid\n";
push #pids, $pid;
}
}
# Wait for them
map {
waitpid($_, 0);
print "$_ done!\n";
} (#pids);
Not sure the shuffling is the best out there, but it works. The idea behind it is just to pick one element at random from the initial (sorted) list, remove it from the there and add it to the shuffled one. Repeat until the initial list is empty.
If you're trying to lock the programs system wide (i.e. no other process in your system should be able to start them), then I'm sorry but that's not possible unless the programs protect themselves from concurrent execution.
If your question was about semaphores, then I'm sorry I missed your point. The IPC documentation has sample code for that. I don't really think it's necessary to go to that complexity for what you're trying to do though.
Here's how you could go about it using the IPC::Semaphore module for convenience.
At the start of your main, create a semaphore set with as many semaphores as required:
use IPC::SysV qw(S_IRUSR S_IWUSR IPC_CREAT IPC_NOWAIT);
use IPC::Semaphore;
my $numprocs = scalar(#progs);
my $sem = IPC::Semaphore->new(1234, # this random number is the semaphore key. Use something else
$numprocs, # number of semaphores you want under that key
S_IRUSR | S_IWUSR | IPC_CREAT);
Check for errors, then initialize all the semaphores to 1.
$sem->setall( (1) x $numprocs) || die "can't set sems $!";
In the code that starts your processes, before you start (after the fork though), try to grab the semaphore:
if ($sem->op($proc_number, -1, IPC_NOWAIT)) {
# here, you got the semaphore - so nothing else is running this program
# run the code
# and once the code is done:
$sem->op($proc_number, 1, 0); # release the semaphore
exit(0);
} else {
# someone else is running this program already
exit(1); # or something
}
In the above, $proc_number must be unique for each program (could be it's index in your programs array for instance). Don't use exec to start the program. Use system instead for example.
Note that you will have to deal with the exit code of the child process in this case. If the exit code is zero, you can mark that program as having run. If not, you need to retry. (This is going to get messy, you'll need to track which program was run or not. I'd suggest a hash with the program number ($proc_number) where you'd store whether it already completed or not, and the current pid running (or trying to run) that code. You can use that hash to figure out what program still needs to be executed.)
Finally after all is done and you've waited for all the children, you should clean up after yourself:
$sem->remove;
This code lacks proper error checking, will work strangely (i.e. not well at all) if the cleanup was not done correctly (i.e. semaphores are already laying around when the code starts). But it should get you started.
I'm writing a Perl script which uses an external script. The external script must run from a specific directory so I found the following useful:
use IPC::System::Simple qw(capture);
my #args = ('external script path...', 'arg1', ...);
my $out = capture( [0], "cd $dir ; #args" );
Sometimes the external script writes stuff to STDERR but still returns 0. I wish to capture these times and confess (or die). Since I don't control the return value of the external script, I thought maybe I could capture its STDERR so I'll have something like this:
my ($out, $err) = cool_capture( [0], "cd $dir ; #args" );
say "Output was: $out";
if ($err) {
die "Error: this was written to STDERR: $err";
}
What can I do?
This is covered in the Perl FAQ.
Presuming test_app is a program that outputs one line to stdout and one line to stderr:
use IPC::Open3;
use Symbol 'gensym';
my($wtr, $rdr, $err);
$err = gensym;
my $pid = open3($wtr, $rdr, $err, 'test_app');
waitpid($pid, 0);
my $status = $? >> 8;
my $stdout = <$rdr>;
my $stderr = <$err>;
print "out output: $stdout\n";
print "err output: $stderr\n";
print "Exit code: $status\n";
EDIT: Per the request updated to include capturing the exit code. You could also have asked perldoc IPC::Open3 which says
waitpid( $pid, 0 );
my $child_exit_status = $? >> 8;
And which you should read anyway for its cautions and caveats.
If significant output is being written to stdout and/or stderr or you're both reading and writing to the process. You need to be a lot more careful with your I/O handling to avoid various blocking problems.
my ($wtr, $rdr, $err) ;
my $pid = IPC::Open3::open3($wtr, $rdr, $err, #_);
close($wtr);
my $stdout = '';
my $stderr = '';
my $s = IO::Select->new;
$s->add($rdr) if $rdr;
$s->add($err) if $err;
while (my #ready = $s->can_read) {
foreach my $ioh (#ready) {
my $bytes_read = sysread($ioh, my $chunk = '', 1024);
die "read error: $!" unless $bytes_read >= 0;
if ($bytes_read) {
($ioh eq $rdr? $stdout: $stderr) .= $chunk;
}
else {
$s->remove($ioh);
}
}
}
my $pid1;
for (;;) {
last if kill(0, $pid);
$pid1 = wait();
#
# Wait until we see the process or -1 (no active processes);
#
last if ($pid1 == $pid || $pid1 <= 0);
}
Finish reading before you shutdown the process. If you're writing to the process's stdin, you'd also need to add $wtr and syswrite to the above select loop.
EDIT
Rationale:
The above is probably overkill for simple cases. This advanced handling of input and output comes into play when you're likely to move more than a few K of data.
You wouldn't need it if you were executing a 'df' command for example.
However, it's when system buffers for any of stdin, stdout or stderr fill up that blocking becomes likely and things can get more involved.
If the child process fills up the stderr and/or stdout buffers, it'll likely block and wait for you to clear them. But if you're waiting for the process finish before you read from stdout or stderr; thats a deadlock. You'll likely to see that the system call never finishes and the child process never completes.
There's a similar possibility of deadlock if stdin is being written to, but the child process is unable to consume the input. This is particularly likely in a 'pipe' situation where the child process is consuming input and writing to stdout.
The select loop is about progressively clearing the buffers to avoid blocking. Both stdout and stderr are monitored concurrently.
If you're writing to stdin and reading from stdout (a pipe), you'll want to keep stdout and stderr clear and only write to stdin when its ready to receive input.
Simply waiting for the process to finish, then reading stdout/stderr probably works 90% of the time. This reply is just to give you somewhere to go if things get more complicated and processes start to block or go into deadlock.
EDIT2
As for which to use, I'd say start simple, test hard.
Go with Sorpigal's approach, but try to stress test with higher data volumes and under more difficult loads and conditionals that you'd ever expect in a live system.