X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=95398497b7c4d9ba77208da8297b33b5c949a851;hp=53ccd724b821a9dcd59355f08011ff804f4951d7;hb=fe2c39524a6c74aed1f21f0e3eaafc332c46843c;hpb=5a25026a936fed50c4ad1dd06b5fc57f3fe9c2c0

diff --git a/dgit b/dgit
index 53ccd724..95398497 100755
--- a/dgit
+++ b/dgit
@@ -36,6 +36,7 @@ use Digest::SHA;
 use Digest::MD5;
 use List::Util qw(any);
 use List::MoreUtils qw(pairwise);
+use Carp;
 
 use Debian::Dgit;
 
@@ -155,6 +156,28 @@ sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
 sub rrref () { return server_ref($csuite); }
 
 sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; }
+sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
+
+# We fetch some parts of lrfetchrefs/*.  Ideally we delete these
+# locally fetched refs because they have unhelpful names and clutter
+# up gitk etc.  So we track whether we have "used up" head ref (ie,
+# whether we have made another local ref which refers to this object).
+#
+# (If we deleted them unconditionally, then we might end up
+# re-fetching the same git objects each time dgit fetch was run.)
+#
+# So, leach use of lrfetchrefs needs to be accompanied by arrangements
+# in git_fetch_us to fetch the refs in question, and possibly a call
+# to lrfetchref_used.
+
+our (%lrfetchrefs_f, %lrfetchrefs_d);
+# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid
+
+sub lrfetchref_used ($) {
+    my ($fullrefname) = @_;
+    my $objid = $lrfetchrefs_f{$fullrefname};
+    $lrfetchrefs_d{$fullrefname} = $objid if defined $objid;
+}
 
 sub stripepoch ($) {
     my ($vsn) = @_;
@@ -196,11 +219,6 @@ sub no_such_package () {
     exit 4;
 }
 
-sub fetchspec () {
-    local $csuite = '*';
-    return  "+".rrref().":".lrref();
-}
-
 sub changedir ($) {
     my ($newdir) = @_;
     printdebug "CD $newdir\n";
@@ -1220,9 +1238,11 @@ sub get_archive_dsc () {
 	my $fmt = getfield $dsc, 'Format';
 	fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
 	$dsc_checked = !!$digester;
+	printdebug "get_archive_dsc: Version ".(getfield $dsc, 'Version')."\n";
 	return;
     }
     $dsc = undef;
+    printdebug "get_archive_dsc: nothing in archive, returning undef\n";
 }
 
 sub check_for_git ();
@@ -1292,7 +1312,7 @@ sub create_remote_git_repo () {
     }
 }
 
-our ($dsc_hash,$lastpush_hash);
+our ($dsc_hash,$lastpush_mergeinput);
 
 our $ud = '.git/dgit/unpack';
 
@@ -1471,7 +1491,8 @@ sub check_for_vendor_patches () {
 			  "distro being accessed");
 }
 
