view release on metacpan or  search on metacpan

t/148-foundation-runner-group-kill.t  view on Meta::CPAN

    # init and lived for 30s after the runner returned.
    #
    # The duration carries a marker unique to this test process ($$) so
    # the post-mortem scan below can identify *our* sleep by exact argv
    # instead of pattern-matching every process on the box. A bare
    # "sleep 30" substring match also catches unrelated survivors like
    # "sleep 300" from a concurrent session (#179), and would cross-match
    # between two copies of this very test running at once on a shared
    # machine -- the marker rules both out. The fractional suffix is a
    # no-op for `sleep` (it just sleeps 30-point-something seconds
    # instead of exactly 30), so the timeout/kill behaviour under test is
    # unaffected.
    my $marker = "30.$$";
    my $cmd = "sleep $marker & exec sleep $marker";

    # We need the agent's PID to look at its /proc/<pid>/stat before
    # exec. Reading /proc/<pid>/stat AFTER exec still gives us the same
    # pid's stat -- /proc is the process, not the executable. But the
    # group identity is set right after fork by the runner, so we have
    # to verify it once the run starts, before the timeout fires.
    my $agent_pid_seen;
    my $watcher = sub {
        # Quick scan of /proc for the most recent sleep 30 we did not
        # start. The runner's group is identifiable because the test
        # process is the only other thing in the box doing sleep 30 in
        # a tempdir, and any such process we see is the agent or its
        # backgrounded child.
        opendir my $d, '/proc' or return;
        while ( my $entry = readdir($d) ) {
            next unless $entry =~ /^\d+$/;
            my $cmdline = safe_slurp("/proc/$entry/cmdline") // next;
            $cmdline =~ s/\0/ /g;
            if ( $cmdline =~ /sleep 30/ ) {
                $agent_pid_seen //= $entry;
            }
        }
        closedir $d;
    };

    # Spin a watcher for up to 6s while the runner is in max_runtime.
    my $watcher_pid = fork // die "fork watcher: $!";
    if ( $watcher_pid == 0 ) {
        # child watcher: poll /proc every 100ms for 6s, then exit.
        for my $i ( 1 .. 60 ) {
            $watcher->();
            select undef, undef, undef, 0.1;
        }
        exit 0;
    }

    my $f = App::karr::Foundation->new( _config_data => {} );
    my $start = time;
    my ( $code, $out ) = $f->_run_command(
        $repo, { max_runtime => 1 }, $cmd,
    );
    my $elapsed = time - $start;

    reap_wait($watcher_pid);

    # The runner should report SIGTERM death and have killed the agent
    # promptly -- not waited 30s for the foreground sleep to finish.
    is $code, 143, 'timed-out run reports 128+SIGTERM';
    ok $elapsed < 10, "killed promptly (took ${elapsed}s)"
        or diag "the runner waited the full sleep -- group kill is broken";

    # The bug-shaped check: nothing under /tmp/* should still be running
    # a `sleep 30`. The watcher polled /proc while the run was live and
    # afterwards; if any of those sleeps survived the runner, it is
    # either our reaped watcher (impossible -- it does not run sleep 30)
    # or an orphan that the group kill missed.
    my @still_running;
    opendir my $d, '/proc' or die "opendir /proc: $!";
    while ( my $entry = readdir($d) ) {
        next unless $entry =~ /^\d+$/;
        next if $entry == $$;                  # the test itself
        my $cmdline = safe_slurp("/proc/$entry/cmdline") // next;
        $cmdline =~ s/\0/ /g;
        $cmdline =~ s/\s+$//;                  # trailing NUL -> trailing space
        # The watcher has exited; filter its defunct shell (a `sh -c`
        # looping select) by parent. /proc/<pid>/status has PPid.
        my $status = safe_slurp("/proc/$entry/status") // next;
        my ($ppid) = $status =~ /^PPid:\s*(\d+)/m;
        next if defined $ppid && $ppid == $test_pid;
        # Exact argv match on our own marked duration, not a substring:
        # "sleep 30" would also catch an unrelated "sleep 300" elsewhere
        # on the box, or the sibling sleep of another copy of this test.
        if ( $cmdline eq "sleep $marker" ) {
            push @still_running, [ $entry, $cmdline, $ppid ];
        }
    }
    closedir $d;

    ok !@still_running, "no orphan sleep $marker left on the box"
        or diag "survivors: @{[ map { join('/',@$_) } @still_running ]}";
};

# Group identity: the agent's pgid must equal its own pid, because the
# runner relies on `kill 'TERM', -$pgid` to signal the whole group. We
# spawn the runner, peek at /proc/<pid>/stat while it is alive, and
# confirm pgid == pid.
subtest 'runner puts the agent in a process group whose pgid is its own pid' => sub {
    my $repo = path( tempdir( CLEANUP => 1 ) );
    my $cmd  = 'sleep 5';

    # Fork a child that drives the runner; the parent watches /proc.
    my $driver_pid = fork // die "fork driver: $!";
    if ( $driver_pid == 0 ) {
        # child driver
        my $f = App::karr::Foundation->new( _config_data => {} );
        $f->_run_command( $repo, { max_runtime => 8 }, $cmd );
        exit 0;
    }

    # Poll for the agent up to 5s.
    my $agent_pid;
    my $end = time + 5;
    while ( time < $end && !$agent_pid ) {
        opendir my $d, '/proc' or die;
        while ( my $entry = readdir($d) ) {
            next unless $entry =~ /^\d+$/;
            next if $entry == $$ || $entry == $driver_pid;
            my $cmdline = safe_slurp("/proc/$entry/cmdline") // next;
            $cmdline =~ s/\0/ /g;