Perl cron job stays running - perl

I'm currently using a cron job to have a perl script that tells my arduino to cycle my aquaponics system and all is well, except the perl script doesn't die as intended.
Here is my cron job:
*/15 * * * * /home/dburke/scripts/hal/bin/main.pl cycle
And below is my perl script:
#!/usr/bin/perl -w
# Sample Perl script to transmit number
# to Arduino then listen for the Arduino
# to echo it back
use strict;
use Device::SerialPort;
use Switch;
use Time::HiRes qw ( alarm );
$|++;
# Set up the serial port
# 19200, 81N on the USB ftdi driver
my $device = '/dev/arduino0';
# Tomoc has to use a different tty for testing
#$device = '/dev/ttyS0';
my $port = new Device::SerialPort ($device)
or die('Unable to open connection to device');;
$port->databits(8);
$port->baudrate(19200);
$port->parity("none");
$port->stopbits(1);
my $lastChoice = ' ';
my $signalOut;
my $args = shift(#ARGV);
# Parent must wait for child to exit before exiting itself on CTRL+C
if ($args eq "cycle") {
open (LOG, '>>log.txt');
print LOG "Cycle started.\n";
my $stop = 0;
sleep(2);
$SIG{ALRM} = sub {
print "Expecting plant bed to be full; please check.\n";
$signalOut = $port->write('2'); # Signal to set pin 3 low
print "Sent cmd: 2\n";
$stop = 1;
};
$signalOut = $port->write('1'); # Signal to arduino to set pin 3 High
print "Sent cmd: 1\n";
print "Waiting for plant bed to fill...\n";
print LOG "Alarm is being set.\n";
alarm (420);
print LOG "Alarm is set.\n";
while ($stop == 0) {
print LOG "In while-sleep loop.\n";
sleep(2);
}
print LOG "The loop has been escaped.\n";
die "Done.";
print LOG "No one should ever see this.";
}
else {
my $pid = fork();
$SIG{'INT'} = sub {
waitpid($pid,0) if $pid != 0; exit(0);
};
# What child process should do
if($pid == 0) {
# Poll to see if any data is coming in
print "\nListening...\n\n";
while (1) {
my $incmsg = $port->lookfor(9);
# If we get data, then print it
if ($incmsg) {
print "\nFrom arduino: " . $incmsg . "\n\n";
}
}
}
# What parent process should do
else {
sleep(1);
my $choice = ' ';
print "Please pick an option you'd like to use:\n";
while(1) {
print " [1] Cycle [2] Relay OFF [3] Relay ON [4] Config [$lastChoice]: ";
chomp($choice = <STDIN>);
switch ($choice) {
case /1/ {
$SIG{ALRM} = sub {
print "Expecting plant bed to be full; please check.\n";
$signalOut = $port->write('2'); # Signal to set pin 3 low
print "Sent cmd: 2\n";
};
$signalOut = $port->write('1'); # Signal to arduino to set pin 3 High
print "Sent cmd: 1\n";
print "Waiting for plant bed to fill...\n";
alarm (420);
$lastChoice = $choice;
}
case /2/ {
$signalOut = $port->write('2'); # Signal to set pin 3 low
print "Sent cmd: 2";
$lastChoice = $choice;
}
case /3/ {
$signalOut = $port->write('1'); # Signal to arduino to set pin 3 High
print "Sent cmd: 1";
$lastChoice = $choice;
}
case /4/ {
print "There is no configuration available yet. Please stab the developer.";
}
else { print "Please select a valid option.\n\n";}
}
}
}
}
When I run ps -ef I find the following output:
dburke 15294 15293 0 14:30 ? 00:00:00 /bin/sh -c /home/dburke/scripts/hal/bin/main.pl cycle
dburke 15295 15294 0 14:30 ? 00:00:00 /usr/bin/perl -w /home/dburke/scripts/hal/bin/main.pl cycle
Shouldn't there only be one process? Is it forking even though it received the cycle argument and the fork is outside of the cycle argument's if block?
Any idea why it wouldn't die from the statement die "Done.";? It runs fine from the command line and interprets the 'cycle' argument fine. When it runs in cron it runs fine, however, the process never dies and while each process doesn't continue to cycle the system it does seem to be looping in some way due to the fact that it ups my system load very quickly.
If you'd like more information, just ask. Thanks guys!

It looks as thought the issue was that my script originally encapsulated the cycle block inside of the fork which for some reason, unknown to me, was leaving a process open (possibly the child?). Taking the cycle block out of the fork has corrected the issue. Now it runs at the specified time and correctly dies after the cycle is complete leaving my cpu load for something more useful. :)
Thank you everyone who commented on my question. You suggestions helped me work through the issue.

