Oct 212008
 

The Spec

The Perl system() function is very powerful and elegant. It forks a child process, suspends the parent process, executes the provided command (potentially calling your shell to help parse the arguments), while seamlessly redirecting all IO between the parent and child process! The usage is simple, but what happens behind the scenes is amazing!

Unfortunately, there is no way to interrupt the system() function in Perl. Sure, you can kill the main Perl program, but that’s not what I want. I want to call system() with 2 additional arguments: timeout and maxattempts. This subroutine would operate just like the traditional system() function, unless operation time exceeded the timeout value, in which case, the command would be killed and restarted, until the maximum number of attempts was exceeded.

A Dead End

You can find many resources that detail how to timeout a long Perl operation, like so:

eval {
    local $SIG{ALRM} = sub { die "alarm clock restart" };
    alarm 10;
    flock(FH, 2);   # blocking write lock
    alarm 0;
};
if ($@ and $@ !~ /alarm clock restart/) { die }

Unfortunately, there is a little footnote that says you should not try this with system calls; otherwise, you get zombies. Sure enough, if you substitute a system() function for the above flock, the parent Perl script is alarmed by the timeout and exits the eval. Normally, this would kill the flock or any other function. But the system function persits. The parent may even complete the remainder of its program and exit, but the child will keep on ticking – not what I wanted. The second problem is that there is no way to get, or access the process id of the command executed by the system() function; therefore, there is no way to kill a system function call by the parent Perl process – at least, no way that I have found.

The above link suggests using fork and exec to create your own function, which is ultimately what I did. So, let’s jump straight to the chase scene, shall we? Here’s my final solution.

Preferred Solution

#!/usr/bin/perl -w
use strict 'refs';
use POSIX "sys_wait_h";

sub timedSystemCall {

  my ($cmd, $timeout, $maxattempts, $attempt, $origmax) = @_;

  # degenerate into system() call - infinite timeout, if timeout is undefined or negative
  $timeout = 0 unless defined($timeout) && ($timeout > 0);
  # degenerate into system() call - 1 attempt, if max attempts is undefined or negative
  $maxattempts = 1 unless defined($maxattempts) && ($maxattempts > 0);
  $attempt = 1 unless defined($attempt) && ($attempt > 0);
  $origmax = $maxattempts unless defined $origmax;

  local ($rc, $pid);

  eval {
    local $SIG{ALRM} = sub { die "TIMEOUT" };

    # Fork child, system process
  FORK: {
      if ($pid = fork) {
        # parent picks up here, with $pid = process id of child; however...
        # NO-OP - Parent does nothing in this case, except avoid branches below...
      } elsif (defined $pid) {  # $pid is zero if here defined
        # child process picks up here - parent process available with getppid()
        # execute provided command, or die if fails
        exec($cmd) || die("(E) timedSystemCall: Couldn't run $cmd: $!\n");
        # child never progresses past here, because of (exec-or-die) combo
      } elsif ($! =~ /No more processes/) {
        # Still in parent:  EAGAIN, supposedly recoverable fork error
        print STDERR "(W) timedSystemCall: fork failed.  Retrying in 5-seconds. ($!)\n";
        sleep 5;
        redo FORK;
      } else {
        # unknown fork error
        die "(E) timedSystemCall:  Cannot fork: $!\n";
      }
    }

    # set alarm to go off in "timeout" seconds, and call $SIG{ALRM} at that time
    alarm($timeout);
    # hang (block) until program is finished
    waitpid($pid, 0);

    # program is finished - disable alarm
    alarm(0);
    # grab output of waitpid
    $rc = $?;
  };                            # end of eval

  # Did eval exit from an alarm timeout?
  if (($@ =~ "^TIMEOUT") || !defined($rc)) {
    # Yes - kill process
    kill(KILL => $pid) || die "Unable to kill $pid - $!";
    # Collect child's remains
    ($ret = waitpid($pid,0)) || die "Unable to reap child $pid (ret=$ret) - $!";
    # grab exit output of child process
    if ($rc = $?) {
      # exit code is lower byte: shift out exit code, leave top byte in $rc
      my $exit_value = $rc >> 8;
      # killing signal is lower 7-bits of top byte, which was shifted to lower byte
      my $signal_num = $rc & 127;
      # core-dump flag is top bit
      my $dumped_core = $rc & 128;
      # Notify grandparent of obituary
      print STDERR "(I) timedSystemCall:  Child $pid obituary: exit=$exit_value, kill_signal=$signal_num, dumped_core=$dumped_core\n";
    }
    # Can we try again?
    if ($maxattempts > 1) {
      # Yes! Increment counter, for print messages
      $attempt++;
      print STDERR "(W) timedSystemCall:  Command timed-out after $timeout seconds.  Restarting ($attempt of $origmax)...\n";
      # Recurse into self, while decrementing number of attempts. Return value from deepest recursion
      return timedSystemCall($cmd, $timeout, $maxattempts-1, $attempt, $origmax);
    } else {
      # No!  Out of attempts...
      print STDERR "(E) timedSystemCall:  Exhausted maximum attempts ($origmax) for command: $cmd\nExiting!\n";
      # Return error code of killed process - will require interpretation by parent
      return $rc;
    }
  } else {
    # No - process completed successfully!  Hooray!!!  Return success code (should be zero).
    return $rc;
  }
}

