From 51f61cf75f6614603782edde86261c9d1bd8c769 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Wed, 7 Sep 2016 21:41:03 +0100
Subject: dgit: Implement `git-fetch --no-insane'

git-fetch has some very poor behaviours.  Implement a non-insane
version.

We are going to want to not fetch things we aren't going to use, and
this is necessary for that.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 dgit | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 128 insertions(+), 2 deletions(-)

diff --git a/dgit b/dgit
index b59d00a..23cae18 100755
--- a/dgit
+++ b/dgit
@@ -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);
-- 
cgit v1.2.3