Tuesday, February 17, 2015

Writing signal-aware waitpid in Perl

As I have talked in YAPC::Asia couple of years ago, the wait functions (e.g. wait, waitpid) of Perl do not return EINTR when receiving a signal.

This is a problem if you would want to wait for child processes until receiving a signal. Proc::Wait3 can be a solution, however the module may be hard to install as it is an XS module. It should also be noted that the module provides replacement for wait only; no workaround exists for waitpid.

So today I have scrubbed my head wondering if I could come up with a pure-perl solution, and, here it is. The Perl script below launches a worker process (that just sleeps), and waits for the process to complete, or until SIGTERM is being received.

use strict;
use warnings;
use Errno ();

our $got_sigterm = 0;
our $sighandler_should_die = 0;

# fork a child process that does the task
my $child_pid = fork;
die "fork failed:$!"
    unless defined $child_pid;
if ($child_pid == 0) {
    # in child process, do something...
    sleep 100;
    exit 0;
}

$SIG{TERM} = sub {
    $got_sigterm = 1;
    die "dying to exit from waitpid"
        if $sighandler_should_die;
};

warn "master process:$$, child process:$child_pid";

# parent process, wait for child exit or SIGTERM
while (! $got_sigterm) {
    if (my_waitpid($child_pid, 0) == $child_pid) {
        # exit the loop if child died
        warn "child process exitted";
        $child_pid = -1;
        last;
    }
}

if ($child_pid != -1) {
    warn "got SIGTERM, stopping the child";
    kill 'TERM', $child_pid;
    while (waitpid($child_pid, 0) != $child_pid) {
    }
}

sub my_waitpid {
    my @args = @_;
    local $@;
    my $ret = eval {
        local $sighandler_should_die = 1;
        die "exit from eval"
            if $got_sigterm;
        waitpid($args[0], $args[1]);
    };
    if ($@) {
        $ret = -1;
        $! = Errno::EINTR;
    }
    return $ret;
} 

The trick is that waitpid is surrounded by a eval within the my_waitpid function, and the signal handler calls die to exit the eval if the $sighandler_should_die flag is being set. It is also essential to check the $got_sigterm flag within the eval block after setting the $sighandler_should_die flag, since otherwise there would be a race condition.

By using these tricks it has now become possible to implement process managers in pure-perl!

10 comments:

  1. دار السلام اهم شركة نقل عفش بالطائف وكذلك اهم شركة نقل عفش بمكة وجدة والمدينة المنورة تقوم الشركة بنقل العفش بحفر الباطن وتبوك وجازان وتقوم بنقل الاثاث بالقصيم
    شركة نقل عفش بالطائف
    شركة نقل عفش بالمدينة المنورة
    شركة نقل عفش بجازان وابها

    ReplyDelete

  2. افضل شركة نقل عفش بجدة شركة الاطلال شركة نقل اثاث بجدة شركة متخصصة فى نقل اثاث بجدة على اعلى مستوى من نقل العفش بجدة
    شركة نقل عفش بجدة

    ReplyDelete

  3. شركة نقل عفش
    اهم شركات مكافحة حشرات بالخبر كذلك معرض اهم شركة مكافحة حشرات بالدمام والخبر والجبيل والخبر والاحساء والقطيف كذلك شركة رش حشرات بالدمام ومكافحة الحشرات بالخبر
    شركة مكافحة حشرات بالدمام
    شركة تنظيف خزانات بجدة الجوهرة من افضل شركات تنظيف الخزانات بجدة حيث ان تنظيف خزانات بجدة يحتاج الى مهارة فى كيفية غسيل وتنظيف الخزانات الكبيرة والصغيرة بجدة على ايدى متخصصين فى تنظيف الخزانات بجدة
    شركة تنظيف خزانات بجدة
    شركة كشف تسربات المياه بالدمام
    شركة نقل عفش واثاث

    ReplyDelete