exit timedSystemCall("inf.pl", 5, 3);

The reason this solution is preferred is because it does not consume CPU while waiting for the child to complete or timeout. Furthermore, it’s the simplest and most elegant solution I have found.

This solution works because the child inherits the exact same environment as the parent, including its standard IO handles (STDOUT, STDIN, STDERR), just as does the command issued by the system() function. Therefore, when the child prints to its STDOUT, it is printing directly to the parent’s STDOUT. And, when the child requests input from its STDIN, it is querying its parent’s STDIN. Therefore, we are not required to perform any fancy polling to copy the child’s output to the parent’s output, or otherwise shuttle communication between the child and the parent’s environment. Moreover, if the parent is killed for some reason, our child process is also killed, so we don’t have to worry about zombies – as much.

The hints for this solution came from an example on pg. 167 of O’Reilly’s Programming Perl, under the fork function description, and from pg. 554-555 of O’Reilly’s Perl Cookbook, under the discussion, “16.1. Gathering Output from a Program”.

Unfortunately, this was not the first solution I created. If you are interested, a few other solutions I found are provided following a few usage examples. Both of these other solutions mostly work; however, they have drawbacks, when compared to the above, preferred solution.

Usage Examples

If the above script is called using the infinite output script as a child, you get output like so:

perl: timedSystemCall("inf.pl", 5, 3);
1
2
3
4
5
(I) timedSystemCall:  Child 14672 obituary: exit=0, kill_signal=9, dumped_core=0
(W) timedSystemCall:  Command timed-out after 5 seconds.  Restarting (2 of 3)...
1
2
3
4
5
(I) timedSystemCall:  Child 14683 obituary: exit=0, kill_signal=9, dumped_core=0
(W) timedSystemCall:  Command timed-out after 5 seconds.  Restarting (3 of 3)...
1
2
3
4
5
(I) timedSystemCall:  Child 14685 obituary: exit=0, kill_signal=9, dumped_core=0
(E) timedSystemCall:  Exhausted maximum attempts (3) for command: inf.pl
$ echo $?
9

This particular child produces output every second for infinity, except it is limited by our new function for a 5-second timeout with a maximum of 3 attempts. The function politely reports all restarts on standard error, so not to comingle with the standard output.

If the system() call does not exceed the timeout, or if the last two arguments are omitted, then the perl script ends as would be expected of a normal system() call, like so:

