view release on metacpan or  search on metacpan

lib/App/karr/Foundation/State.pm  view on Meta::CPAN

# ABSTRACT: karr-foundation per-repo state — lock file, JSON state, cooldown backoff

package App::karr::Foundation::State;
our $VERSION = '0.500';
use Moo;
use Path::Tiny;
use Fcntl qw( LOCK_EX LOCK_NB LOCK_UN );
use App::karr::Encoding qw( json_encode json_decode );
use Try::Tiny;


has foundation => (
  is       => 'ro',
  weak_ref => 1,
  required => 1,
);

# ---------------------------------------------------------------------------
# Lock file — flock-gated, holds the work, not the watcher
# ---------------------------------------------------------------------------
#
# The lock names the work, not the foundation process: a stale foundation (a
# SIGTERM-restart, a segfault, a hung shell waiting for a child that has been
# 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.

sub _lock_file { path( $_[1]->child('.karr.lock') ) }

# Read the lock metadata — pid/pgid/agent_pid/started — without taking the
# flock. Used by the SIGTERM handler in Foundation.pm and by --status, which
# have to look at the file without acquiring it. Unreadable files (missing,
# corrupt) yield undef rather than dying — the caller can fall back to "no
# live agent" if it wants.
#
# We do NOT use Path::Tiny's slurp here: slurp opens a second fd and calls
# flock() LOCK_EX on it (blocking). When this foundation still holds the
# lock through its own fd, the second fd's flock blocks forever — the
# documented quirk is that flock per-open-file-description can deadlock
# when one process owns the only exclusive lock. Use raw sysread instead;
# the flock doesn't block our own reads, only other flocks.
sub _read_lock_metadata {
  my ( $self, $repo ) = @_;
  my $lock = $self->_lock_file( $repo );
  return undef unless $lock->exists;
  open( my $fh, '<', "$lock" ) or return undef;
  my $raw = '';
  my $buf = '';
  while (1) {
    my $n = sysread( $fh, $buf, 4096 );
    last unless defined $n && $n;
    $raw .= $buf;
    last if $n < 4096;
  }
  close $fh;
  return undef unless length $raw;
  my $data = try { json_decode($raw) } catch { return undef };
  return ref $data eq 'HASH' ? $data : undef;
}

# Held iff someone holds the flock. We probe with LOCK_EX LOCK_NB: on success
# the lock is stale (no holder), we release and report 0; on EWOULDBLOCK
# someone else owns it and we report 1. A file we can read but not flock is
# held; a file we can read and flock is not. Missing files are not held.
sub _lock_held {
  my ( $self, $repo ) = @_;
  my $lock = $self->_lock_file( $repo );
  return 0 unless $lock->exists;
  open( my $fh, '<', "$lock" ) or do {
    # Unlinked by another tick that just released; the next acquire will
    # recreate it. Treat as not held.
    return 0;
  };
  if ( flock( $fh, LOCK_EX | LOCK_NB ) ) {
    flock( $fh, LOCK_UN );
    close $fh;