Related

Monitoring stdout of a forked process in perl by character

I am attempting to launch a subprocess in perl that either:
Successfully runs to conclusion
Takes too long and needs to be killed
Prints an error message to STDERR and hangs and needs to be killed
I could handle just the timeout issue (2) with waitpid.
I could look for messages on STDOUT with a while (<CHILD_HANDLE>) loop.
I could read the STDOUT and STDERR by appending 2>&1 to the process string.
But, this got more complicated when I realized that after sending an error to STDERR (3), the child process does not return a line break, and then hangs for a while. I could wait for a timeout as in (2), but I'd prefer to identify the error right away. So I switched from while (<CHILD_HANDLE>) syntax to while ($next_letter = getc(<CHILD_HANDLE>)) syntax. This worked with a toy test process, but when I try it with the real command I'm monitoring, I am finding that the child process terminates after sending a single character ("\n"). This may be difficult to troubleshoot without my sharing details of the actual subprocess, but I'm hoping some guidance can be provided.
Here is the simplified code I've got:
#!/usr/bin/perl
use POSIX qw(:sys_wait_h WNOHANG);
my $TIMEOUT = 60 * 30; # 30 minutes
my $alarm_hit = 0;
my $pid = open(CHILD_HANDLE, "-|", 'command arg1 arg2 arg3 2>&1' ));
die "Could not fork\n" if not defined $pid;
if ($pid > 0) {
# set the timeout alarm
local $SIG{ALRM} = sub {kill 9, $pid; print "Killing process after timeout\n"; $alarm_hit = 1; };
alarm $TIMEOUT;
my $next_letter;
my $buffer;
# read the next character from the child
READ_LOOP: while ($next_letter = getc(CHILD_HANDLE)) {
$buffer .= $next_letter;
# if we see the error message
if ($buffer =~ /Error Message/) {
print "======= HIT ERROR MESSAGE\n";
# kill the child
close CHILD_HANDLE;
kill 'KILL', $pid;
last READ_LOOP;
# if the timeout alarm was hit
} elsif ($alarm_hit == 1) {
close READ_LOOP;
print "======= ALARM HIT\n";
last READ_LOOP;
# else print the child output when we hit a new line
} elsif ($next_letter eq "\n") {
print "> $buffer";
$buffer = '';
}
}
}

Perl subroutine timeout

I have a subroutine that normally takes 1 second to run. Sometimes, it can run infinitely. I want to move on in the code if the subroutine is taking too long (> 10 seconds) and ignore that run of that subroutine. Here is what I have so far using alarm.
use Win32::OLE;
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 10; # schedule alarm in 10 seconds
&do_the_subroutine;
alarm 0; # cancel the alarm
};
if ($#) {
$error_string .= $script;
#Do something else if the subroutine took too long.
}
do_the_subroutine{
# use existing instance if Excel is already running
eval {$ex = Win32::OLE->GetActiveObject('Excel.Application')};
die "Excel not installed" if $#;
unless (defined $ex) {
$ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;})
or die "Oops, cannot start Excel";
}
# get a new workbook
$book = $ex->Workbooks->Add;
# write to a particular cell
$sheet = $book->Worksheets(1);
$sheet->Cells(1,1)->{Value} = "foo";
# write a 2 rows by 3 columns range
$sheet->Range("A8:C9")->{Value} = [[ undef, 'Xyzzy', 'Plugh' ],
[ 42, 'Perl', 3.1415 ]];
# print "XyzzyPerl"
$array = $sheet->Range("A8:C9")->{Value};
for (#$array) {
for (#$_) {
print defined($_) ? "$_|" : "<undef>|";
}
print "\n";
}
# save and exit
$book->SaveAs( 'test.xls' );
undef $book;
undef $ex;
}
&do_the_subroutine never returns so I'm not able to move on. I'm also not able to put this block of code inside that subroutine. Any thoughts?
I suspect that what you want to do is simply not natively possible with alarm on Windows.
From perldoc perlport:
alarm Emulated using timers that must be explicitly polled whenever
Perl wants to dispatch "safe signals" and therefore cannot
interrupt blocking system calls. (Win32)

