App-karr
view release on metacpan or search on metacpan
lib/App/karr/Foundation/Runner.pm view on Meta::CPAN
# ABSTRACT: karr-foundation command execution -- fork/pipe/select tee + run classification
package App::karr::Foundation::Runner;
our $VERSION = '0.600';
use Moo;
use App::karr::Error qw( clean_error user_error );
use App::karr::Encoding qw( from_octets json_decode to_octets to_octets_for_env );
use Encode ();
use IO::Select;
use IO::Handle ();
use POSIX qw( SIGTERM SIGKILL SIGALRM WNOHANG setpgid );
use Scalar::Util qw( looks_like_number );
has foundation => (
is => 'ro',
weak_ref => 1,
required => 1,
);
# ---------------------------------------------------------------------------
# Command execution
# ---------------------------------------------------------------------------
sub _run_command {
my ( $self, $repo, $karr, $cmd, $ticket, $agent, %opt ) = @_;
my $command = $cmd // $karr->{command};
my $stream_terms = $self->foundation->_stream_to_terminal;
# What this run is, and how long it may take. Both default to the agent, who
# was the only caller for as long as there was only one kind of run. The
# C<on_drained> hook (#193) is the second: it wants the whole apparatus below
# -- the process group, the timeout, the tee -- and none of the identity, so
# it passes its own role and its own budget and takes everything else as it
# stands. Anything the identity decides is keyed off $role and nothing else.
my $role = $opt{role} // 'agent';
my $max_runtime = $opt{max_runtime} // $karr->{max_runtime} // 1800;
# How this run's output is to be read for a human, decided by the agent
# definition that supplied the command and by nothing else (#188). Undef --
# every board that names no agent -- is the historical path: the octets the
# command printed, verbatim, to the log and the terminal.
my $render = ref $agent eq 'HASH' ? $agent->{render} : undef;
# Environment for the child (and all karr calls it spawns). The child inherits
# it across the fork/exec below, so a command template — including the
# synthesized claude command — expands $PROMPT, ${KARR_REPO}, $KARR_ROLE and
# every other variable foundation itself was started with as ordinary shell
# parameters. %ENV is a byte boundary owned by App::karr::Encoding, so each
# value is encoded through to_octets_for_env before the assignment (#167):
# a non-ASCII prompt would otherwise emit "Wide character in setenv" on
# stderr and the bytes the child receives would depend on the IO layers in
# scope at the call site.
local $ENV{KARR_REPO} = to_octets_for_env("$repo");
local $ENV{KARR_ROLE} = to_octets_for_env($role);
# The prompt is the board agent's instruction, so only the board agent gets
# the board's one. A hook handed a prompt telling it to pick the next
# actionable task would be told to do the one thing it is not there for, and
# every karr write it made would land in the agent's activity log -- which is
# the evidence the auto-block reads. KARR_ROLE keeps those apart, and this
# keeps the instruction with the identity it belongs to.
#
# A caller that brings its OWN instruction passes it, and the coordination
# agent (#210) is the one that does: it is an agent and needs a prompt, but
# not the board's -- it is not there to work a card, and it is not even run
# in a board's own repository in the sense the drain means. `prompt => ...`
# is therefore the exception the two identities above make necessary, not a
# third way for a board agent to be told what to do.
local $ENV{PROMPT} = to_octets_for_env(
defined $opt{prompt} ? $opt{prompt}
: $role eq 'agent' ? $self->foundation->_prompt_for( $karr, $ticket )
: '' );
# The id of the task this run is about, in ticket mode, and empty in every
# other mode -- localised either way so a run never inherits the previous
# one's card, and so a template reading it in drain mode gets nothing rather
# than a stale number. This is the whole machine-readable half of the ticket
# contract: the prompt above carries the assignment in prose for the agent,
# $KARR_TASK carries it for a command template that wants the bare id
# (`myagent --task "$KARR_TASK"`). Deliberately not an argument appended to
# the command -- how arguments are appended is what `kind: claude-code`
# settles per agent definition (#188), and an env var is the one thing that
# works with every command template that exists today, including the
# synthesized `claude -p "$PROMPT"`.
local $ENV{KARR_TASK} = defined $ticket ? to_octets_for_env("$ticket") : '';
# The expansion is the shell's, not ours (#159). Splicing %ENV into the command
# string here instead meant the shell went on to parse the *values*: a prompt
# is board content written in Markdown, so its backtick spans and $(...) ran as
# commands in the board's own directory, and the substitution reached inside
# single quotes, where sh guarantees a literal — awk '{print $2}' arrived as
# awk '{print }'. Parameter expansion has neither problem: sh does not rescan
# an expanded value for substitutions, and it leaves single quotes alone. A
# template that needs a value the shell cannot see gets it exported above,
# never spliced.
#
# So this logs the template, which is now exactly the string /bin/sh -c is
# handed. It used to log the substituted result, which after this change is not
# even computable without reimplementing the shell — and what an operator reads
# this line for is which command was resolved (--command vs default_command vs
# .karr vs synthesized claude), not a second copy of the prompt. It also no
# longer copies whatever an env var held — a wrapper's API key included — into
# a plaintext .karr.log.
$self->foundation->_append_log( $repo, 'START '
. ( $role ne 'agent' ? "role=$role " : '' )
. ( ref $agent eq 'HASH' && defined $agent->{name} ? "agent=$agent->{name} " : '' )
. "command=$command" );
$self->foundation->_say_verbose("exec in $repo: $command");
if ( $self->foundation->dry_run ) {
$self->foundation->_append_log( $repo, "DRY-RUN (skipped)" );
return ( 0, '' );
}
my $log_file = $repo->child('.karr.log');
# Opened before the command is started, not after (#147). Everything from the
# fork below to the waitpid at the end of this method runs with a live agent
# on the other side, and the drain loop that calls this catches per repo and
# moves on to the next board — so a croak in that window releases the board's
# lock with its agent still running and leaves one behind for the rest of the
# foundation run. Refusing to start an agent whose log cannot be written is
# the honest failure, and it is the one the foundation's own
# _append_log("START ...") above already makes for the same file.
# A resource the OS refused is the operator's problem, not a bug report, so
# this and the two below carry the errno and no call site into this file (#77).
open( my $log_fh, '>>', "$log_file" ) or user_error("open log $log_file: $!");
$log_fh->autoflush(1);
# Native pipe: the child writes stdout+stderr, the parent reads. The parent
# is the tee — it fans each chunk to the persistent log, the terminal (when
# streaming), and an in-memory buffer for error scanning. No external tee
# process to race, and the run's output is captured directly (no re-slurping
# the log via byte offsets).
pipe( my $reader, my $writer ) or user_error("pipe failed: $!");
my $pid = fork;
user_error("fork failed: $!") unless defined $pid;
if ( $pid == 0 ) {
# child
close $reader;
chdir "$repo" or die "chdir $repo: $!";
open( STDOUT, '>&', $writer ) or die "dup stdout: $!";
open( STDERR, '>&STDOUT' ) or die "dup stderr: $!";
# The agent becomes its own process group leader so the runner can signal
# the whole tree (the agent, its forked grandchildren, anything it
# backgrounded) without reaching the runner itself (#148). Before this the
# timeout SIGTERM hit only the shell — `sleep 300 & wait`, a pipeline, any
# command the agent backgrounded, all survived the kill because they were
# children of /bin/sh, not of the runner. setpgrp(0,0) puts the child in a
# group whose pgid is its own pid; the parent signals that group with
# kill 'TERM', -$pid. SIGALRM is also reset to default in the child — the
# timeout timer is the runner's, not the agent's.
setpgid( 0, 0 ) if defined &setpgid;
POSIX::setsid() if !defined &setpgid; # fall back if POSIX::setpgid isn't there
$SIG{ALRM} = 'DEFAULT';
exec( '/bin/sh', '-c', $command ) or die "exec: $!";
}
# parent. From here to the waitpid below there is a running agent, so nothing
lib/App/karr/Foundation/Runner.pm view on Meta::CPAN
# when $render is on; the raw path below never touches them.
my $line_buf = '';
my $shown = '';
while (1) {
last if $timed_out;
if ( !$sel ) {
# SIGALRM fired and closed $reader; nothing left to do but exit the loop
# so the kill path runs.
last;
}
my @ready = $sel->can_read( $max_runtime > 0 ? $max_runtime - ( time - $started ) : undef );
last if $timed_out;
unless (@ready) {
# Spurious wakeup (signal) or genuine deadline. SIGALRM would have set
# the flag, but the deadline could also be reached by wall clock if a
# signal reset the alarm — check both and end the loop either way.
next unless $max_runtime > 0;
last if time - $started >= $max_runtime;
next;
}
my $chunk;
my $n = sysread( $reader, $chunk, 65536 );
last if !defined $n; # read error (or SIGALRM closing the fd)
last if $n == 0; # EOF — the command closed its output
if ($render) {
$pending .= $chunk;
$line_buf .= Encode::decode( 'UTF-8', $pending, Encode::FB_QUIET );
while ( $line_buf =~ s/\A([^\n]*)\n// ) {
my $text = $self->_render_stream_line( $render, $1 );
next unless length $text;
print {$log_fh} to_octets($text);
print $text if $stream_terms;
$shown = substr $text, -1;
}
}
else {
print {$log_fh} $chunk;
if ($stream_terms) {
$pending .= $chunk;
print Encode::decode( 'UTF-8', $pending, Encode::FB_QUIET );
}
}
# The classification buffer keeps the raw octets whatever the terminal and
# the log were given: _run_result reads the result object out of the tail
# of the stream, and rendering has just dropped it on the floor.
$output .= $chunk;
}
# A last line the command left without a newline (it was killed, or it simply
# does not end its output with one) still has something to say.
if ( $render && length $line_buf ) {
my $text = $self->_render_stream_line( $render, $line_buf );
if ( length $text ) {
print {$log_fh} to_octets($text);
print $text if $stream_terms;
$shown = substr $text, -1;
}
}
# Rendered text arrives as deltas and the last one rarely ends a line, so
# without this the shell prompt (and the next log line) lands mid-sentence.
if ( $render && length $shown && $shown ne "\n" ) {
print {$log_fh} "\n";
print "\n" if $stream_terms;
}
# Disarm the alarm before reap: a waitpid that takes longer than max_runtime
# would otherwise be cut short by SIGALRM (no handler anymore — the default
# action is to die, and Foundation is the parent). $max_runtime == 0 already
# never armed.
alarm 0;
$SIG{ALRM} = 'DEFAULT' if $max_runtime > 0;
my $exit_code;
if ($timed_out) {
my $elapsed = time - $started;
# The one call that has to happen here rather than after the kill: it is the
# only record of why the agent was stopped, and the kill/waitpid pair below
# can block for as long as the child stays unkillable. So it runs
# best-effort — a log the OS took away mid-run (#147) must not cost us the
# SIGTERM/SIGKILL and the reap, which are all that stop a hung agent. The
# failure is reported once the child is safely gone, and the END line below
# raises it for real if the log is still unwritable by then.
my $log_err;
eval {
$self->foundation->_append_log( $repo,
"TIMEOUT after ${elapsed}s -- sending SIGTERM to $pid (group -$pid)" );
1;
} or $log_err = clean_error($@);
# Negative pid = process group (kill(2) group semantics, #148). The shell,
# the agent, any grandchildren the agent backgrounded, all receive the
# signal. SIGTERM is catchable, so we wait up to 2s before escalating.
kill 'TERM', -$pid;
my $deadline = time + 2;
while ( time < $deadline ) {
last if kill( 0, $pid ) == 0;
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;
while (1) {
my $w = waitpid( $pid, WNOHANG );
last if $w > 0 || $w < 0;
if ( time >= $deadline ) {
lib/App/karr/Foundation/Runner.pm view on Meta::CPAN
[ '502', ['502'], _http( 502, qr/bad gateway/i ) ],
[ '503', ['503'], _http( 503, qr/service unavailable/i ) ],
);
sub _error_patterns {
my ( $self, $karr ) = @_;
# A board's own error_patterns stay what they were documented as: plain
# case-insensitive substrings. Somebody who configures one has seen the
# string their agent prints and means exactly it -- the narrowing above is
# for the defaults, which have to hold for every board. Such a pattern is
# its own pre-filter.
my @custom = map { [ $_, [ lc $_ ], qr/\Q$_\E/i ] }
@{ $karr->{error_patterns} // [] };
return [ @DEFAULT_PATTERNS, @custom ];
}
sub _match_error {
my ( $self, $text, $patterns ) = @_;
return undef unless defined $text && length $text;
# The pre-filter earns its keep on the output that has none of this in it,
# which is nearly all of it: index() over a whole transcript is a memory
# scan, these patterns are not, and skipping one that cannot match costs a
# single index instead of a full pass. A trigger that does not occur in what
# its own pattern matches would silently switch that pattern off, so t/152
# checks the two against each other over the corpus.
my $lc;
for my $p ( @$patterns ) {
my ( $name, $triggers, $re ) =
ref $p eq 'ARRAY' ? @$p : ( $p, [ lc $p ], qr/\Q$p\E/i );
$lc //= lc $text;
next unless grep { index( $lc, $_ ) >= 0 } @$triggers;
return $name if $text =~ $re;
}
return undef;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
App::karr::Foundation::Runner - karr-foundation command execution -- fork/pipe/select tee + run classification
=head1 VERSION
version 0.600
=head1 DESCRIPTION
L<App::karr::Foundation::Runner> runs a single agent command for
L<App::karr::Foundation>. It forks the command under C</bin/sh -c>, reads its
combined stdout/stderr over a native pipe, and tees each chunk to the
persistent C<.karr.log>, the terminal (when streaming), and an in-memory buffer
the run is classified from, enforcing the per-run C<max_runtime> timeout. A
weak back-reference to the owning foundation supplies shared options and helpers
(C<dry_run>, C<_stream_to_terminal>, C<_prompt_for>, C<_append_log>,
C<_say_verbose>).
That buffer is read twice over, in this order. First for the run's B<own
report>: an agent invoked with C<--output-format json> ends its output with a
JSON object saying whether the run failed, how it ended, how many turns it
took, how long it ran and what it cost. C<_run_result> finds it -- at the tail
of the output, which is the only place a mixture of prose and JSON cannot be
misread -- and C<_result_error> says whether the ending it describes is a
common error and of what kind.
Only where a run left no report does the older text scan run: observable common
errors (rate limit, auth, network, 5xx, ...) matched against the transcript,
where a symptom word counts only next to a failure word on the same line, or
inside a phrase an API really emits, and an HTTP status only where something
adjacent marks it as one. The drain asks that at all only for a run that made
no progress -- see L<App::karr::Foundation>'s "Drain semantics".
The command is a shell template, not a string karr rewrites: C<PROMPT>,
C<KARR_REPO>, C<KARR_ROLE> and C<KARR_TASK> are exported into the child's
environment and C</bin/sh> expands them like any other parameter. A prompt's own
backticks therefore stay text, and C<< awk '{print $2}' >> reaches awk intact.
C<KARR_TASK> holds the id of the task a C<< mode: ticket >> run was given and is
empty in every other mode; the same id is spelled out in the prompt.
Where the agent came from a definition with an invocation contract that asks
for structured live output (C<kind: claude-code>, #188), the tee renders it: the
assistant's own text goes to the terminal and to F<.karr.log> as it arrives,
while the raw stream stays in the classification buffer. That is what lets the
contract ask for a machine-readable format without losing the live output an
interactive run is watched for. A board that names no agent is on the older
path -- the octets the command printed, verbatim, to both sinks.
A C<.karr.log> it cannot open ends the run for that board B<before> the command
is started, never after: the agent is refused rather than launched unwatched.
Once the fork has happened the parent owes it a C<waitpid>, so nothing between
the two may throw.
The agent is not the only thing that goes through this door. The C<on_drained>
hook (L<App::karr::Foundation>) is a command in a repository that must not
outlive the run that started it either, so it is started here rather than
beside here -- one process-group kill, one timeout, one tee, one place where
the live child is registered for the shutdown handler. What it does B<not>
share is the identity: C<< role => 'hook' >> puts C<KARR_ROLE=hook> in its
environment and leaves C<PROMPT> empty, so its own C<karr> writes land in a
different activity log from the agent's and it is never handed the instruction
to go and pick a card. C<< max_runtime => N >> gives it its own budget, because
how long a board's agent may run says nothing about how long whatever the
operator hung on C<on_drained> may take. Nothing else in this method asks who
the caller is: the run is classified by the drain, which simply does not
classify a hook.
The coordination agent (L<App::karr::Foundation::Coordinator>) is the third,
and the one that needed a third option: it B<is> an agent and needs an
instruction, but not a board's -- so it passes C<< prompt => ... >> beside
C<< role => 'coordinator' >> and gets its own text in C<$PROMPT> instead of
the board's or the hook's silence.
=head2 foundation
The owning L<App::karr::Foundation> instance, held C<weak_ref> to avoid a
reference cycle. Supplies the shared options and helpers a run needs
(C<dry_run>, C<_stream_to_terminal>, C<_prompt_for>, C<_append_log>,
C<_say_verbose>) that do not belong to the Runner itself.
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/karr/issues>.
=head2 IRC
Join C<#langertha> on C<irc.perl.org> or message Getty directly.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
=cut
( run in 0.658 second using v1.01-cache-2.11-cpan-ff9377addf4 )