App-karr
view release on metacpan or search on metacpan
was bumped, an activity-log entry was appended, the command printed
success, and `--block 0` left the card unblocked (the sharp edge:
`karr pick` would have handed it out). The fix is the rule already
written down for `--body` in ticket #78 (`defined && length`)
applied to the siblings; `--last < 1` raises a usage error matching
`Show.pm:161-162` and `Context.pm:97-99` exactly (same exit 2,
same error format); `karr archive ,` raises the same usage error
as `move ,` / `edit ,` / `delete ,` already do. The audit trail no
longer records edits that did not happen.
- `karr-foundation` now keeps an agent it started alive in three
situations where it used to silently lose it: a pipeline/`&`/shell-
builtin command where the real agent was the shell's child, not the
shell (#148); an agent that closed its stdout before max_runtime
elapsed, where the runner fell through to a bare blocking waitpid
that held `.karr.lock` forever (#161); and a SIGTERM/INT/HUP to
foundation mid-drain, where the agent was reparented to init and
`.karr.lock` named a dead pid the next tick read as free (#163).
The runner wraps every agent in its own process group with
`setpgid(0,0)` in the child and `setpgid($pid,$pid)` in the parent
(the second call wins the fork race idempotently); the timeout,
lib/App/karr/Foundation/Runner.pm view on Meta::CPAN
select undef, undef, undef, 0.05;
}
kill 'KILL', -$pid;
waitpid( $pid, 0 );
warn "karr-foundation: cannot write $log_file: $log_err\n" if $log_err;
# 128 + SIGTERM(15) = 143 — same convention as shells, distinct from a
# clean non-zero exit, and surfaces in cooldown/last_error so an agent
# that exceeded max_runtime triggers the backoff (#164 / #161).
$exit_code = 128 + SIGTERM;
} else {
# The child may still be alive after the loop ended on EOF — a command
# whose stdout is closed while it keeps running (the classic
# `exec >/dev/null 2>&1; sleep N`, #161). Reap it with a wait loop that
# checks the wall-clock deadline: if the loop ended on EOF before
# max_runtime expired, this blocks until the child exits on its own or
# until the deadline arrives and we kill it via the timed_out path. The
# loop uses WNOHANG to keep checking; the deadline path is identical to
# the SIGALRM path above.
my $deadline;
if ( $max_runtime > 0 ) {
$deadline = $started + $max_runtime;
lib/App/karr/Foundation/State.pm view on Meta::CPAN
# reaped by init) used to leave a .karr.lock naming a pid nobody could ever
# own again, while the lock file was the only thing keeping the next tick from
# starting a second agent (#162, #163). The gate is now flock(2): the
# foundation that holds the exclusive lock on the file holds the board, and
# the recorded pid/pgid are evidence (for `karr-foundation --status` and the
# SIGTERM handler) rather than authority.
#
# File contents are JSON: { pid, pgid, agent_pid, started }. flock on an open
# fd is the source of truth: the Foundation instance keeps an open fd for the
# lifetime of the lock and only closes it on release. A stale .karr.lock — one
# nobody flocks — is not held even if the recorded pid is alive in some other
# context, and a process whose recorded pid matches $$ but which never flock'd
# the file has no claim.
#
# Two ticks that overlap, the normal case while a max_runtime-sized drain is
# still running and cron fires again, now race on flock: exactly one wins,
# exactly one is told to skip (#162). The "tight while-loop" the POD used to
# recommend no longer relies on the lock file as a polite signal — under the
# new semantics two consecutive tight loops cannot both pass _lock_held,
# because the second one will lose the flock race. That is intentional and
# desired.
lib/App/karr/Lock.pm view on Meta::CPAN
A lock past its TTL may be taken over. The takeover is itself a compare-and-swap
against the OID whose age was judged, so a holder that refreshes its lock in
between wins and is never silently evicted. The TTL is deliberately B<not>
C<claim_timeout>: see L<App::karr::Cmd::Pick>.
=head2 Locks are local, and live outside the board
Lock refs live under C<refs/karr-local/>, which nothing pushes, fetches, prunes
or snapshots. A lock says "this process, in this clone, is mid-pick right now",
and that sentence has no meaning anywhere else: a clone that receives one cannot
tell whether the holder is still alive, and has no way to find out.
They used to live at C<refs/karr/tasks/N/lock>, inside the namespace C<karr>
pushes. Any sync that fired while a lock was held published it, other clones
pulled it, and it then blocked their picks until somebody ran C<karr unlock> --
a lock that outlived the process holding it and the machine it ran on (#93). It
also turned every board backup into a snapshot of somebody's momentary lock.
Moving the refs out is what makes that impossible, rather than making it depend
on the timing of when a lock happens to be released.
Locks left in the old place by a C<karr> older than this one -- or pulled from a
lib/App/karr/Role/SyncLifecycle.pm view on Meta::CPAN
This role provides C<sync_before> and C<sync_after> methods that wrap Git pull
and push operations with retry logic. C<sync_before> creates a
L<App::karr::SyncGuard> and retains it on the object as insurance: if the
command body dies or croaks before C<sync_after> runs, the guard's DESTROY
pushes with 3 retries. Because the guard is held by the role (not by the
caller), commands may call both methods in void context; C<sync_after>
neutralises the guard so it never pushes twice.
Holding the guard on the command object is also why the CLI cannot rely on
DESTROY alone: L<MooX::Cmd>'s command chain keeps that object alive past
F<bin/karr>'s error handler, so on the die path the guard is only reaped in
global destruction, where pushing is forbidden. F<bin/karr> therefore drains
L<App::karr::SyncGuard/flush_armed> from an C<END> block.
Commands that compose this role must also have a C<store> attribute (provided
by L<App::karr::Role::BoardDiscovery>) with a C<git> accessor.
=head1 METHODS
=head2 sync_before
lib/App/karr/SyncGuard.pm view on Meta::CPAN
package App::karr::SyncGuard;
our $VERSION = '0.500';
use Moo;
use strict;
use warnings;
use Scalar::Util qw( refaddr weaken );
use App::karr::Git;
# Process-wide registry of armed guards, keyed by refaddr with weakened values
# so a guard that is released normally is not kept alive here. done() and
# DESTROY deregister, flush_armed() drains. In practice a karr process holds at
# most one guard; this is a registry rather than a single slot only because
# nothing guarantees that, and a stale single slot would push the wrong guard.
our %ARMED;
sub BUILD {
my ($self) = @_;
my $key = refaddr $self;
$ARMED{$key} = $self;
weaken $ARMED{$key};
t/122-foundation-runner-errors.t view on Meta::CPAN
#
# "The kernel refused you a process" is an operator's problem, not a bug report,
# so the errno has to survive and the call site has to go.
#
# The pipe case is the one not exercised here: making pipe(2) fail means
# exhausting the descriptor table, and the soft limit on a normal box is a
# million. It shares its single line of code shape with the two below.
{
# Stands in for App::karr::Foundation. The Runner holds it weakly, so the
# caller has to keep it alive -- $foundation below is not a spare variable.
package FakeFoundation;
sub new { bless {}, shift }
sub _stream_to_terminal { 0 }
sub _prompt_for { '' }
sub _append_log { }
sub _say_verbose { }
sub dry_run { 0 }
}
my $foundation = FakeFoundation->new;
t/148-foundation-runner-child-leak.t view on Meta::CPAN
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';
t/148-foundation-runner-group-kill.t view on Meta::CPAN
}
}
closedir $d;
ok !@still_running, 'no orphan sleep 30 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 => {} );
t/162-foundation-lock-race.t view on Meta::CPAN
# close A's fd, must not unlink the file, must not affect A's lock.
$f2->_release_lock( $dir );
ok $f1->_lock_held( $dir ), 'A still holds the lock';
ok -e $dir->child('.karr.lock'), 'lock file still present';
$f1->_release_lock( $dir );
};
# _lock_held must report false on a .karr.lock nobody is flocking -- even
# if its recorded pid is alive in some other context. The fix decoupled
# held-ness from the recorded pid text.
subtest '_lock_held is false on an un-flocked .karr.lock, regardless of pid text' => sub {
my $dir = path( tempdir( CLEANUP => 1 ) );
$dir->child('.karr.lock')->spew_utf8( "999999\n" );
my $f = App::karr::Foundation->new( _config_data => {} );
ok !$f->_lock_held( $dir ),
'a stale .karr.lock nobody is flocking is not held -- a fresh tick can take over'
or diag 'lock is reported held by a stale pid -- this is the bug #162 invariant';
t/163-foundation-sigterm-cleanup.t view on Meta::CPAN
# 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;
}
t/163-foundation-sigterm-cleanup.t view on Meta::CPAN
last;
}
}
closedir $d;
select undef, undef, undef, 0.05 unless $agent_pid;
}
ok $agent_pid, 'found the agent process running under the driver'
or BAIL_OUT 'driver did not fork the agent -- cannot exercise handler';
ok kill( 0, $agent_pid ), 'agent is alive before SIGTERM';
# SIGTERM the driver -- the handler should run, kill the agent's
# group, force-release the lock, and exit 143.
kill 'TERM', $driver_pid;
# Wait for the driver to actually exit (handler runs synchronously
# in the signal delivery, then POSIX::_exit). Give it a moment.
my $w = 0;
$deadline = time + 5;
while ( time < $deadline ) {
t/163-foundation-sigterm-cleanup.t view on Meta::CPAN
waitpid( $driver_pid, 0 );
}
my $driver_status = $? >> 8;
is $driver_status, 143,
'driver exited 128+SIGTERM (the conventional signal-death code)'
or diag "driver exited with status $driver_status -- handler did not run";
# Give the kernel a moment to actually reap the agent.
my $end = time + 3;
my $still_alive = 0;
while ( time < $end ) {
$still_alive = kill( 0, $agent_pid ) ? 1 : 0;
last unless $still_alive;
select undef, undef, undef, 0.05;
}
ok !$still_alive, 'the agent was killed by the SIGTERM handler'
or diag "agent $agent_pid survived SIGTERM to the foundation";
# And .karr.lock is gone -- the handler called _force_release_lock.
ok !$repo->child('.karr.lock')->exists,
'.karr.lock is unlinked by the handler, not left for the next tick'
or diag '.karr.lock was left behind -- the next tick would skip the board';
# A fresh foundation instance reports the board free.
require App::karr::Foundation;
my $f_fresh = App::karr::Foundation->new( _config_data => {} );
t/164-foundation-signal-exit.t view on Meta::CPAN
die "fork: $!" unless defined $dpid;
if ( $dpid == 0 ) {
exec( $^X, "$driver" ) or die;
}
my $agent_pid = wait_for_pid_file( $pid_file, 5 );
ok $agent_pid, 'agent was forked (pid file populated)'
or BAIL_OUT 'no agent pid recorded -- the runner did not fork';
select undef, undef, undef, 0.1;
ok kill( 0, $agent_pid ), 'agent is alive in /proc before the kill';
# External SIGKILL -- the OOM-killer shape.
kill 'KILL', $agent_pid;
reap_wait($dpid);
my $log = -e $repo->child('.karr.log') ? $repo->child('.karr.log')->slurp_utf8 : '';
like $log, qr/END elapsed=\d+s exit=(\d+)/, 'log has END line'
or diag "log was: $log";
t/30-foundation.t view on Meta::CPAN
}
sub write_karr_file {
my ( $dir, %opts ) = @_;
my $content = "command: " . ( $opts{command} // 'echo hello' ) . "\n";
$content .= "on_idle: " . ( $opts{on_idle} // 'skip' ) . "\n";
$content .= "max_runtime: " . ( $opts{max_runtime} // 1800 ) . "\n";
$dir->child('.karr')->spew_utf8( $content );
}
# Returns ($cfg_dir, $cfg_file) — caller must keep $cfg_dir alive to avoid cleanup
sub write_config {
my ( $dirs ) = @_;
my $cfg_dir = tempdir( CLEANUP => 1 );
my $cfg_file = $cfg_dir->child('config.yml');
$cfg_file->spew_utf8( "dirs:\n" . join( '', map { " - $_\n" } @$dirs ) );
return ( $cfg_dir, $cfg_file );
}
# karr-init a repo the way `karr init` does: write refs/karr/config, no .karr
# file. Detection must therefore rely on the ref, not a sidecar file.
t/52-syncguard-lifetime.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use App::karr::Role::SyncLifecycle;
# Regression for ticket #28:
# Every command calls $self->sync_before; in VOID context. sync_before built
# a SyncGuard and returned it, but nobody kept the returned guard alive, so it
# was DESTROYed the instant sync_before returned -- firing a redundant push
# BEFORE the command body ran (the doubled "Push attempt 1 of 3..." seen on
# every karr move/handoff). The documented "insurance on die before
# sync_after" therefore never engaged: by the time the body died, the guard
# was long gone.
#
# The fix keeps the guard alive for the duration of the command by stashing it
# on the SyncLifecycle role; sync_after neutralises it after a successful push.
# A counting Git double: records the exact order of pull/push calls so we can
# assert *when* the guard fires relative to the command body.
{
package CountingGit;
sub new { bless { log => [], pushes => 0, pulls => 0 }, shift }
sub pull { my ($self) = @_; $self->{pulls}++; CORE::push @{ $self->{log} }, 'pull'; 1 }
sub push { my ($self) = @_; $self->{pushes}++; CORE::push @{ $self->{log} }, 'push'; 1 }
sub mark { my ($self, $what) = @_; CORE::push @{ $self->{log} }, $what }
t/68-syncguard-end-flush.t view on Meta::CPAN
use App::karr::SyncGuard;
use App::karr::Role::SyncLifecycle;
# Ticket #37: the SyncGuard insurance push never fired at a usable moment on
# the CLI.
#
# App::karr::Role::SyncLifecycle arms a guard for every writing command and
# stashes it on the command object, so a body that dies after writing refs but
# before sync_after should still push. It never did: bin/karr wraps the run in
# an eval and exits from the handler, MooX::Cmd's command chain keeps the
# command object alive, and the guard was therefore first reaped in global
# destruction -- where #34 (rightly) forbids all libgit2 work, leaving nothing
# but a "run karr sync" notice.
#
# The fix is a process-wide registry of armed guards drained by
# App::karr::SyncGuard->flush_armed, which bin/karr calls from an END block:
# the last point before global destruction, and one that also covers the exit()
# calls inside command bodies. The DESTRUCT branch of DESTROY stays as the last
# resort for embedders that never flush -- that is t/66's subject, not this
# file's.
#
t/68-syncguard-end-flush.t view on Meta::CPAN
$guard->done;
is( armed_count(), 0, 'done() deregisters immediately' );
}
{
local $App::karr::Git::WRITES = 0;
my $guard = App::karr::SyncGuard->new( git => $git, quiet => 1 );
is( armed_count(), 1, 'a second guard registers' );
}
is( armed_count(), 0,
'scope exit frees the guard: the registry never kept it alive' );
is( scalar( keys %App::karr::SyncGuard::ARMED ), 0,
'and DESTROY removed the key too, so the registry does not grow' );
};
done_testing;
t/91-locks-are-local.t view on Meta::CPAN
use App::karr::Lock;
use App::karr::Task;
use App::karr::BoardStore;
use App::karr::Cmd::Unlock;
# Ticket #93: task locks lived at refs/karr/tasks/N/lock -- inside the namespace
# karr pushes.
#
# A lock means "this process, in this clone, is mid-pick right now". It says
# nothing a second clone can act on: it cannot tell whether the holder is still
# alive, and has no way to find out. But any sync that fired while one was held
# published it, the next clone to pull inherited it, and it then blocked that
# clone's picks until somebody ran `karr unlock`. Board backups snapshotted it
# too.
#
# The fix is not better release timing -- it is that no refspec can reach the
# refs at all: they live under refs/karr-local/ now.
#
# What must NOT change with them: refs/karr/log/* (the activity log) and every
# other board ref are board state and must keep syncing. Only the locks are
# process-local.
( run in 2.749 seconds using v1.01-cache-2.11-cpan-14f38c9f855 )