view release on metacpan or  search on metacpan

t/148-foundation-runner-child-leak.t  view on Meta::CPAN

    return unless defined $pid;
    return if waitpid( $pid, WNOHANG ) != 0;
    kill 'KILL', $pid;
    waitpid( $pid, 0 );
}

subtest 'an unopenable log is refused before anything is forked' => sub {
    my $foundation = FakeFoundation->new;    # held: the Runner keeps it weakly
    my $runner = App::karr::Foundation::Runner->new( foundation => $foundation );

    my $repo = tempdir( CLEANUP => 1 );
    # A directory where the log belongs: open '>>' fails with EISDIR whatever
    # the caller's privileges are, so this holds for root too.
    $repo->child('.karr.log')->mkpath;

    local $LAST_CHILD_PID;
    eval { $runner->_run_command( $repo, { command => 'true', max_runtime => 5 } ) };
    my $err = $@;

    like $err, qr/^open log /, 'the run is refused, naming the log';
    is $LAST_CHILD_PID, undef, 'and nothing was forked: no agent was started'
        or diag "a child was forked before the log open failed: $LAST_CHILD_PID";
    is waitpid( -1, WNOHANG ), -1, 'no child of this process is left over'
        or diag 'the refused run left a child behind';

    cleanup_child($LAST_CHILD_PID);
};

subtest 'a log lost mid-run does not cost the agent its SIGTERM and its reap' => sub {
    # The reachable half: the log is writable when the run starts, so the
    # foundation's START line lands and the agent is forked -- and then the
    # agent itself replaces .karr.log with a directory and hangs past
    # max_runtime. The TIMEOUT append then fails, in the window between the tee
    # loop and the waitpid. `exec` in the command matters: without it /bin/sh
    # keeps the sleep as a grandchild that survives the kill, and this test
    # would litter the box.
    my $f    = App::karr::Foundation->new( _config_data => {} );
    my $repo = tempdir( CLEANUP => 1 );
    my $cmd  = 'rm -f .karr.log; mkdir .karr.log; exec sleep 30';

    local $LAST_CHILD_PID;
    my @warnings;
    my $ok = do {
        local $SIG{__WARN__} = sub { push @warnings, $_[0] };
        eval { $f->_run_command( $repo, { max_runtime => 1 }, $cmd ); 1 };
    };
    my $err = $@;

    ok !$ok, 'the broken log still fails the run for this board'
        or diag 'the run reported success over an unwritable log';
    like $err, qr/\.karr\.log/, 'and the error names the log';

    ok defined $LAST_CHILD_PID, 'the agent really was forked'
        or diag 'nothing forked -- this subtest is not exercising the window';

    SKIP: {
        skip 'nothing was forked', 3 unless defined $LAST_CHILD_PID;

        is waitpid( $LAST_CHILD_PID, WNOHANG ), -1,
            'the library reaped the agent: it is no longer a child of this process'
            or diag "pid $LAST_CHILD_PID is still ours -- alive, or a zombie";
        is kill( 0, $LAST_CHILD_PID ), 0, 'and it is not running any more'
            or diag "pid $LAST_CHILD_PID survived the run";
        ok scalar( grep { /cannot write .*\.karr\.log/ } @warnings ),
            'the TIMEOUT line it could not write is reported, not swallowed'
            or diag "warnings were:\n@warnings";
    }

    cleanup_child($LAST_CHILD_PID);
    is waitpid( -1, WNOHANG ), -1, 'no child of this process is left over'
        or diag 'the timed-out run left a child behind';
};

done_testing;