fork()

use POSIX qw(:signal_h setsid WNOHANG);


$SIG{TERM} = $SIG{INT} = \&do_term; # signal handler installieren, damit die child procs gekillt werden bei diesen signalen


my %CHILDREN;


sub launch_child {
  my $callback = shift;
  my $home     = shift;
  my $signals = POSIX::SigSet->new(SIGINT,SIGCHLD,SIGTERM,SIGHUP);
  sigprocmask(SIG_BLOCK,$signals);  # block inconvenient signals
  warn("Can't fork: $!") unless defined (my $child = fork());
  if ($child) {
    $CHILDREN{$child} = $callback || 1;
  } else {
    $SIG{HUP} = $SIG{INT} = $SIG{CHLD} = $SIG{TERM} = 'DEFAULT';
    prepare_child($home);
  }
  sigprocmask(SIG_UNBLOCK,$signals);  # unblock signals
  return $child;
}


sub prepare_child {
  my $home = shift;
  if ($home) {
    local($>,$<) = ($<,$>);   # become root again (briefly)
    chdir  $home || croak "chdir(): $!";
    chroot $home || croak "chroot(): $!";
  }
  $< = $>;  # set real UID to effective UID
}


sub reap_child {
  while ( (my $child = waitpid(-1,WNOHANG)) > 0) {
    $CHILDREN{$child}->($child) if ref $CHILDREN{$child} eq 'CODE';
    delete $CHILDREN{$child};
  }
}


sub kill_children {
  kill TERM => keys %CHILDREN;
  # wait until all the children die
  sleep while %CHILDREN;
}


sub do_term {
  warn("TERM signal received, terminating children...\n");
  kill_children();
  exit 0;
}