# complete in 3 seconds - before 5 sec timeout
perl: timedSystemCall("inf.pl 3", 5, 3);
1
2
3
$ echo $?
# degenerate into system() behavior
perl: timedSystemCall("inf.pl");
0
1
2
3
4
5
6
7
8
9
^C
Captured SIGINT.  Exiting after 9 seconds.
$ echo $?
130

Hopefully, you will find this function useful. If you are intested in better understanding a few alternatives, although lesser they may be, then read on! Otherwise, enjoy this new function!

Solution #1

My first solution hinges around the open3 function, which launches the input command and returns the essential process id, so we can kill it, if it runs too long. Output is synchronized by polling non-blocking versions of the child’s output handles, and dumping them to the parent’s output. This waiting loop is CPU bound, so it consumes 100% of one CPU, trying to keep the outputs synchronized – bad! Furthermore, the child’s input is not synchronized – very bad!

use IPC::Open3;
use Fcntl;
use POSIX "sys_wait_h";

sub timedSystemCall {

  local ($cmd, $timeout, $maxattempts, $retry, $origmax) = @_;

  # degenerate into system() call - infinite timeout, if timeout is undefined or negative
  $timeout = 0 unless defined($timeout) && ($timeout > 0);
  # degenerate into system() call - 1 attempt, if max attempts is undefined or negative
  $maxattempts = 1 unless defined($maxattempts) && ($maxattempts > 0);
  $attempt = 1 unless defined($attempt) && ($attempt > 0);
  $origmax = $maxattempts unless defined $origmax;

  local ($rc, $pid);

  eval {
    local $SIG{ALRM} = sub { die "TIMEOUT" };

    $pid = open3(\*WTR, \*RDR, \*ERR, $cmd) || die("(E) timedSystemCall: Unable to launch command - $cmd\n$!\n");
    # Make reads from RDR to be non-blocking
    my $rflags = 0;
    fcntl(RDR, F_GETFL, $rflags) || die $!;
    $rflags |= O_NONBLOCK;
    fcntl(RDR, F_SETFL, $rflags) || die $!;
    # Make reads from RDR to be non-blocking
    my $eflags = 0;
    fcntl(ERR, F_GETFL, $eflags) || die $!;
    $eflags |= O_NONBLOCK;
    fcntl(ERR, F_SETFL, $eflags) || die $!;
    #$pid = open3(">&STDIN", "<&STDOUT", "<&STDERR", $cmd) || die("(E) timedSystemCall: Unable to launch command - $cmd\n$!\n");

    alarm($timeout);

    # Is program finished?
    until (waitpid($pid, WNOHANG)) {
      # No!
      # NONBLOCKING: Did the program produce any output (STDOUT)?
      while () {
        # Yes - dump output to this program's STDOUT
        print STDOUT;
      }
      #NONBLOCKING: Did the program produce any errors (STDERR)?
      while () {
        # Yes - dump errors to this program's STDERR
        print STDERR;
      }
    } # exit until
    # program is finished - disable alarm
    alarm(0);
    # grab output of waitpid, and separate bytes
    $rc = $?;
    # close associated IO handles
    close(WTR);
    close(RDR);
    close(ERR);
  }; # end of eval

  # Did eval exit from an alarm timeout?
  if (($@ =~ "^TIMEOUT") || !defined($rc)) {
    # Yes - kill process
    kill(KILL => $pid) || die "Unable to kill $pid - $!";
    # Collect child's remains
    ($ret = waitpid($pid,0)) || die "Unable to reap child $pid (ret=$ret) - $!";
    # grab exit output of child process
    if ($rc = $?) {
      # exit code is lower byte: shift out exit code, leave top byte in $rc
      my $exit_value = $rc >> 8;
      # killing signal is lower 7-bits of top byte, which was shifted to lower byte
      my $signal_num = $rc & 127;
      # core-dump flag is top bit
      my $dumped_core = $rc & 128;
      # Notify grandparent of obituary
      print "(I) timedSystemCall:  Child $pid obituary: exit=$exit_value, kill_signal=$signal_num, dumped_core=$dumped_core\n";
    }
    # Can we try again?
    if ($maxattempts > 1) {
      # Yes! Increment counter, for print messages
      $retry++;
      print "(W) timedSystemCall:  Command timed-out after $timeout seconds.  Restarting ($retry of $origmax)...\n";
      # Recurse into self, while decrementing number of attempts. Return value from deepest recursion
      return timedSystemCall($cmd, $timeout, $maxattempts-1, $retry, $origmax);
    } else {
      # No!  Out of attempts...
      print "(E) timedSystemCall:  Exhausted maximum attempts ($origmax) for command: $cmd\nExiting!\n";
      # Return error code of killed process - will require interpretation by parent
      return $rc;
    }
  } else {
    # No - process completed successfully!  Hooray!!!  Return success code (should be zero).
    return $rc;
  }
}

