App-karr
view release on metacpan or search on metacpan
lib/App/karr/Git.pm view on Meta::CPAN
# What _adopt_next_id_ref answers when the local counter was already the
# further one: applied, in the sense that the two sides have converged on it,
# but not by taking the remote's version -- which is the difference the
# conflict report has to know about.
use constant KEPT_LOCAL => 'kept-local';
sub _mirror_prefix {
my ( $self, $remote, $root ) = @_;
return ( $root // MIRROR_ROOT ) . "/$remote/";
}
# Fetch never writes into the live board any more: the remote state lands in
# the mirror, and karr decides per ref what that means. Forced and pruning is
# safe here for the same reason -- the mirror is supposed to be an exact copy
# of the remote, nothing of ours lives in it.
sub _fetch_refspec {
my ( $self, $remote ) = @_;
return '+refs/karr/*:' . $self->_mirror_prefix($remote) . '*';
}
sub has_remote {
my ( $self, $remote ) = @_;
$remote //= 'origin';
my $repo = $self->_repo or return 0;
return $repo->has_remote($remote);
}
# The probe behind the automatic fetch in
# App::karr::Role::BoardDiscovery/require_local_board (#173): does the remote
# hold a board at all? It has to answer that without fetching, because the
# caller's other outcome is a refusal, and it has to answer within a bounded
# time, because it runs unasked in front of `karr list`.
#
# Native first, CLI as the fallback -- the same order every other transport
# here takes. It was the CLI and only the CLI until #203, on the grounds that
# libssh2 retried past libgit2's socket timeout and an ssh:// probe therefore
# had no deadline at all (#174, measured); the 1.9.3 floor cpanfile pins closed
# that, and the argument went with it. What the CLI is still needed for is the
# reason the rest of this class keeps it: libgit2 reads no ~/.ssh/config, so a
# Host alias, the IdentityFile, User or Port under it, and a ProxyCommand all
# exist only for the CLI. libssh2 takes a remote written as `board:karr.git`
# for the literal host `board` and stops at the name lookup (measured), so
# there the fallback is not a second opinion but the only route. git config's
# own url.*.insteadOf is not part of that list: libgit2 applies the rewrite
# itself, as 1.9.3 does here.
#
# The budget (_probe_timeout: KARR_TRANSPORT_TIMEOUT capped at 10 s) is split
# rather than spent twice. The native attempt gets half of it, the CLI gets
# whatever is left of the deadline when the native one returns -- so a remote
# that is silent rather than absent, the case where both attempts run all the
# way to their limit, still costs the cap once. A native attempt that ended the
# budget by itself leaves nothing to fall back with, and the probe reports the
# deadline instead of forking. With KARR_NO_CLI_FALLBACK there is no second
# attempt to hold anything back for, so the native one gets the whole budget:
# the switch means "native only" here, the way it does everywhere else in this
# class, rather than the "do not ask at all" it used to mean when the CLI was
# the only route.
#
# Nothing here may prompt: this call is not one the user made, so a passphrase
# prompt appearing in the middle of `karr list --json` would be a surprise
# that only the deadline ends. On the CLI side GIT_TERMINAL_PROMPT=0 (set by
# _run_git) covers git's own credential prompts; BatchMode covers ssh's, which
# git never sees. It is appended to the user's own GIT_SSH_COMMAND rather than
# replacing it, so a configured wrapper still runs -- and ssh takes the first
# value it is given for an option, so an explicit BatchMode of theirs still
# wins. The native side runs no ssh binary at all: _default_credentials_cb
# hands libgit2 an agent, a key file with an explicit (empty) passphrase, or
# nothing, and never an interactive credential -- so a passphrase-protected
# key with no agent behind it fails the connection rather than asking anyone.
sub remote_has_board {
my ( $self, $remote ) = @_;
$remote //= 'origin';
return 0 unless $self->has_remote($remote);
my $budget = _probe_timeout();
my $share = $ENV{KARR_NO_CLI_FALLBACK} ? $budget : $budget / 2;
my $deadline = Time::HiRes::time() + $budget;
# Set for both attempts: the CLI reaches ssh through this variable, and a
# libgit2 built against the exec ssh transport rather than libssh2 would
# reach it through the same one.
local $ENV{GIT_SSH_COMMAND} =
( $ENV{GIT_SSH_COMMAND} || 'ssh' ) . ' -o BatchMode=yes';
my ( $names, $native_why );
if ( my $repo = $self->_repo ) {
# _repo has just applied the transport budget; the probe's is smaller.
_set_native_transport_timeouts($share);
try {
$names = $repo->remote($remote)
->list_refs( credentials => _default_credentials_cb() );
} catch {
$native_why = clean_error($_);
};
_apply_native_transport_timeouts();
}
# list_refs answers with the remote's own ref names, HEAD included and no
# refspec mapping applied, so the board is a prefix match. An answer with
# no board ref in it is an answer: the remote has none.
return ( grep { index( $_, BOARD_ROOT ) == 0 } @$names ) ? 1 : 0
if $names;
my $why = $native_why;
my $left = $deadline - Time::HiRes::time();
if ( $ENV{KARR_NO_CLI_FALLBACK} ) {
# Native only: whatever it said is the whole answer.
}
elsif ( $left <= 0 ) {
$why = "no answer within ${budget}s";
}
else {
my $run = $self->_run_git( { timeout => $left },
'ls-remote', '--quiet', $remote, BOARD_ROOT . '*' );
if ( $run->{ok} && !$run->{status} ) {
# An answer with no ref in it is an answer: the remote has no board.
return $run->{out} =~ /\S/ ? 1 : 0;
}
# git's first line is the one that says what went wrong ("ssh: connect
# to host ...", "fatal: '/x' does not appear to be a git repository");
lib/App/karr/Git.pm view on Meta::CPAN
# seconds is already an unreasonable remote rather than a slow one -- and it is
# the budget for the whole probe, both of its attempts together.
use constant BOARD_PROBE_TIMEOUT => 10;
# KARR_TRANSPORT_TIMEOUT lowers it and never raises it, 0 ("no limit")
# included: an unasked probe that can hang forever is the thing #173's guard
# clause exists to avoid, and the answer it produces is only ever the
# difference between fetching now and printing "run karr sync".
sub _probe_timeout {
my $configured = _transport_timeout();
return BOARD_PROBE_TIMEOUT
if !$configured || $configured > BOARD_PROBE_TIMEOUT;
return $configured;
}
# Run `git -C <work tree root> @args` and return
# { ok => 0|1, failure => ''|'start'|'timeout', status => $?, out, err,
# timeout => $seconds }
#
# The root, not ->dir. Everything this class hands git as a path comes out of
# _relative_to_root and is therefore measured from the work tree root, while a
# git pathspec is resolved against the process cwd -- so running from ->dir
# asked about `subdir/tasks` whenever ->dir was not the root, and `git ls-files`
# answers that with exit 0 and no output, i.e. "not tracked" (#113). Pinning
# the cwd here puts both routes on one origin instead of correcting the
# pathspec at each call site. It costs the transport verbs nothing: git
# discovers the same repository from either directory. Only a repository
# libgit2 cannot open has no root to run from, and there ->dir is all that is
# left -- the same degradation every other native operation makes.
#
# Both pipes are drained through one IO::Select loop. Reading stdout to EOF
# first, as this used to, deadlocks the moment the child fills the 64 KiB
# stderr pipe buffer: the child blocks on write and so never exits or closes
# stdout, while the parent is still blocked reading stdout. A diverged board
# reaches that at roughly 700 rejected refs, and it could strike inside
# bin/karr's END flush, i.e. after the command had already printed its result
# (#43). The loop is also bounded by a deadline, so a transport that stalls
# (an ssh ProxyCommand hanging on a jump host, a grandchild holding the pipes
# open past the child's exit) fails instead of hanging an unattended agent.
#
# `status` is the raw waitpid status, not `$? >> 8`, so callers can tell a
# clean exit from a death by signal (#42).
sub _run_git {
my ( $self, @args ) = @_;
# An optional leading hashref carries per-call options -- currently only
# `timeout`, for the one caller whose budget is not the transport's
# (remote_has_board, which runs unasked in front of a read command).
# Every other caller passes git's argv and nothing else.
my $opt = ref $args[0] eq 'HASH' ? shift @args : {};
my $cwd = $self->repo_root // $self->dir;
my @cmd = ( 'git', '-C', $cwd->stringify, @args );
my $timeout = defined $opt->{timeout} ? $opt->{timeout} : _transport_timeout();
my %result = (
ok => 0, failure => 'start', status => 0,
out => '', err => '', timeout => $timeout,
);
my ( $pid, $timed_out );
my $started = try {
local $ENV{GIT_TERMINAL_PROMPT} = 0; # never hang on an interactive prompt
my $err_fh = gensym;
$pid = open3( my $in, my $out_fh, $err_fh, @cmd );
close $in;
my %sink = (
fileno($out_fh) => \$result{out},
fileno($err_fh) => \$result{err},
);
my $select = IO::Select->new( $out_fh, $err_fh );
my $deadline = $timeout ? Time::HiRes::time() + $timeout : undef;
while ( $select->count ) {
my $left = defined $deadline
? $deadline - Time::HiRes::time() : undef;
if ( defined $left && $left <= 0 ) { $timed_out = 1; last }
# Poll in slices so the deadline is still honoured while git is
# quiet on both streams.
my $slice = !defined $left || $left > 1 ? 1 : $left;
for my $fh ( $select->can_read($slice) ) {
my $read = sysread $fh, my $chunk, 65_536;
if ( !defined $read ) {
next if $! == EINTR;
$select->remove($fh);
next;
}
if ( !$read ) { $select->remove($fh); next }
my $buffer = $sink{ fileno($fh) };
$$buffer .= $chunk if length($$buffer) < CLI_OUTPUT_LIMIT;
}
}
1;
} catch {
$result{err} = "$_";
0;
};
return \%result unless $started;
if ($timed_out) {
$self->_reap_killed($pid);
$result{failure} = 'timeout';
return \%result;
}
waitpid $pid, 0;
@result{qw( ok failure status )} = ( 1, '', $? );
# The buffers hold raw bytes from the child git process, exactly like the
# bytes config_string hands back: the :encoding(UTF-8) layer on the
# binmode'd handle that reads them would encode them a second time on
# their way out as a karr error message (#157). Decode here so callers
# below this line see character strings, the same as the rest of the
# class.
$result{out} = from_octets( $result{out} );
$result{err} = from_octets( $result{err} );
return \%result;
}
# Take down a child that blew the transport timeout: TERM first, KILL if it is
# still around, and reap it either way so it cannot linger as a zombie in a
# long-running embedder.
sub _reap_killed {
lib/App/karr/Git.pm view on Meta::CPAN
OID. Returns the empty string when the ref doesn't exist, never C<undef>.
=head2 ref_exists
if ( $git->ref_exists($ref) ) { ... }
Returns C<1> when C<$ref> exists, C<0> otherwise -- including when the
repository can't be opened.
=head2 delete_ref
my $removed = $git->delete_ref($ref);
Deletes C<$ref>. Retries transparently through L</retry_contended> while
another process holds the ref's lock. Returns C<1> when this exact call is
the one that removed it and C<0> when there was nothing to remove -- the ref
was not there, or the repository can't be opened at all (which includes the
global-destruction refusal every native operation in this class degrades to,
#63). A delete that was attempted and refused C<die>s with a C<karr: could
not delete ...> message, the same way L</delete_ref_cas> and L</write_ref>
report a real failure: C<0> means "not on the board", never "we could not
tell". It used to fold that failure into the same C<0>, and
L<App::karr::Lock/break_lock> read it as "already gone", so C<karr unlock>
announced a broken lock that was still held (#119). Unlike
L</delete_ref_cas>, the delete itself is unguarded -- whatever is at C<$ref>
goes, last-writer-wins.
=head2 has_remote
if ( $git->has_remote('origin') ) { ... }
Returns true when C<$remote> (default C<origin>) is configured, false
otherwise -- including when the repository can't be opened.
=head2 remote_has_board
my $there = $git->remote_has_board($remote); # default 'origin'
Asks C<$remote> whether it advertises anything under C<refs/karr/> without
fetching. Three answers, and the third is not the second: C<1> when the remote
has a board, C<0> when it answered and has none (C<$remote> not being
configured included), and C<undef> when the question could not be put --
unreachable remote, no C<git> CLI, or no answer within the probe's budget.
L</last_error> carries the reason for C<undef>.
The budget is C<KARR_TRANSPORT_TIMEOUT> capped at 10 seconds, and the cap
applies to C<0> ("no limit") as well: this call runs unasked in front of a
read command, and an unasked round trip that can hang forever is worse than
one that gives up. It is the budget for the probe, not for each attempt: the
native transport is asked first with half of it, and the C<git> CLI gets
whatever is left of the deadline, so a silent remote costs the cap once rather
than twice. C<KARR_NO_CLI_FALLBACK> leaves the native attempt alone with the
whole budget instead.
The CLI is still worth a fallback now that the native transport is bounded for
C<ssh://> too (#174, #203), because libgit2 reads no C<~/.ssh/config>: a
C<Host> alias, the C<IdentityFile>, C<User> or C<Port> under it, and a
C<ProxyCommand> exist only for the CLI, and a remote written as C<board:x.git>
is taken by libssh2 for the literal host C<board>.
Neither route can stop and ask: no credential prompt, no ssh passphrase
prompt. A key that needs a passphrase with no agent behind it fails the probe
instead.
L<App::karr::Role::BoardDiscovery/require_local_board> is the caller: a fresh
clone holds no C<refs/karr/*> because C<git clone> does not fetch them, which
is indistinguishable from having no board until someone asks the remote.
=head2 fetch
my $ok = $git->fetch($remote); # default 'origin'
Runs a plain C<git fetch> using the remote's configured refspecs -- unlike
L</pull>, this does not go through the C<refs/karr-remote/> mirror or touch
the board at all. Returns C<1> when C<$remote> isn't configured (a no-op) or
the fetch succeeds, C<0> on failure with L</last_error> set. Tries the native
libgit2 transport first and falls back to the system C<git> CLI on failure
(see L</DESCRIPTION>).
=head2 push_rejections
my $rejected = $git->push_rejections;
# [ { ref => 'refs/karr/tasks/12/data', reason => 'stale info' }, ... ]
Returns the per-ref rejections from the most recent C<push> or C<push_ref>,
as an array reference of C<< { ref => $name, reason => $text } >> hashes.
Empty when the last push succeeded, and empty when it failed as a whole --
no connection, a killed transport -- rather than ref by ref: a rejection is
the server's final answer, not a transport failure, and the two are kept
apart. Reset to empty at the start of every push attempt, so a rejection from
an earlier call never lingers into the read after a later one succeeds.
libgit2's C<git_remote_push> returns success even when the far side refused
every single ref -- a pre-receive hook, a protected ref, a non-fast-forward on
a non-forced refspec. The per-ref outcome only exists in the
L<Git::Native::Remote::Result> C<push> hands back, and karr used to throw
that away, so a push that landed nothing was reported as a completed sync and
the board diverged in silence (ticket #84). This is where that outcome
survives the call; the CLI fallback parses C<--porcelain> output into the
same shape, so both transports answer the same way.
L<App::karr::Role::SyncLifecycle> and L<App::karr::SyncGuard> both check this
after a failed push and stop retrying once it is non-empty: the remote was
reached and gave its answer, so further attempts would only collect the same
refusal again -- unless L</push_contention> says the answer was "someone else
got here first", which is not an answer worth keeping.
=head2 push_contention
if ( !$git->push and $git->push_contention ) {
# transient: the same push again can land
}
Returns true when the last push was rejected I<and> every rejected ref was
rejected because another push reached it first, rather than because the far
side refused it. False when the push succeeded, when it failed as a whole, and
whenever a single one of the rejected refs carries a reason that is a real
refusal: one protected ref among ten contended ones still makes the push final,
because pushing again cannot change that ref's answer.
Two concurrent pushes creating the same brand-new ref are refused by the
receiving side, and the next push of the same refspec goes through. libgit2's
( run in 0.647 second using v1.01-cache-2.11-cpan-aadc1410aed )