use Digest::MD5;
use List::Util qw(any);
use List::MoreUtils qw(pairwise);
+use Carp;
use Debian::Dgit;
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) = @_;
exit 4;
}
-sub fetchspec () {
- local $csuite = '*';
- return "+".rrref().":".lrref();
-}
-
sub changedir ($) {
my ($newdir) = @_;
printdebug "CD $newdir\n";
- chdir $newdir or die "chdir: $newdir: $!";
+ chdir $newdir or confess "chdir: $newdir: $!";
}
sub deliberately ($) {
return $c;
}
+sub commit_getclogp ($) {
+ # Returns the parsed changelog hashref for a particular commit
+ my ($objid) = @_;
+ our %commit_getclogp_memo;
+ my $memo = $commit_getclogp_memo{$objid};
+ return $memo if $memo;
+ mkpath '.git/dgit';
+ my $mclog = ".git/dgit/clog-$objid";
+ runcmd shell_cmd "exec >$mclog", @git, qw(cat-file blob),
+ "$objid:debian/changelog";
+ $commit_getclogp_memo{$objid} = parsechangelog("-l$mclog");
+}
+
sub must_getcwd () {
my $d = getcwd();
defined $d or fail "getcwd failed: $!";
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 ();
}
}
-our ($dsc_hash,$lastpush_hash);
+our ($dsc_hash,$lastpush_mergeinput);
our $ud = '.git/dgit/unpack';
"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;
# 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) {
- runcmd @git, qw(reset -q --hard), $lastpush_hash;
- runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp';
- my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
+ if ($lastpush_mergeinput) {
+ my $oldclogp = mergeinfo_getclogp($lastpush_mergeinput);
my $oversion = getfield $oldclogp, 'Version';
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 ($$) {
}
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);
});
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";
});
}
+sub mergeinfo_getclogp ($) {
+ # Ensures thit $mi->{Clogp} exists and returns it
+ my ($mi) = @_;
+ $mi->{Clogp} = commit_getclogp($mi->{Commit});
+}
+
+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
+ # Ensures that lrref() is what is actually in the archive, one way
+ # or another, according to us - ie this client's
+ # appropritaely-updated archive view. Also returns the commit id.
+ # If there is nothing in the archive, leaves lrref alone and
+ # returns undef. git_fetch_us must have already been called.
get_archive_dsc();
if ($dsc) {
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: $objid $fullrefname\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.
END
}
- return 0;
+ unshift @end, $del_lrfetchrefs;
+ return undef;
+ }
+
+ 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};
+ }
}
- 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);
+
+ 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";
- my $clogf = ".git/dgit/changelog.tmp";
- runcmd shell_cmd "exec >$clogf",
- @git, qw(cat-file blob), "$hash:debian/changelog";
- my $gotclogp = parsechangelog("-l$clogf");
+ my $gotclogp = commit_getclogp($hash);
my $got_vsn = getfield $gotclogp, 'Version';
printdebug "SKEW CHECK GOT $got_vsn\n";
if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
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;
dryrun_report @upd_cmd;
}
}
- return 1;
+
+ lrfetchref_used lrfetchref();
+
+ unshift @end, $del_lrfetchrefs;
+ return $hash;
}
sub set_local_git_config ($$) {
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 $!;
$tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro);
$tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };
}
+ printdebug 'push_tagwants: ', Dumper(\@_, \@tagwants);
return @tagwants;
}
}
}
-sub dopush ($) {
- my ($forceflag) = @_;
+sub dopush () {
printdebug "actually entering push\n";
+
+ supplementary_message(<<'END');
+Push failed, while checking state of the archive.
+You can retry the push, after fixing the problem, if you like.
+END
+ if (check_for_git()) {
+ git_fetch_us();
+ }
+ my $archive_hash = fetch_from_archive();
+ if (!$archive_hash) {
+ $new_package or
+ fail "package appears to be new in this suite;".
+ " if this is intentional, use --new";
+ }
+
supplementary_message(<<'END');
Push failed, while preparing your push.
You can retry the push, after fixing the problem, if you like.
}
check_not_dirty();
+
+ my $forceflag = '';
+ if ($archive_hash) {
+ if (is_fast_fwd($archive_hash, $dgithead)) {
+ # ok
+ } elsif (deliberately_not_fast_forward) {
+ $forceflag = '+';
+ } else {
+ fail "dgit push: HEAD is not a descendant".
+ " of the archive's version.\n".
+ "dgit: To overwrite its contents,".
+ " use git merge -s ours ".lrref().".\n".
+ "dgit: To rewind history, if permitted by the archive,".
+ " use --deliberately-not-fast-forward";
+ }
+ }
+
changedir $ud;
progress "checking that $dscfn corresponds to HEAD";
runcmd qw(dpkg-source -x --),
$changesfile = "$buildproductsdir/$changesfile";
}
+ # Checks complete, we're going to try and go ahead:
+
responder_send_file('changes',$changesfile);
responder_send_command("param head $dgithead");
responder_send_command("param csuite $csuite");
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}";
}
fail "dgit push: changelog specifies $isuite ($csuite)".
" but command line specifies $specsuite";
}
- supplementary_message(<<'END');
-Push failed, while checking state of the archive.
-You can retry the push, after fixing the problem, if you like.
-END
- if (check_for_git()) {
- git_fetch_us();
- }
- my $forceflag = '';
- if (fetch_from_archive()) {
- if (is_fast_fwd(lrref(), 'HEAD')) {
- # ok
- } elsif (deliberately_not_fast_forward) {
- $forceflag = '+';
- } else {
- fail "dgit push: HEAD is not a descendant".
- " of the archive's version.\n".
- "dgit: To overwrite its contents,".
- " use git merge -s ours ".lrref().".\n".
- "dgit: To rewind history, if permitted by the archive,".
- " use --deliberately-not-fast-forward";
- }
- } else {
- $new_package or
- fail "package appears to be new in this suite;".
- " if this is intentional, use --new";
- }
- dopush($forceflag);
+ dopush();
}
#---------- remote commands' implementation ----------
if $patches_applied_dirtily & 01;
rmtree '.pc'
if $patches_applied_dirtily & 02;
+ $patches_applied_dirtily = 0;
}
#----- other building -----
}
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
" 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): $!";
rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
}
}
+ changedir $wasdir;
maybe_unapply_patches_again();
printdone "build successful, results in $multichanges\n" or die $!;
}
~ianmdlvl / dgit.git / blobdiff