diff options
Diffstat (limited to 'dgit')
-rwxr-xr-x | dgit | 130 |
1 files changed, 128 insertions, 2 deletions
@@ -1607,9 +1607,135 @@ sub ensure_we_have_orig () { sub git_fetch_us () { my @specs = - map { "+refs/$_/*:".lrfetchrefs."/$_/*" } + map { "$_/*" } qw(tags heads), $branchprefix; - runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(), @specs; + + # This is rather miserable: + # When git-fetch --prune is passed a fetchspec ending with a *, + # it does a plausible thing. If there is no * then: + # - it matches subpaths too, even if the supplied refspec + # starts refs, and behaves completely madly if the source + # has refs/refs/something. (See, for example, Debian #NNNN.) + # - if there is no matching remote ref, it bombs out the whole + # fetch. + # We want to fetch a fixed ref, and we don't know in advance + # if it exists, so this is not suitable. + # + # Our workaround is to use git-ls-remote. git-ls-remote has its + # own qairks. Notably, it has the absurd multi-tail-matching + # behaviour: git-ls-remote R refs/foo can report refs/foo AND + # refs/refs/foo etc. + # + # Also, we want an idempotent snapshot, but we have to make two + # calls to the remote: one to git-ls-remote and to git-fetch. The + # solution is use git-ls-remote to obtain a target state, and + # git-fetch to try to generate it. If we don't manage to generate + # the target state, we try again. + + my $specre = join '|', map { + my $x = $_; + $x =~ s/\W/\\$&/g; + $x =~ s/\\\*$/.*/; + "(?:refs/$x)"; + } @specs; + printdebug "git_fetch_us specre=$specre\n"; + my $wanted_rref = sub { + local ($_) = @_; + return m/^(?:$specre)$/o; + }; + + my %lrfetchrefs_f; + + my $fetch_iteration = 0; + FETCH_ITERATION: + for (;;) { + if (++$fetch_iteration > 10) { + fail "too many iterations trying to get sane fetch!"; + } + + my @look = map { "refs/$_" } @specs; + my @lcmd = (@git, qw(ls-remote -q --refs), access_giturl(), @look); + debugcmd "|",@lcmd; + + my %wantr; + open GITLS, "-|", @lcmd or die $!; + while (<GITLS>) { + printdebug "=> ", $_; + m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?"; + my ($objid,$rrefname) = ($1,$2); + if (!$wanted_rref->($rrefname)) { + print STDERR <<END; +warning: git-ls-remote @look reported $rrefname; this is silly, ignoring it. +END + next; + } + $wantr{$rrefname} = $objid; + } + $!=0; $?=0; + close GITLS or failedcmd @lcmd; + + # OK, now %want is exactly what we want for refs in @specs + my @fspecs = map { + return () if !m/\*$/ && !exists $wantr{"refs/$_"}; + "+refs/$_:".lrfetchrefs."/$_"; + } @specs; + + my @fcmd = (@git, qw(fetch -p -n -q), access_giturl(), @fspecs); + runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(), + @fspecs; + + %lrfetchrefs_f = (); + my %objgot; + + git_for_each_ref(lrfetchrefs, sub { + my ($objid,$objtype,$lrefname,$reftail) = @_; + $lrfetchrefs_f{$lrefname} = $objid; + $objgot{$objid} = 1; + }); + + foreach my $lrefname (sort keys %lrfetchrefs_f) { + my $rrefname = 'refs'.substr($lrefname, length lrfetchrefs); + if (!exists $wantr{$rrefname}) { + if ($wanted_rref->($rrefname)) { + printdebug <<END; +git-fetch @fspecs created $lrefname which git-ls-remote @look didn't list. +END + } else { + print STDERR <<END +warning: git-fetch @fspecs created $lrefname; this is silly, deleting it. +END + } + runcmd_ordryrun_local @git, qw(update-ref -d), $lrefname; + delete $lrfetchrefs_f{$lrefname}; + next; + } + } + foreach my $rrefname (sort keys %wantr) { + my $lrefname = lrfetchrefs.substr($rrefname, 4); + my $got = $lrfetchrefs_f{$lrefname} // '<none>'; + my $want = $wantr{$rrefname}; + next if $got eq $want; + if (!defined $objgot{$want}) { + print STDERR <<END; +warning: git-ls-remote suggests we want $lrefname +warning: and it should refer to $want +warning: but git-fetch didn't fetch that object to any relevant ref. +warning: This may be due to a race with someone updating the server. +warning: Will try again... +END + next FETCH_ITERATION; + } + printdebug <<END; +git-fetch @fspecs made $lrefname=$got but want git-ls-remote @look says $want +END + runcmd_ordryrun_local @git, qw(update-ref -m), + "dgit fetch git-fetch fixup", $lrefname, $want; + $lrfetchrefs_f{$lrefname} = $want; + } + last; + } + printdebug "git_fetch_us: git-fetch --no-insane emulation complete\n", + Dumper(\%lrfetchrefs_f); my %here; my @tagpats = debiantags('*',access_basedistro); |