-sub generate_commit_from_dsc () {
+sub generate_commits_from_dsc () {
+    # See big comment in fetch_from_archive, below.
     prep_ud();
     changedir $ud;
 
@@ -1520,10 +1541,16 @@ $changes
 # imported from the archive
 END
     close C or die $!;
-    my $outputhash = make_commit qw(../commit.tmp);
+    my $rawimport_hash = make_commit qw(../commit.tmp);
     my $cversion = getfield $clogp, 'Version';
+    my $rawimport_mergeinput = {
+        Commit => $rawimport_hash,
+        Info => "Import of source package",
+    };
+    my @output = ($rawimport_mergeinput);
     progress "synthesised git commit from .dsc $cversion";
-    if ($lastpush_hash) {
+    if ($lastpush_mergeinput) {
+	my $lastpush_hash = $lastpush_mergeinput->{Commit};
 	runcmd @git, qw(reset -q --hard), $lastpush_hash;
 	runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp';
 	my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
@@ -1531,37 +1558,28 @@ END
 	my $vcmp =
 	    version_compare($oversion, $cversion);
 	if ($vcmp < 0) {
-	    # git upload/ is earlier vsn than archive, use archive
-	    open C, ">../commit2.tmp" or die $!;
-	    print C <<END or die $!;
-tree $tree
-parent $lastpush_hash
-parent $outputhash
-author $authline
-committer $authline
-
+	    @output = ($rawimport_mergeinput, $lastpush_mergeinput,
+		{ Message => <<END, ReverseParents => 1 });
 Record $package ($cversion) in archive suite $csuite
 END
-            $outputhash = make_commit qw(../commit2.tmp);
 	} elsif ($vcmp > 0) {
 	    print STDERR <<END or die $!;
 
-Version actually in archive:    $cversion (older)
-Last allegedly pushed/uploaded: $oversion (newer or same)
+Version actually in archive:   $cversion (older)
+Last version pushed with dgit: $oversion (newer or same)
 $later_warning_msg
 END
-            $outputhash = $lastpush_hash;
+            @output = $lastpush_mergeinput;
         } else {
-	    $outputhash = $lastpush_hash;
+	    # Same version.  Use what's in the server git branch,
+	    # discarding our own import.  (This could happen if the
+	    # server automatically imports all packages into git.)
+	    @output = $lastpush_mergeinput;
 	}
     }
     changedir '../../../..';
-    runcmd @git, qw(update-ref -m),"dgit fetch import $cversion",
-            'DGIT_ARCHIVE', $outputhash;
-    cmdoutput @git, qw(log -n2), $outputhash;
-    # ... gives git a chance to complain if our commit is malformed
     rmtree($ud);
-    return $outputhash;
+    return @output;
 }
 
 sub complete_file_from_dsc ($$) {
@@ -1610,11 +1628,138 @@ sub ensure_we_have_orig () {
 }
 
 sub git_fetch_us () {
-    my @specs = (fetchspec());
-    push @specs,
-        map { "+refs/$_/*:".lrfetchrefs."/$_/*" }
-        qw(tags heads);
-    runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(), @specs;
+    # Want to fetch only what we are going to use, unless
+    # deliberately-not-ff, in which case we must fetch everything.
+
+    my @specs = deliberately_not_fast_forward ? qw(tags/*) :
+	map { "tags/$_" } debiantags('*',access_basedistro);
+    push @specs, server_branch($csuite);
+    push @specs, qw(heads/*) if deliberately_not_fast_forward;
+
+    # 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 $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);
@@ -1626,12 +1771,14 @@ sub git_fetch_us () {
     });
     git_for_each_ref([map { lrfetchrefs."/tags/".$_ } @tagpats], sub {
 	my ($objid,$objtype,$fullrefname,$reftail) = @_;
-	my $lref = "refs".substr($fullrefname, length lrfetchrefs);
+	my $lref = "refs".substr($fullrefname, length(lrfetchrefs));
 	printdebug "offered $lref=$objid\n";
 	if (!defined $here{$lref}) {
 	    my @upd = (@git, qw(update-ref), $lref, $objid, '');
 	    runcmd_ordryrun_local @upd;
+	    lrfetchref_used $fullrefname;
 	} elsif ($here{$lref} eq $objid) {
+	    lrfetchref_used $fullrefname;
 	} else {
 	    print STDERR \
 		"Not updateting $lref from $here{$lref} to $objid.\n";
@@ -1639,6 +1786,21 @@ sub git_fetch_us () {
     });
 }
 
+sub mergeinfo_getclogp ($) {
+    my ($mi) = @_;
+    # Ensures thit $mi->{Clogp} exists and returns it
+    return $mi->{Clogp} if $mi->{Clogp};
+    my $mclog = ".git/dgit/clog-$mi->{Commit}";
+    mkpath '.git/dgit';
+    runcmd shell_cmd "exec >$mclog", @git, qw(cat-file blob),
+	"$mi->{Commit}:debian/changelog";
+    $mi->{Clogp} = parsechangelog("-l$mclog");
+}
+
+sub mergeinfo_version ($) {
+    return getfield( (mergeinfo_getclogp $_[0]), 'Version' );
+}
+
 sub fetch_from_archive () {
     # ensures that lrref() is what is actually in the archive,
     #  one way or another
@@ -1660,35 +1822,164 @@ sub fetch_from_archive () {
 	progress "no version available from the archive";
     }
 
-    $lastpush_hash = git_get_ref(lrref());
+    # If the archive's .dsc has a Dgit field, there are three
+    # relevant git commitids we need to choose between and/or merge
+    # together:
+    #   1. $dsc_hash: the Dgit field from the archive
+    #   2. $lastpush_hash: the suite branch on the dgit git server
+    #   3. $lastfetch_hash: our local tracking brach for the suite
+    #
+    # These may all be distinct and need not be in any fast forward
+    # relationship:
+    #
+    # If the dsc was pushed to this suite, then the server suite
+    # branch will have been updated; but it might have been pushed to
+    # a different suite and copied by the archive.  Conversely a more
+    # recent version may have been pushed with dgit but not appeared
+    # in the archive (yet).
+    #
+    # $lastfetch_hash may be awkward because archive imports
+    # (particularly, imports of Dgit-less .dscs) are performed only as
+    # needed on individual clients, so different clients may perform a
+    # different subset of them - and these imports are only made
+    # public during push.  So $lastfetch_hash may represent a set of
+    # imports different to a subsequent upload by a different dgit
+    # client.
+    #
+    # Our approach is as follows:
+    #
+    # As between $dsc_hash and $lastpush_hash: if $lastpush_hash is a
+    # descendant of $dsc_hash, then it was pushed by a dgit user who
+    # had based their work on $dsc_hash, so we should prefer it.
+    # Otherwise, $dsc_hash was installed into this suite in the
+    # archive other than by a dgit push, and (necessarily) after the
+    # last dgit push into that suite (since a dgit push would have
+    # been descended from the dgit server git branch); thus, in that
+    # case, we prefer the archive's version (and produce a
+    # pseudo-merge to overwrite the dgit server git branch).
+    #
+    # (If there is no Dgit field in the archive's .dsc then
+    # generate_commit_from_dsc uses the version numbers to decide
+    # whether the suite branch or the archive is newer.  If the suite
+    # branch is newer it ignores the archive's .dsc; otherwise it
+    # generates an import of the .dsc, and produces a pseudo-merge to
+    # overwrite the suite branch with the archive contents.)
+    #
+    # The outcome of that part of the algorithm is the `public view',
+    # and is same for all dgit clients: it does not depend on any
+    # unpublished history in the local tracking branch.
+    #
+    # As between the public view and the local tracking branch: The
+    # local tracking branch is only updated by dgit fetch, and
+    # whenever dgit fetch runs it includes the public view in the
+    # local tracking branch.  Therefore if the public view is not
+    # descended from the local tracking branch, the local tracking
+    # branch must contain history which was imported from the archive
+    # but never pushed; and, its tip is now out of date.  So, we make
+    # a pseudo-merge to overwrite the old imports and stitch the old
+    # history in.
+    #
+    # Finally: we do not necessarily reify the public view (as
+    # described above).  This is so that we do not end up stacking two
+    # pseudo-merges.  So what we actually do is figure out the inputs
+    # to any public view psuedo-merge and put them in @mergeinputs.
+
+    my @mergeinputs;
+    # $mergeinputs[]{Commit}
+    # $mergeinputs[]{Info}
+    # $mergeinputs[0] is the one whose tree we use
+    # @mergeinputs is in the order we use in the actual commit)
+    #
+    # Also:
+    # $mergeinputs[]{Message} is a commit message to use
+    # $mergeinputs[]{ReverseParents} if def specifies that parent
+    #                                list should be in opposite order
+    # Such an entry has no Commit or Info.  It applies only when found
+    # in the last entry.  (This ugliness is to support making
+    # identical imports to previous dgit versions.)
+
+    my $lastpush_hash = git_get_ref(lrfetchref());
     printdebug "previous reference hash=$lastpush_hash\n";
-    my $hash;
+    $lastpush_mergeinput = $lastpush_hash && {
+        Commit => $lastpush_hash,
+	Info => "dgit suite branch on dgit git server",
+    };
+
+    my $lastfetch_hash = git_get_ref(lrref());
+    printdebug "fetch_from_archive: lastfetch=$lastfetch_hash\n";
+    my $lastfetch_mergeinput = $lastfetch_hash && {
+	Commit => $lastfetch_hash,
+	Info => "dgit client's archive history view",
+    };
+
+    my $dsc_mergeinput = $dsc_hash && {
+        Commit => $dsc_hash,
+        Info => "Dgit field in .dsc from archive",
+    };
+
+    my $cwd = getcwd();
+    my $del_lrfetchrefs = sub {
+	changedir $cwd;
+	my $gur;
+	printdebug "del_lrfetchrefs\n";
+	foreach my $fullrefname (sort keys %lrfetchrefs_d) {
+	    my $objid = $lrfetchrefs_d{$fullrefname};
+	    printdebug "del_lrfetchrefs: $fullrefname=$objid.\n";
+	    if (!$gur) {
+		$gur ||= new IO::Handle;
+		open $gur, "|-", qw(git update-ref --stdin) or die $!;
+	    }
+	    printf $gur "delete %s %s\n", $fullrefname, $objid;
+	}
+	if ($gur) {
+	    close $gur or failedcmd "git update-ref delete lrfetchrefs";
+	}
+    };
+
     if (defined $dsc_hash) {
 	fail "missing remote git history even though dsc has hash -".
-	    " could not find ref ".lrref().
-	    " (should have been fetched from ".access_giturl()."#".rrref().")"
+	    " could not find ref ".rref()." at ".access_giturl()
 	    unless $lastpush_hash;
-	$hash = $dsc_hash;
 	ensure_we_have_orig();
 	if ($dsc_hash eq $lastpush_hash) {
+	    @mergeinputs = $dsc_mergeinput
 	} elsif (is_fast_fwd($dsc_hash,$lastpush_hash)) {
 	    print STDERR <<END or die $!;
 
 Git commit in archive is behind the last version allegedly pushed/uploaded.
-Commit referred to by archive:  $dsc_hash
-Last allegedly pushed/uploaded: $lastpush_hash
+Commit referred to by archive: $dsc_hash
+Last version pushed with dgit: $lastpush_hash
 $later_warning_msg
 END
-	    $hash = $lastpush_hash;
+	    @mergeinputs = ($lastpush_mergeinput);
 	} else {
-	    fail "git head (".lrref()."=$lastpush_hash) is not a ".
-		"descendant of archive's .dsc hash ($dsc_hash)";
+	    # Archive has .dsc which is not a descendant of the last dgit
+	    # push.  This can happen if the archive moves .dscs about.
+	    # Just follow its lead.
+	    if (is_fast_fwd($lastpush_hash,$dsc_hash)) {
+		progress "archive .dsc names newer git commit";
+		@mergeinputs = ($dsc_mergeinput);
+	    } else {
+		progress "archive .dsc names other git commit, fixing up";
+		@mergeinputs = ($dsc_mergeinput, $lastpush_mergeinput);
+	    }
 	}
     } elsif ($dsc) {
-	$hash = generate_commit_from_dsc();
+	@mergeinputs = generate_commits_from_dsc();
+	# We have just done an import.  Now, our import algorithm might
+	# have been improved.  But even so we do not want to generate
+	# a new different import of the same package.  So if the
+	# version numbers are the same, just use our existing version.
+	# If the version numbers are different, the archive has changed
+	# (perhaps, rewound).
+	if ($lastfetch_mergeinput &&
+	    !version_compare( (mergeinfo_version $lastfetch_mergeinput),
+			      (mergeinfo_version $mergeinputs[0]) )) {
+	    @mergeinputs = ($lastfetch_mergeinput);
+	}
     } elsif ($lastpush_hash) {
 	# only in git, not in the archive yet
-	$hash = $lastpush_hash;
+	@mergeinputs = ($lastpush_mergeinput);
 	print STDERR <<END or die $!;
 
 Package not found in the archive, but has allegedly been pushed using dgit.
@@ -1705,14 +1996,126 @@ But we were not able to obtain any version from the archive or git.
 
 END
 	}
+	unshift @end, $del_lrfetchrefs;
 	return 0;
     }
-    printdebug "current hash=$hash\n";
-    if ($lastpush_hash) {
-	fail "not fast forward on last upload branch!".
-	    " (archive's version left in DGIT_ARCHIVE)"
-	    unless is_fast_fwd($lastpush_hash, $hash);
+
+    if ($lastfetch_hash &&
+	!grep {
+	    my $h = $_->{Commit};
+	    $h and is_fast_fwd($lastfetch_hash, $h);
+	    # If true, one of the existing parents of this commit
+	    # is a descendant of the $lastfetch_hash, so we'll
+	    # be ff from that automatically.
+	} @mergeinputs
+        ) {
+	# Otherwise:
+	push @mergeinputs, $lastfetch_mergeinput;
+    }
+
+    printdebug "fetch mergeinfos:\n";
+    foreach my $mi (@mergeinputs) {
+	if ($mi->{Info}) {
+	    printdebug " commit $mi->{Commit} $mi->{Info}\n";
+	} else {
+	    printdebug sprintf " ReverseParents=%d Message=%s",
+		$mi->{ReverseParents}, $mi->{Message};
+	}
     }
+
+    my $compat_info= pop @mergeinputs
+	if $mergeinputs[$#mergeinputs]{Message};
+
+    @mergeinputs = grep { defined $_->{Commit} } @mergeinputs;
+
+    my $hash;
+    if (@mergeinputs > 1) {
+	# here we go, then:
+	my $tree_commit = $mergeinputs[0]{Commit};
+
+	my $tree = cmdoutput @git, qw(cat-file commit), $tree_commit;
+	$tree =~ m/\n\n/;  $tree = $`;
+	$tree =~ m/^tree (\w+)$/m or die "$dsc_hash tree ?";
+	$tree = $1;
+
+	# We use the changelog author of the package in question the
+	# author of this pseudo-merge.  This is (roughly) correct if
+	# this commit is simply representing aa non-dgit upload.
+	# (Roughly because it does not record sponsorship - but we
+	# don't have sponsorship info because that's in the .changes,
+	# which isn't in the archivw.)
+	#
+	# But, it might be that we are representing archive history
+	# updates (including in-archive copies).  These are not really
+	# the responsibility of the person who created the .dsc, but
+	# there is no-one whose name we should better use.  (The
+	# author of the .dsc-named commit is clearly worse.)
+
+	my $useclogp = mergeinfo_getclogp $mergeinputs[0];
+	my $author = clogp_authline $useclogp;
+	my $cversion = getfield $useclogp, 'Version';
+
+	my $mcf = ".git/dgit/mergecommit";
+	open MC, ">", $mcf or die "$mcf $!";
+	print MC <<END or die $!;
+tree $tree
+END
+
+	my @parents = grep { $_->{Commit} } @mergeinputs;
+	@parents = reverse @parents if $compat_info->{ReverseParents};
+	print MC <<END or die $! foreach @parents;
+parent $_->{Commit}
+END
+
+	print MC <<END or die $!;
+author $author
+committer $author
+
+END
+
+	if (defined $compat_info->{Message}) {
+	    print MC $compat_info->{Message} or die $!;
+	} else {
+	    print MC <<END or die $!;
+Record $package ($cversion) in archive suite $csuite
+
+Record that
+END
+	    my $message_add_info = sub {
+		my ($mi) = (@_);
+		my $mversion = mergeinfo_version $mi;
+		printf MC "  %-20s %s\n", $mversion, $mi->{Info}
+		    or die $!;
+	    };
+
+	    $message_add_info->($mergeinputs[0]);
+	    print MC <<END or die $!;
+should be treated as descended from
+END
+	    $message_add_info->($_) foreach @mergeinputs[1..$#mergeinputs];
+	}
+
+	close MC or die $!;
+	$hash = make_commit $mcf;
+    } else {
+	$hash = $mergeinputs[0]{Commit};
+    }
+    progress "fetch hash=$hash\n";
+
+    my $chkff = sub {
+	my ($lasth, $what) = @_;
+	return unless $lasth;
+	die "$lasth $hash $what ?" unless is_fast_fwd($lasth, $hash);
+    };
+
+    $chkff->($lastpush_hash, 'dgit repo server tip (last push)');
+    $chkff->($lastfetch_hash, 'local tracking tip (last fetch)');
+
+    runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
+	    'DGIT_ARCHIVE', $hash;
+    cmdoutput @git, qw(log -n2), $hash;
+    # ... gives git a chance to complain if our commit is malformed
+
     if (defined $skew_warning_vsn) {
 	mkpath '.git/dgit';
 	printdebug "SKEW CHECK WANT $skew_warning_vsn\n";
@@ -1732,7 +2135,8 @@ We were able to obtain only   $got_vsn
 END
 	}
     }
-    if ($lastpush_hash ne $hash) {
+
+    if ($lastfetch_hash ne $hash) {
 	my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
 	if (act_local()) {
 	    cmdoutput @upd_cmd;
@@ -1740,6 +2144,10 @@ END
 	    dryrun_report @upd_cmd;
 	}
     }
+
+    lrfetchref_used lrfetchref();
+
+    unshift @end, $del_lrfetchrefs;
     return 1;
 }
 
@@ -1808,7 +2216,6 @@ sub clone ($) {
     runcmd @git, qw(init -q);
     my $giturl = access_giturl(1);
     if (defined $giturl) {
-	set_local_git_config "remote.$remotename.fetch", fetchspec();
 	open H, "> .git/HEAD" or die $!;
 	print H "ref: ".lref()."\n" or die $!;
 	close H or die $!;
@@ -2243,11 +2650,13 @@ END
 	create_remote_git_repo();
     }
 
-    my @pushrefs = $forceflag."HEAD:".rrref();
+    my @pushrefs = $forceflag.$dgithead.":".rrref();
     foreach my $tw (@tagwants) {
 	my $view = $tw->{View};
 	next unless $view eq 'dgit'
 	    or any { $_ eq $view } access_cfg_tagformats();
+	    # ^ $view is "dgit" or "maint" so this looks for "maint"
+	    # in archive supported tagformats.
 	push @pushrefs, $forceflag."refs/tags/$tw->{Tag}";
     }
 
@@ -3475,6 +3884,7 @@ sub maybe_unapply_patches_again () {
 	if $patches_applied_dirtily & 01;
     rmtree '.pc'
 	if $patches_applied_dirtily & 02;
+    $patches_applied_dirtily = 0;
 }
 
 #----- other building -----
@@ -3663,16 +4073,15 @@ sub cmd_gbp_build {
 	}
 	build_prep();
     }
+    maybe_unapply_patches_again();
     if ($wantsrc < 2) {
 	unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
 	    canonicalise_suite();
 	    push @cmd, "--git-debian-branch=".lbranch();
 	}
 	push @cmd, changesopts();
-	maybe_apply_patches_dirtily();
 	runcmd_ordryrun_local @cmd, @ARGV;
     }
-    maybe_unapply_patches_again();
     printdone "build successful\n";
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
@@ -3755,6 +4164,7 @@ sub cmd_sbuild {
 	    " building would result in ambiguity about the intended results"
 	    if @unwanted;
     }
+    my $wasdir = must_getcwd();
     changedir "..";
     if (act_local()) {
 	stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
@@ -3783,6 +4193,7 @@ sub cmd_sbuild {
 	    rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
 	}
     }
+    changedir $wasdir;
     maybe_unapply_patches_again();
     printdone "build successful, results in $multichanges\n" or die $!;
 }