The intense CPU utilization and lack of STDIN synchronization makes this solution undersirable and arguably a failure. It worked in my particular application, but it may not work in others. Between this issue and the unnecessary CPU utilization, this solution is an academic curiosity, but nothing more.

Solution #2

The second solution is similar to the first, because it depends on the open3 function. However, it directly connects the child’s IO handles to the parents, so that it behaves more like the final, preferred soltuion.

#!/usr/bin/perl -w
use strict 'refs';

use FileHandle;
use IPC::Open3;
use POSIX "sys_wait_h";

sub timedSystemCall {

  local ($cmd, $timeout, $maxattempts, $retry, $origmax) = @_;

  # degenerate into system() call - infinite timeout, if timeout is undefined or negative
  $timeout = 0 unless defined($timeout) && ($timeout > 0);
  # degenerate into system() call - 1 attempt, if max attempts is undefined or negative
  $maxattempts = 1 unless defined($maxattempts) && ($maxattempts > 0);
  $attempt = 1 unless defined($attempt) && ($attempt > 0);
  $origmax = $maxattempts unless defined $origmax;

  local ($rc, $pid, *DUPOUT, *DUPERR, *DUPIN);

  eval {
    local $SIG{ALRM} = sub { die "TIMEOUT" };

    # duplicate stdandard IO handles
    open DUPOUT, ">&STDOUT";
    open DUPERR, ">&STDERR";
    open DUPIN,  "<&STDIN";
    # launch child command, attached directly to standard IO handles
    $pid = open3("<&STDIN", ">&STDOUT", ">&STDERR", $cmd) || die("(E) timedSystemCall: Unable to launch command - $cmd\n$!\n");
    # select primary output, and then disable buffering (activate auto-flush)
    select STDERR; $| = 1;
    select STDOUT; $| = 1;

    # set alarm to go off in "timeout" seconds, and call $SIG{ALRM} at that time
    alarm($timeout);
    # hang (block) until program is finished
    waitpid($pid, 0);

    # program is finished - disable alarm
    alarm(0);
    # grab output of waitpid
    $rc = $?;
    # close child's associated IO handles
    close(STDOUT);
    close(STDERR);
    close(STDIN);
    # restore orig handles
    open STDOUT, ">&DUPOUT";
    open STDERR, ">&DUPERR";
    open STDIN, "<&DUPIN";
  }; # end of eval

  # Did eval exit from an alarm timeout?
  if (($@ =~ "^TIMEOUT") || !defined($rc)) {
    # Yes - kill process
    kill(KILL => $pid) || die "Unable to kill $pid - $!";
    # Collect child's remains
    ($ret = waitpid($pid,0)) || die "Unable to reap child $pid (ret=$ret) - $!";
    # close child's associated IO handles
    close(STDOUT);
    close(STDERR);
    close(STDIN);
    # restore orig handles
    open STDOUT, ">&DUPOUT";
    open STDERR, ">&DUPERR";
    open STDIN, "<&DUPIN";
    # grab exit output of child process
    if ($rc = $?) {
      # exit code is lower byte: shift out exit code, leave top byte in $rc
      my $exit_value = $rc >> 8;
      # killing signal is lower 7-bits of top byte, which was shifted to lower byte
      my $signal_num = $rc & 127;
      # core-dump flag is top bit
      my $dumped_core = $rc & 128;
      # Notify grandparent of obituary
      print "(I) timedSystemCall:  Child $pid obituary: exit=$exit_value, kill_signal=$signal_num, dumped_core=$dumped_core\n";
    }
    # Can we try again?
    if ($maxattempts > 1) {
      # Yes! Increment counter, for print messages
      $retry++;
      print "(W) timedSystemCall:  Command timed-out after $timeout seconds.  Restarting ($retry of $origmax)...\n";
      # Recurse into self, while decrementing number of attempts. Return value from deepest recursion
      return timedSystemCall($cmd, $timeout, $maxattempts-1, $retry, $origmax);
    } else {
      # No!  Out of attempts...
      print "(E) timedSystemCall:  Exhausted maximum attempts ($origmax) for command: $cmd\nExiting!\n";
      # Return error code of killed process - will require interpretation by parent
      return $rc;
    }
  } else {
    # No - process completed successfully!  Hooray!!!  Return success code (should be zero).
    return $rc;
  }
}

