view release on metacpan or  search on metacpan

lib/File/Unpack2.pm  view on Meta::CPAN

        # PR_SET_PDEATHSIG(SIGKILL) makes the kernel kill this helper the instant its parent worker
        # dies, so a stuck helper (e.g. a malicious cyclic-hardlink tar spinning on stat()/linkat())
        # is not orphaned to ppid==1 to spin forever when the worker is force-stopped mid-unpack
        # (Minion "stop job", a hard restart, a crash) - the case the stall watchdog can't cover
        # because it dies with the worker. PR_SET_PDEATHSIG is 1 on every Linux arch. Where the
        # syscall number was unresolved this is skipped; then that narrow orphan window remains and
        # such orphans must be cleaned up out of band (or the worker stopped via systemd
        # KillMode=control-group, which reaps the whole cgroup).
        eval { syscall($SYS_PRCTL, 1, POSIX::SIGKILL()) if $SYS_PRCTL; 1 };
        # ... and put each helper in its own process group so _kill_family can reap the whole family
        # (grandchildren included) while we are alive.
        setpgrp(0, 0);    # builtin; POSIX::setpgrp is unimplemented on modern perl
      };
    }

  my $has_i_redir = 0;
  my $has_o_redir = 0;
  my $has_e_redir = 0;

  ## The ugly truth is, there might be multiple commands with pipes.
  ## We need to provide all of them with the proper redirects.

t/10-stall-timeout.t  view on Meta::CPAN

  # progress) every 0.3s for ~3s, then writes a marker file at the very end. With stall_timeout=2,
  # if pipe output did not count as progress it would be killed at ~2s and the marker never written.
  my ($u, $src, $dest) = stall_setup(
    [$^X, '-e', 'for (1..10) { print STDERR "x"; select undef,undef,undef,0.3 } open my $f, ">", "pipe.done" or die; print $f "ok"; close $f']);
  plan skip_all => 'could not build fixture' unless $u;

  my $done = guarded(30, sub { $u->unpack($src) });
  ok($done, 'unpack() returned');
  my $marker;
  find(sub { $marker = $File::Find::name if $_ eq 'pipe.done' }, $dest);
  ok($marker, 'a pipe-only helper ran to completion - pipe output kept it alive, not falsely killed');
};

subtest 'a reparented grandchild holding the pipe is reaped via its process group' => sub {
  # The direct child backgrounds a grandchild (which inherits the stdout pipe and the helper's
  # process group) and then exits, so the grandchild reparents to init - invisible to the ppid walk.
  # Only killing the captured process group reaps it; otherwise finish() blocks on the still-open
  # pipe forever (caught by the alarm as a failure).
  my ($u, $src) = stall_setup(['/bin/sh', '-c', 'sleep 999 & exit 0']);
  plan skip_all => 'could not build fixture' unless $u;

t/10-stall-timeout.t  view on Meta::CPAN

      chomp($hpid = <$f>);
      close $f;
      last if $hpid;
    }
    select undef, undef, undef, 0.1;
  }
  unless ($hpid && kill 0, $hpid) {
    kill 'KILL', $worker; waitpid $worker, 0;
    plan skip_all => 'helper did not start (fixture/timing)';
  }
  ok(1, 'helper started and is alive while the worker runs');

  # "stop job" kills the WORKER (not its process group). The helper is in its own group, so this
  # signal does not reach it - PR_SET_PDEATHSIG is what must take it down.
  kill 'KILL', $worker;
  waitpid $worker, 0;

  my $alive = 1;
  for (1 .. 100) { $alive = kill 0, $hpid; last unless $alive; select undef, undef, undef, 0.1 }
  ok(!$alive, 'helper was SIGKILLed when its parent worker died - not orphaned to spin forever');
  kill 'KILL', $hpid if $alive;    # cleanup only if the safeguard regressed
};

done_testing;