Time out when using system cmd in perl

I'm using PSEXEC to run remote process with system($CMD) in perl.
I have a computer (lets call it-#1) that runs system cmd, and another computer (lets call it-#2), which "receives" commands from computer #1.
Sometimes the process in the second computer (#2) gets stuck.
How can I set a timeout to the system cmd in computer #1 that will force-terminate the cmd after several minutes?
thanks for the answers, but:
i'm tring to do somthing very simple, I have 2 perl files.
file#1 that counting seconds 1 to 10. (+print to the screen)
file#2-Timeout file that cal file#1 (system command) that should terminate file #1 after 5 sec.
the results...:
timeout occurred, but process #1 still running...
file#2
$timeout=5;
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $timeout;
$nread = system('F:\perl1.pl');
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
print "process terminated\n";}
else {
# didn't
}
file#1
$i=0;
while($
i<10){
sleep(1);
$i++;
print "$i\n";
}
CMD window results:
C:\>F:\perl2.pl
1
2
3
4
process terminated
C:\>5
6
7
8
9
10
Let IPC::Run handle that for you.
use IPC::Run qw( run timeout );
run \#cmd, timeout( 120 )
or die "cat: $?";
You could use alarm in your situation:
If you want to use alarm to time out a system call you need to use an
eval/die pair. You can't rely on the alarm causing the system call to
fail with $! set to EINTR because Perl sets up signal handlers to
restart system calls on some systems. Using eval/die always works,
modulo the caveats given in Signals in perlipc.
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $timeout;
$nread = sysread SOCKET, $buffer, $size;
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
# didn't
}

How can I terminate a system command with alarm in Perl?

I am running the below code snippet on Windows. The server starts listening continuously after reading from client. I want to terminate this command after a time period.
If I use alarm() function call within main.pl, then it terminates the whole Perl program (here main.pl), so I called this system command by placing it in a separate Perl file
and calling this Perl file (alarm.pl) in the original Perl File using the system command.
But in this way I was unable to take the output of this system() call neither in the original Perl File nor in called one Perl File.
Could anybody please let me know the way to terminate a system() call or take the output in that way I used above?
main.pl
my #output = system("alarm.pl");
print"one iperf completed\n";
open FILE, ">display.txt" or die $!;
print FILE #output_1;
close FILE;
alarm.pl
alarm 30;
my #output_1 = readpipe("adb shell cd /data/app; ./iperf -u -s -p 5001");
open FILE, ">display.txt" or die $!;
print FILE #output_1;
close FILE;
In both ways display.txt is always empty.
There are a few separate issues here.
First, to keep the alarm from killing your script, you need to handle the ALRM signal. See the alarm documentation. You shouldn't need two scripts for this.
Second, system doesn't capture output. You need one of the backtick variants or a pipe if you want to do that. There are answers for that on Stackoverflow already.
Third, if alarm.pl puts anything in display.txt, you discard it in main.pl when you re-open the file in write mode. You only need to create the file in one place. When you get rid of the extra script, you won't have this problem.
I recently had some problems with alarm and system, but switching to IPC::System::Simple fixed that.
Good luck, :)
What the hell was I thinking? You don't need a background process for this task. You just need to follow the example in the perldoc -f alarm function and wrap your time-sensitive code in an eval block.
my $command = "adb shell cd /data/app; ./iperf -u -s -p 5001";
my #output;
eval {
local $SIG{ALRM} = sub { die "Timeout\n" };
alarm 30;
#output = `$command`;
alarm 0;
};
if ($#) {
warn "$command timed out.\n";
} else {
print "$command successful. Output was:\n", #output;
}
Inside the eval block, you can capture your output the regular way (with backticks or qx() or readpipe). Though if the call times out, there won't be any output.
If you don't need the output (or don't mind hacking some interprocess communication together), an almost idiot-proof alternative is to set the alarm and run the system call in a child process.
$command = "adb shell cd /data/app; ./iperf -u -s -p 5001";
if (($pid = fork()) == 0) {
# child process
$SIG{ALRM} = sub { die "Timeout\n" }; # handling SIGALRM in child is optional
alarm 30;
my $c = system($command);
alarm 0;
exit $c >> 8; # if you want to capture the exit status
}
# parent
waitpid $pid, 0;
waitpid will return when either the child's system command is finished, or when the child's alarm goes off and kills the child. $? will hold the exit code of the system call, or something else (142 on my system) for an unhandled SIGALRM or 255 if your SIGALRM handler calls die.
I run into a similar problem that requires:
run a system command and get its output
time out the system command after x seconds
kill the system command process and all child processes
After much reading about Perl IPC and manual fork & exec, I came out with this solution. It is implemented as a simulated 'backtick' subroutine.
use Error qw(:try);
$SIG{ALRM} = sub {
my $sig_name = shift;
die "Timeout by signal [$sig_name]\n";
};
# example
my $command = "vmstat 1 1000000";
my $output = backtick(
command => $command,
timeout => 60,
verbose => 0
);
sub backtick {
my %arg = (
command => undef,
timeout => 900,
verbose => 1,
#_,
);
my #output;
defined( my $pid = open( KID, "-|" ) )
or die "Can't fork: $!\n";
if ($pid) {
# parent
# print "parent: child pid [$pid]\n" if $arg{verbose};
try {
alarm( $arg{timeout} );
while (<KID>) {
chomp;
push #output, $_;
}
alarm(0);
}
catch Error with {
my $err = shift;
print $err->{-text} . "\n";
print "Killing child process [$pid] ...\n" if $arg{verbose};
kill -9, $pid;
print "Killed\n" if $arg{verbose};
alarm(0);
}
finally {};
}
else {
# child
# set the child process to be a group leader, so that
# kill -9 will kill it and all its descendents
setpgrp( 0, 0 );
# print "child: pid [$pid]\n" if $arg{verbose};
exec $arg{command};
exit;
}
wantarray ? #output : join( "\n", #output );
}
Might use "timeout -n " for wrapping your commands if thats already common on your system.