exit timedSystemCall("inf.pl", 5, 3);

The advantage of this solution is that the standard IO handles (STDOUT, STDERR, STDIN) are directly connected to the child. The parent does not have to poll the child with non-blocking reads, and dump that output to the parent’s IO. So, this solution is somewhat simpler. Plus, it does not consume excess CPU while in the tight polling loop.

The other interesting thing about this solution is that the standard IO handles must be duplicated, or saved before they are fed to the child process. Otherwise, when the child process is killed, the standard IO handles will be automatically closed. Any restarted children will not be able to duplicate them, so the open3 command fails. But, what is worse, the parent cannot communicate to the outside world to communicate the cause of the error. This brings sudden and silent death to the parent. However, if the standard IO handles are first saved, then they can be restored after the child is killed, hence the duplicate (“DUP”) IO handles. The above solution is a good example of this technique.

The hint for this technique came from pg. 193, of O’Reilly’s, Programming Perl, under the open function explanation. Another hint came from the middle of pg. 568 of O’Reilly’s, Perl Cookbook, under discussion on “16.8. Controlling Input and Output of Another Program“.

Further Thoughts

Here are a few links for further reading on the topic of busting out of a long Perl operation:

http://www.mail-archive.com/beginners@perl.org/msg81677.html
http://coding.derkeiler.com/Archive/Perl/comp.lang.perl.misc/2003-10/0422.html

Could there be a better way? Could you improve on my final solution? I am both an optomist and an optomizerist (sic), so if you can improve my solution, let me know! 🙂

Share
Oct 212008
 

Just a little ditty … Let’s say you wanted a process to block infinitely, without using much CPU, and producing continous, non-buffered output?  Try this:

inf.pl:

#!/usr/bin/perl
my $timeout = $ARGV[0];
if ((defined $timeout) && ($timeout > 0)) {
  $timeout = time() + $timeout;
} else {
  $timeout = 0;
}
my $k = 0;
$SIG{INT} = \&caught_int;
sub caught_int {
	$SIG{INT} = 'DEFAULT';
	print "\nCaptured SIGINT.  Exiting after $k seconds.\n";
	#die;
	exit;
}
$| = 1;
while (!$timeout || (time() < $timeout)) {
	$k++;
	print "$k\n";
	sleep 1;
}

Running this program with default yields an infinite stream of numbers with output every second, until you press Control-C, like so:

