App-karr
view release on metacpan or search on metacpan
lib/App/karr/Git.pm view on Meta::CPAN
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");
# the rest is the standard advice underneath it, and this becomes one
# line in front of a refusal that has four of its own.
my $detail = $run->{err} // '';
$detail =~ s/\s+\z//;
$detail = ( split /\n/, $detail )[0] // '';
# No git to run leaves the native attempt as the only thing that
# happened, so its reason is carried along. The timeout names the whole
# probe's deadline rather than the slice this attempt was given: what
# the caller waited through is both attempts together.
my $start = "could not run git: $detail"
. ( defined $native_why ? " (native: $native_why)" : '' );
$why =
$run->{failure} eq 'start' ? $start
: $run->{failure} eq 'timeout' ? "no answer within ${budget}s"
: length $detail ? $detail
: "git ls-remote exited " . ( $run->{status} >> 8 );
}
$self->{_last_error} = $why // 'the remote could not be asked';
return undef;
}
# Default credentials callback: SSH-agent → ~/.ssh/id_ed25519 → ~/.ssh/id_rsa
# → default → fail. Matches CLI `git`'s implicit auth chain.
sub _default_credentials_cb {
my @tried;
return sub {
my (%args) = @_;
my $user = $args{username_from_url} || 'git';
my $types = $args{allowed_types} || 0;
# GIT_CREDENTIAL_SSH_KEY = 1<<1 = 2
if ( $types & 2 ) {
return Git::Native::Credential->ssh_agent( username => $user )
unless $tried[0]++;
for my $k (qw( id_ed25519 id_rsa )) {
my $priv = "$ENV{HOME}/.ssh/$k";
next unless -r $priv;
next if $tried[1]{$k}++;
return Git::Native::Credential->ssh_key(
username => $user,
private_key => $priv,
public_key => "$priv.pub",
passphrase => '',
);
}
}
# GIT_CREDENTIAL_DEFAULT = 1<<3 = 8
if ( ( $types & 8 ) && !$tried[2]++ ) {
return Git::Native::Credential->default;
}
return undef; # PASSTHROUGH — give up
};
}
sub fetch {
my ( $self, $remote ) = @_;
$remote //= 'origin';
my $repo = $self->_repo or return 0;
return 1 unless $repo->has_remote($remote);
# The Result's ->updated names the refs a fetch actually moved. karr
# deliberately does not use it: reconciliation has to consider the refs the
# fetch did *not* move as well (unpushed local work is exactly that), so it
# reads the ref OIDs itself -- and the CLI transport has no such list to
# hand back, so consuming it would make the two transports differ again,
# which is what #41 was. ->rejected is always empty on fetch.
return $self->_fetch_refspecs( $remote, [] ); # configured refspecs
}
# Per-ref rejections from the most recent push, as
# [ { ref => $name, reason => $text }, ... ]. Empty when the last push
# succeeded, and empty when it failed as a whole (no connection, killed
# transport) rather than ref by ref -- a rejection is the server's final
# answer, so App::karr::Role::SyncLifecycle uses this to stop retrying it.
sub push_rejections {
my ($self) = @_;
return $self->{_push_rejections} || [];
}
# Reasons the receiving side gives for "another push got to this ref first",
# as opposed to "I refuse this ref". The wording is all karr gets, so both
# transports' phrasings are named here:
#
lib/App/karr/Git.pm view on Meta::CPAN
# The one shape where the native push connects to the right repository and
# writes to the wrong one (#208).
#
# libgit2's local transport pushes by opening remote->url -- the *fetch* URL --
# rather than the URL it was handed for the push. So a remote whose push URL
# resolves to a local path different from its fetch URL connects to the push
# URL, and then puts the objects and the refs in the fetch URL's repository and
# reports success. Measured on the 1.9.3 Alien::Libgit2 carries, in both shapes
# that produce a distinct push URL -- remote.<name>.pushurl and
# url.<base>.pushInsteadOf -- by reading back which of two bare repositories
# had actually received refs/karr/*. That is a published board that never
# reached the remote, with nothing failing for the CLI fallback to catch, so
# the fallback is put in front of the push instead: the git CLI lands at the
# push URL in every one of these cases, which is where this remote's board
# belongs.
#
# Narrow on purpose. An ordinary board has no push URL at all, so this is one
# NULL check and no string work; a push URL identical to the fetch URL is the
# same repository either way; and where the push URL is a real transport
# libgit2 is correct, which is where all the ssh and https boards are. What is
# left over is the shape above -- and a fetch URL that is not local, where the
# native push would fail rather than misdirect (it opens a URL that is no path)
# and the CLI is the route regardless.
#
# Returns the reason as a message, or the empty list when the push may run
# natively. The message is what App::karr::Git/last_error carries when
# KARR_NO_CLI_FALLBACK leaves no route to take instead: a named refusal, rather
# than a success that went somewhere else.
sub _misdirected_local_push {
my ($remote_obj) = @_;
my $push = _remote_pushurl($remote_obj) or return ();
my $url = from_octets( $remote_obj->url // '' );
return () if $push eq $url;
return () unless _is_local_url($push);
return "the remote's push URL ($push) is a local path different from its "
. "fetch URL ($url), and libgit2's local transport writes to the fetch "
. "URL regardless (#208) -- the git CLI is the only route that lands "
. "where this remote points";
}
# Send @$refspecs and report the outcome the way every caller here needs it:
# native transport first, CLI fallback on a transport failure, and a per-ref
# rejection turned into a false return with last_error and push_rejections set.
# The three public pushes -- the board's, a single helper ref's and the fleet
# namespace's -- differ in what they send and in what they do afterwards, never
# in this, so it is written once.
sub _push_refspecs {
my ( $self, $remote, $refspecs ) = @_;
my $repo = $self->_repo or return 0;
$self->{_push_rejections} = [];
my $result;
my $ok = try {
my $r = $repo->remote($remote);
if ( my $why = _misdirected_local_push($r) ) {
$self->{_last_error} = $why;
return $self->_cli_transport( 'push', $remote, $refspecs );
}
$result = $r->push(
refspecs => $refspecs,
credentials => _default_credentials_cb(),
);
1;
} catch {
$self->{_last_error} = "$_";
$self->_cli_transport( 'push', $remote, $refspecs );
};
return 0 unless $ok;
return $self->_accept_push_result( $remote, $result ) ? 1 : 0;
}
# The fetch half of the same: native first, CLI fallback, no reconciliation.
# An empty @$refspecs means the remote's configured ones.
sub _fetch_refspecs {
my ( $self, $remote, $refspecs, %opt ) = @_;
my $repo = $self->_repo or return 0;
return try {
my $r = $repo->remote($remote);
$r->fetch(
refspecs => $refspecs,
credentials => _default_credentials_cb(),
( $opt{prune} ? ( prune => 1 ) : () ),
);
1;
} catch {
$self->{_last_error} = "$_";
$self->_cli_transport( 'fetch', $remote, $refspecs, %opt );
};
}
sub push {
my ( $self, $remote, $refspec ) = @_;
$remote //= 'origin';
my $repo = $self->_repo or return 0;
$refspec //= BOARD_REFSPEC;
my $board = $refspec eq BOARD_REFSPEC;
# No remote is no debt. A tombstone is the record of a deletion this clone
# owes the remote (TOMBSTONE_ROOT), and _clear_pending_deletes only ever
# ran after a push that landed -- so a repository with no remote, where
# this returns before anything else happens, kept one ref per deleted card
# forever, each of them holding the deleted commit reachable (#197).
#
# Settled here rather than given a retention age, because a tombstone is
# push bookkeeping: keeping the card recoverable is a side effect of
# pointing it at the deleted commit, not its job, nothing reads one back,
# and an age limit would need a deletion time this ref does not carry (its
# commit's date is when the card was last written) plus a policy to
# configure. The unpleasant case decides it: with the record kept, adding
# a remote later makes the first push publish every deletion ever made
# here, and a push checks no board identity -- #95 guards the pull -- so a
# board that happens to have cards at those paths loses them.
#
# has_pending_deletes, the auto-fetch guard (#173), still reads correctly:
# it is only consulted after has_remote, and without a remote there is
# nothing to fetch back.
unless ( $repo->has_remote($remote) ) {
$self->_settle_local_deletes(BOARD_ROOT) if $board;
return 1;
}
# A board push publishes exactly two things: the local refs as they stand
# here, and the deletions this clone recorded. It used to publish a third
# -- "and nothing else exists", via prune -- which is a claim no clone is
# in a position to make: a card another clone created a second ago is one
# this one has never seen, and pruning deleted it off the remote, after
# which _mirror_local_state made the mirror agree and the next pull read
# it as a deletion the remote had made and removed the card locally too.
# Eight parallel creates in one clone lost a whole card that way, and one
# `karr sync --push` from a clone that had not pulled did it on its own
# (#178).
#
# The snapshot is read before the push rather than after: the refspec is
# expanded inside the push, so a ref written in between is published
# without being in the snapshot -- which leaves the mirror lagging the
# remote, the direction that converges harmlessly (see
# _mirror_local_state). Reading it afterwards is the direction that
# loses cards: the mirror would claim refs the push never carried.
my ( $local, $tombstones, @deletes );
if ($board) {
$local = $self->ref_oids(BOARD_ROOT) || {};
lib/App/karr/Git.pm view on Meta::CPAN
# The snapshot may carry a different meta/encoding than the board had.
delete $self->{_encoding_version};
return 1;
}
sub delete_refs {
my ( $self, $prefix ) = @_;
# One ref refusing to go must not stop the others, or the report below
# would name whichever failed first instead of everything still standing.
# delete_ref dies on a refusal now (#119), and that exception is the only
# thing that says *why* a `karr destroy` is stuck -- so it is kept, not
# swallowed, and raised after every ref has had its turn.
my @why;
for my $ref ( $self->list_refs($prefix) ) {
try { $self->delete_ref($ref) } catch { CORE::push @why, $_ };
}
# Re-read rather than trust the loop. Now that delete_ref can say no
# (#51), swallowing that here would just move the old lie one level up and
# let `karr destroy` report success over refs that are still on disk. It is
# also the only answer that stays right when a ref vanished underneath us:
# gone is gone, whoever removed it.
my @left = $self->list_refs($prefix);
return 1 unless @left;
die join( '', @why ) if @why;
die "karr: could not delete " . join( ', ', @left ) . "\n";
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
App::karr::Git - Git operations for karr sync (native via Git::Native + libgit2, with a git-CLI transport fallback)
=head1 VERSION
version 0.601
=head1 SYNOPSIS
my $git = App::karr::Git->new(dir => '.');
$git->pull;
my @ids = $git->list_task_refs;
my $task = $git->load_task_ref($ids[0]);
=head1 DESCRIPTION
L<App::karr::Git> provides the low-level Git interface used by C<karr> for
syncing board state through C<refs/karr/*>. Local object/ref ops (read/write/
delete of refs, blobs, trees, commits) run natively via L<Git::Native> (FFI
to libgit2) with no fork/exec. SSH-agent and HTTPS-token credentials are
supplied through the libgit2 credential-acquire callback.
Network fetch/push (C<fetch>, C<pull>, C<push>, C<push_ref>, C<pull_ref>)
also try the native libgit2 transport first. If that transport fails, they
fall back to the system C<git> CLI (via L<IPC::Open3>). What the fallback is
there for is C<~/.ssh/config>, which libgit2 does not read: a C<Host> alias,
the C<IdentityFile>, C<User> or C<Port> written under it, and a
C<ProxyCommand> all take effect through the CLI and nowhere else. libssh2
reads a remote spelled C<board:karr.git> as the literal host C<board> and
stops at the name lookup, so for a board reached through an alias the CLI is
not a second opinion but the only route. Set C<KARR_NO_CLI_FALLBACK=1> to
disable the fallback and surface native transport failures directly.
Git's own URL rewriting is not part of that list, though this paragraph
listed it for a long time. libgit2 applies C<< url.<base>.insteadOf >>
itself, and C<pushInsteadOf> alongside it -- on the 1.9.3 that
L<Alien::Libgit2> carries, a fetch goes where the first rule points and a
push where the second does. That was settled by aiming the two rules at two
different repositories and reading back which one each end had reached,
because a rewrite is easy to measure wrongly: a rule pointing at a path that
does not exist fails as C<unsupported URL protocol>, which looks exactly like
no rewrite having happened at all. The substitution is textual and runs
before anything inspects the protocol, so it is not confined to the local
paths it was first tried on -- C<ssh://> and C<https://> serve on either side
of a rule, as the URL being rewritten or as what it is rewritten to.
One corner does not hold, and it is the second thing the fallback is there
for. Where a remote's push URL resolves to a local path other than its fetch
URL -- from C<pushInsteadOf>, or from an explicit C<< remote.<name>.pushurl >>
-- libgit2's local transport connects to the push URL and then writes the
objects and refs to the fetch URL regardless, reporting success. Nothing fails,
so nothing used to fall back, and the board was published to the wrong
repository in silence. Such a push is therefore taken off the native transport
before it runs and sent through the CLI, which lands at the push URL in every
one of these cases; with C<KARR_NO_CLI_FALLBACK> there is no route left and it
fails naming both URLs instead (#208). A push URL that is absent, that names
the fetch URL, or that is a real transport is untouched by this -- libgit2 is
correct there, which is where ssh and https boards are.
Every CLI transport run is bounded by a wall-clock timeout, 120 seconds by
default; C<KARR_TRANSPORT_TIMEOUT> overrides it (in seconds, C<0> disables
it). A run that blows the timeout is killed and reported as a failure. The
same setting bounds the native transport, as libgit2's per-read/write network
timeout -- one knob for both routes. It reaches every transport libgit2
speaks, C<ssh://> included: those reads go through libssh2, which used to
retry past the socket timeout, and the C<Alien::Libgit2> this distribution
requires carries the libgit2 1.9.3 that stopped it (#174). The two bounds are
not the same shape, though -- the CLI's is the whole run's wall clock,
libgit2's is one read or write -- so nothing that finishes under the CLI rule
can fail under the native one. L</remote_has_board> narrows both: it runs
unasked in front of a read command (#173), so its budget is capped at 10
seconds and split between its two attempts.
C<push> sends C<refs/karr/*> under a forced refspec, plus one delete refspec
for every board ref this clone deleted and has not published yet. It
deliberately does not prune: a prune makes the pusher's local refs the whole
truth of the namespace, which is wrong the moment another clone holds a card
this one has never seen -- that push took the card off the remote, and the
mirror update behind it made the next pull delete it locally as well (#178).
C<pull> is its inverse, but it never fetches straight into the board: the
( run in 0.634 second using v1.01-cache-2.11-cpan-007c89162af )