view release on metacpan or  search on metacpan

t/163-foundation-sigterm-cleanup.t  view on Meta::CPAN

use strict;
use warnings;

# Ticket #163. Foundation installed no SIGTERM handler. Stop it
# mid-drain -- systemd TimeoutStopSec, a deploy, an operator's kill --
# and the agent survived, reparented to init, while .karr.lock named the
# foundation's now-dead pid and the next tick started a second agent.
#
# The fix has two halves:
#   - Foundation::run installs SIGTERM/INT/HUP handlers that kill the
#     live agent's process group and force-release the lock.
#   - the lock now records the work (an open fd, plus pid/pgid as
#     evidence), so the handler can find and clean it up.
#
# This test exercises the handler end-to-end. We fork a driver child
# that imports Foundation, installs the SIGTERM handler, drives an
# agent through _run_command (so the agent is in its own process
# group, the same shape production leaves), then sends SIGTERM to
# itself. We then check from the parent:
#   1. the agent is gone (it would have been reparented to init without
#      the handler, and would still be running);
#   2. .karr.lock is gone (the handler force-released it);
#   3. a fresh foundation instance reports the lock free.

use Test::More;
use POSIX qw( WNOHANG SIGTERM );
use File::Temp qw( tempdir );
use Path::Tiny qw( path );

sub reap_or_kill {
    my ($pid) = @_;
    # waitpid(2) with WNOHANG: if the child has exited, $w is the pid
    # (or 0 if still alive, -1 on error). A handler that called
    # POSIX::_exit has already produced a status for us; we just want
    # to collect it without the WNOHANG-vs-blocking race that would
    # otherwise be the test's own failure mode.
    my $w = waitpid( $pid, WNOHANG );
    return 1 if $w > 0 || $w < 0;
    kill 'KILL', $pid;
    waitpid( $pid, 0 );
    return 1;
}

sub cmdline_of {
    my ($pid) = @_;
    my $cmdline = path("/proc/$pid/cmdline")->slurp_utf8 // return '';
    $cmdline =~ s/\0/ /g;
    return $cmdline;
}

# A script the driver child runs. We write it to a tempdir and exec it
# so that the test process itself is not exposed to the SIGTERM -- the
# handler runs in the driver only, and the test process just observes.
sub write_driver_script {
    my ( $dir, $repo_str ) = @_;
    my $lib = path('lib')->absolute->stringify;
    my $script = path($dir)->child('driver.pl');
    $script->spew_utf8(<<PERL);
use strict;
use warnings;
use lib '$lib';
use App::karr::Foundation;
use Path::Tiny qw( path );
my \$repo = path("$repo_str");
my \$f    = App::karr::Foundation->new( _config_data => {} );