How can I test STDIN without blocking in Perl?

I'm writing my first Perl app -- an AOL Instant Messenger bot that talks to an Arduino microcontroller, which in turn controls a servo that will push the power button on our sysadmin's server, which freezes randomly every 28 hours or so.
I've gotten all the hard stuff done, I'm just trying to add one last bit of code to break the main loop and log out of AIM when the user types 'quit'.
The problem is, if I try to read from STDIN in the main program loop, it blocks the process until input is entered, essentially rendering the bot inactive. I've tried testing for EOF before reading, but no dice... EOF just always returns false.
Here's below is some sample code I'm working with:
while(1) {
$oscar->do_one_loop();
# Poll to see if any arduino data is coming in over serial port
my $char = $port->lookfor();
# If we get data from arduino, then print it
if ($char) {
print "" . $char ;
}
# reading STDIN blocks until input is received... AAARG!
my $a = <STDIN>;
print $a;
if($a eq "exit" || $a eq "quit" || $a eq 'c' || $a eq 'q') {last;}
}
print "Signing off... ";
$oscar->signoff();
print "Done\n";
print "Closing serial port... ";
$port->close() || warn "close failed";
print "Done\n";
The Perl built-in is select(), which is a pass-through to the select() system call, but for sane people I recommend IO::Select.
Code sample:
#!/usr/bin/perl
use IO::Select;
$s = IO::Select->new();
$s->add(\*STDIN);
while (++$i) {
print "Hiya $i!\n";
sleep(5);
if ($s->can_read(.5)) {
chomp($foo = <STDIN>);
print "Got '$foo' from STDIN\n";
}
}
I found that IO::Select works fine as long as STDOUT gets closed, such as when the upstream process in the pipeline exits, or input is from a file. However, if output is ongoing (such as from "tail -f") then any partial data buffered by <STDIN> will not be displayed. Instead, use the unbuffered sysread:
#!/usr/bin/perl
use IO::Select;
$s = IO::Select->new(\*STDIN);
while (++$i) {
if ($s->can_read(2)) {
last unless defined($foo=get_unbuf_line());
print "Got '$foo'\n";
}
}
sub get_unbuf_line {
my $line="";
while (sysread(STDIN, my $nextbyte, 1)) {
return $line if $nextbyte eq "\n";
$line .= $nextbyte;
}
return(undef);
}