view release on metacpan or  search on metacpan

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

  # 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
  # in between may die: no croaking call, and no unguarded call into the
  # foundation (its _append_log throws when the log file is gone). Keep it that
  # way — the tee loop below reports its errors by ending, not by dying.
  close $writer;

  # setpgid in the child may race with the parent's getpgid (the child has not
  # called it yet when fork returns in the parent). setpgid( $pid, $pid ) in the
  # parent is idempotent if the child has already done it, and is the
  # documented way to guarantee the value is set before we signal the group.
  setpgid( $pid, $pid ) if defined &setpgid;

  # The runner is the only place that knows the agent's pid and pgid — the
  # Foundation needs both so its SIGTERM handler can kill the agent's process
  # group when the cron host stops us mid-drain (#163). Record them here, in
  # the foundation's own attribute, so a handler installed in run() can reach
  # them without re-reading the lock file (which it does anyway, defensively).
  $self->foundation->_live_agent(
    { repo => $repo, pid => $pid, pgid => $pid, lockfile => $self->foundation->_state->_lock_file( $repo ) }
  );

  my $started   = time;
  my $output    = '';
  my $timed_out = 0;
  my $sel       = IO::Select->new($reader);

  # Deadline arming: the deadline must fire regardless of IO activity, because
  # an agent that closes its stdout/stderr while still running ends the read
  # loop on EOF with $timed_out still 0, and the runner falls into a bare
  # blocking waitpid that holds .karr.lock forever (#161). SIGALRM with a
  # handler that sets $timed_out keeps the deadline independent of the read
  # loop: the alarm fires at the deadline, the handler arms the flag, the
  # next loop iteration sees it and ends the loop. arm_alarm() also re-arms on
  # each can_read wakeup so a long-running command never gets a stale timer
  # from a prior iteration — every iteration arms for "remaining from now",
  # which is what the user expects max_runtime to mean.
  my $alarm_target;
  if ( $max_runtime > 0 ) {
    $alarm_target = $started + $max_runtime;
    $SIG{ALRM} = sub {
      $timed_out = 1;
      # Closing the read end of the pipe unblocks can_read with no data so
      # the loop wakes immediately rather than waiting for the alarm delivery
      # to reach it through sysread's EINTR. Cheap and signal-safe.
      close $reader;
      $sel = undef;
    };
    alarm $max_runtime;
  }

  # The agent's output arrives as raw octets in 64k reads that can split a
  # multi-byte character, while STDOUT carries the :encoding(UTF-8) layer
  # F<karr-foundation> installed and therefore wants characters. FB_QUIET is
  # the streaming decoder: it consumes every complete sequence and leaves a
  # trailing partial one in $pending for the next chunk. The log file and the
  # error-scanning buffer keep the raw octets.
  my $pending = '';

  # Line assembly for a rendered stream (see _render_stream_line). Only used
  # 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;
      }