$ inf.pl
1
2
3
4
5
6
7
8
9
10
11
^C
Captured SIGINT.  Exiting after 11 seconds.

If a numerical argument is provided, then output is generated for that number of seconds, and then the program exits, like so:

$ inf.pl 3
1
2
3

It’s a simple Perl script that demonstrates simple command-line argument parsing, catching Control-C (interrupts), watching the clock, and producing steady output with minimal CPU usage. … Plus, it comes in handy while testing other, more complex Perl scripts.

Share
Oct 212008
 

Introduction

“Perl” can mean different things to different people, but based on this unique spelling, it can only mean one thing:

Practical Extraction and Report Language

It is Larry Wall’s scripting language, primarily developed for UNIX based operating systems.  However, ActiveState maintains a Windows port, which I use on a regular basis:

http://www.activestate.com/Products/activeperl/index.mhtml

Perl was originally designed to be a superset, an amalgamation of Larry’s favorite scripting languages.  Consequently, it is an extremely rich language, because it borrows from so many.  It is also designed to enable compact code.  Consequently, it can be difficult to master and read (reverse-engineer).  However, for the patient and determined, Perl provides a treasure trove of programming power.

Common Usages

Perl is primarily used for complex text processing.  Although awk has been the traditional, simple text processor, Perl can compete well with awk.  The primary deciding factor is, as always, your personal knowledge and proficiency in each language.

Perl is also used as a programming language for many dynamic web sites.  It has been a favorite language for CGI scripts used in form processing and producing dynamic web-content.  Recently, PHP has been overtaking Perl’s popularity on this scene, and even more recently, Ruby has been overtaking both, especially when considered with the “Ruby on Rails” extension.  However, it seems like a new language appears on this front almost every day.

Although it cannot match the flexibility or speed of C or C++, Perl can be used as a complete language for very complex projects.  It provides object-oriented support.  And, it has a large developer community, providing hundreds of varied and tested third-party modules.  Exploring and utilizing these modules are key to unlocking the latent potential of Perl.  Many modules are stored and documented on CPAN:

http://www.cpan.org

For example, these modules allow you to edit MP3 tags, parse or write XML files, generate PNG image files, etc.  They handle many of the low-level details, which would require a large amount of time to reproduce.  Why reinvent the wheel, especially if you can download a free set with racing stripes and turbo pre-installed?

Why Perl?

Is Perl perfect?  No way!  But, it offers a tremendous amount of immediate power on multiple platforms (UNIX, Linux, Windows, etc.).  It is much easier to develop simple programs in Perl than C, C++, JAVA, or other more “powerful” languages.  Admittedly, Perl has its quirks.  But, unless you are a C.S. or C.S.E. student with copious amounts of free time and interest, it is difficult to keep up with the latest scripting language craze, which may or may not be more powerful than the language you already know.  At some point, mastery in one language becomes more powerful than mere acquaintance with several.  So, here in the real world, I have thrown my lot in with Perl, although I hope to someday learn more about Python or PHP, while I use C for “real” work.

One of Perl’s idiosynchrocies is that it tries to help you by doing several things automatically for you “behind the scenes”.  Given this fact, its diverse blending of languages, and its compact notation, Perl has an inevitable steep learning curve and a rapid “decay rate”.  You have to use Perl regularly and routinely to learn, master, and maintain a working knowledge of Perl.  Unfortunately, I don’t use Perl that regularly in my day job, so one of the categories on this web-site will contain my notes on tips and tricks in Perl.  Hopefully, my own knowledge of Perl won’t atrophy so rapidly, and I will be able to find details on accomplishing infrequent, but necessary tasks without having to search through mountains of old scripts and code.  Who knows?  Maybe you will find something helpful here too!

Share
Sep 202008
 

Welcome to my IT Blog!

Here, I dump and hope to organize all the various sticky notes that keep my IT world online.  Hopefully, you will find it helpful too!

Share
 Posted by at 12:26 PM