use IPC::Open2;
use Digest::SHA;
use Digest::MD5;
+use List::Util qw(any);
+use List::MoreUtils qw(pairwise);
use Debian::Dgit;
our $our_version = 'UNRELEASED'; ###substituted###
-our @rpushprotovsn_support = qw(3 2); # 4 is new tag format
+our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
our $protovsn;
our $isuite = 'unstable';
our $we_are_responder;
our $initiator_tempdir;
our $patches_applied_dirtily = 00;
+our $tagformat_want;
our $tagformat;
our $tagformatfn;
return $tagformatfn->($v, $distro);
}
+sub debiantag_maintview ($$) {
+ my ($v,$distro) = @_;
+ $v =~ y/~:/_%/;
+ return "$distro/$v";
+}
+
sub lbranch () { return "$branchprefix/$csuite"; }
my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$';
sub lref () { return "refs/heads/".lbranch(); }
sub rrref () { return server_ref($csuite); }
sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; }
+sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
sub stripepoch ($) {
my ($vsn) = @_;
exit 4;
}
-sub fetchspec () {
- local $csuite = '*';
- return "+".rrref().":".lrref();
-}
-
sub changedir ($) {
my ($newdir) = @_;
printdebug "CD $newdir\n";
# > file changes
# [etc]
#
-# > param head HEAD
+# > param head DGIT-VIEW-HEAD
# > param csuite SUITE
+# > param tagformat old|new
+# > param maint-view MAINT-VIEW-HEAD
#
# > previously REFNAME=OBJNAME # if --deliberately-not-fast-forward
# # goes into tag, for replay prevention
'dgit.default.ssh' => 'ssh',
'dgit.default.archive-query' => 'madison:',
'dgit.default.sshpsql-dbname' => 'service=projectb',
- 'dgit.default.dgit-tag-format' => 'old,new',
+ 'dgit.default.dgit-tag-format' => 'old,new,maint',
'dgit-distro.debian.archive-query' => 'ftpmasterapi:',
'dgit-distro.debian.git-check' => 'url',
'dgit-distro.debian.git-check-suffix' => '/info/refs',
return sort { -version_compare($a->[0],$b->[0]); } @rows;
}
+#---------- tag format handling ----------
+
+sub access_cfg_tagformats () {
+ split /\,/, access_cfg('dgit-tag-format');
+}
+
+sub need_tagformat ($$) {
+ my ($fmt, $why) = @_;
+ fail "need to use tag format $fmt ($why) but also need".
+ " to use tag format $tagformat_want->[0] ($tagformat_want->[1])".
+ " - no way to proceed"
+ if $tagformat_want && $tagformat_want->[0] ne $fmt;
+ $tagformat_want = [$fmt, $why, $tagformat_want->[2] // 0];
+}
+
+sub select_tagformat () {
+ # sets $tagformatfn
+ return if $tagformatfn && !$tagformat_want;
+ die 'bug' if $tagformatfn && $tagformat_want;
+ # ... $tagformat_want assigned after previous select_tagformat
+
+ my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats();
+ printdebug "select_tagformat supported @supported\n";
+
+ $tagformat_want //= [ $supported[0], "distro access configuration", 0 ];
+ printdebug "select_tagformat specified @$tagformat_want\n";
+
+ my ($fmt,$why,$override) = @$tagformat_want;
+
+ fail "target distro supports tag formats @supported".
+ " but have to use $fmt ($why)"
+ unless $override
+ or grep { $_ eq $fmt } @supported;
+
+ $tagformat_want = undef;
+ $tagformat = $fmt;
+ $tagformatfn = ${*::}{"debiantag_$fmt"};
+
+ fail "trying to use unknown tag format \`$fmt' ($why) !"
+ unless $tagformatfn;
+}
+
#---------- archive query entrypoints and rest of program ----------
sub canonicalise_suite () {
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 ();
}
}
-sub select_tagformat () {
- # sets $tagformatfn
- return if $tagformatfn && !$tagformat;
- die 'bug' if $tagformatfn && $tagformat;
- # ... $tagformat assigned after previous select_tagformat
-
- my (@supported) = split /\,/, access_cfg('dgit-tag-format');
- printdebug "select_tagformat supported @supported\n";
-
- $tagformat //= [ $supported[0], "distro access configuration", 0 ];
- printdebug "select_tagformat specified @$tagformat\n";
-
- my ($fmt,$why,$override) = @$tagformat;
-
- fail "target distro supports tag formats @supported".
- " but have to use $fmt ($why)"
- unless $override
- or grep { $_ eq $fmt } @supported;
-
- $tagformat = undef;
- $tagformatfn = ${*::}{"debiantag_$fmt"};
-
- fail "trying to use unknown tag format \`$fmt' ($why) !"
- unless $tagformatfn;
-}
-
-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) {
+ 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');
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 $!;
Last allegedly pushed/uploaded: $oversion (newer or same)
$later_warning_msg
END
- $outputhash = $lastpush_hash;
+ @output = $lastpush_mergeinput;
} else {
- $outputhash = $lastpush_hash;
+ @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,
+ my @specs =
map { "+refs/$_/*:".lrfetchrefs."/$_/*" }
- qw(tags heads);
+ qw(tags heads), $branchprefix;
runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(), @specs;
my %here;
});
}
+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
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",
+ };
+
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 $!;
Last allegedly pushed/uploaded: $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.
}
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";
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;
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 $!;
my $dscfn = dscfn($cversion);
- return ($clogp, $cversion, $tag, $dscfn);
+ return ($clogp, $cversion, $dscfn);
}
sub push_parse_dsc ($$$) {
" but debian/changelog is for $package $cversion";
}
-sub push_mktag ($$$$$$$) {
- my ($head,$clogp,$tag,
- $dscfn,
+sub push_tagwants ($$$$) {
+ my ($cversion, $dgithead, $maintviewhead, $tfbase) = @_;
+ my @tagwants;
+ push @tagwants, {
+ TagFn => \&debiantag,
+ Objid => $dgithead,
+ TfSuffix => '',
+ View => 'dgit',
+ };
+ if (defined $maintviewhead) {
+ push @tagwants, {
+ TagFn => \&debiantag_maintview,
+ Objid => $maintviewhead,
+ TfSuffix => '-maintview',
+ View => 'maint',
+ };
+ }
+ foreach my $tw (@tagwants) {
+ $tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro);
+ $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };
+ }
+ return @tagwants;
+}
+
+sub push_mktags ($$ $$ $) {
+ my ($clogp,$dscfn,
$changesfile,$changesfilewhat,
- $tfn) = @_;
+ $tagwants) = @_;
- $dsc->{$ourdscfield[0]} = $head;
+ die unless $tagwants->[0]{View} eq 'dgit';
+
+ $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid};
$dsc->save("$dscfn.tmp") or die $!;
my $changes = parsecontrol($changesfile,$changesfilewhat);
my $authline = clogp_authline $clogp;
my $delibs = join(" ", "",@deliberatelies);
my $declaredistro = access_basedistro();
- open TO, '>', $tfn->('.tmp') or die $!;
- print TO <<END or die $!;
+
+ my $mktag = sub {
+ my ($tw) = @_;
+ my $tfn = $tw->{Tfn};
+ my $head = $tw->{Objid};
+ my $tag = $tw->{Tag};
+
+ open TO, '>', $tfn->('.tmp') or die $!;
+ print TO <<END or die $!;
object $head
type commit
tag $tag
tagger $authline
+END
+ if ($tw->{View} eq 'dgit') {
+ print TO <<END or die $!;
$package release $cversion for $clogsuite ($csuite) [dgit]
[dgit distro=$declaredistro$delibs]
END
- foreach my $ref (sort keys %previously) {
- print TO <<END or die $!;
+ foreach my $ref (sort keys %previously) {
+ print TO <<END or die $!;
[dgit previously:$ref=$previously{$ref}]
END
- }
+ }
+ } elsif ($tw->{View} eq 'maint') {
+ print TO <<END or die $!;
+$package release $cversion for $clogsuite ($csuite)
+(maintainer view tag generated by dgit --quilt=$quilt_mode)
+END
+ } else {
+ die Dumper($tw)."?";
+ }
- close TO or die $!;
+ close TO or die $!;
- my $tagobjfn = $tfn->('.tmp');
- if ($sign) {
- if (!defined $keyid) {
- $keyid = access_cfg('keyid','RETURN-UNDEF');
- }
- if (!defined $keyid) {
- $keyid = getfield $clogp, 'Maintainer';
- }
- unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
- my @sign_cmd = (@gpg, qw(--detach-sign --armor));
- push @sign_cmd, qw(-u),$keyid if defined $keyid;
- push @sign_cmd, $tfn->('.tmp');
- runcmd_ordryrun @sign_cmd;
- if (act_scary()) {
- $tagobjfn = $tfn->('.signed.tmp');
- runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
- $tfn->('.tmp'), $tfn->('.tmp.asc');
+ my $tagobjfn = $tfn->('.tmp');
+ if ($sign) {
+ if (!defined $keyid) {
+ $keyid = access_cfg('keyid','RETURN-UNDEF');
+ }
+ if (!defined $keyid) {
+ $keyid = getfield $clogp, 'Maintainer';
+ }
+ unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
+ my @sign_cmd = (@gpg, qw(--detach-sign --armor));
+ push @sign_cmd, qw(-u),$keyid if defined $keyid;
+ push @sign_cmd, $tfn->('.tmp');
+ runcmd_ordryrun @sign_cmd;
+ if (act_scary()) {
+ $tagobjfn = $tfn->('.signed.tmp');
+ runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
+ $tfn->('.tmp'), $tfn->('.tmp.asc');
+ }
}
- }
+ return $tagobjfn;
+ };
- return ($tagobjfn);
+ my @r = map { $mktag->($_); } @$tagwants;
+ return @r;
}
sub sign_changes ($) {
Push failed, while preparing your push.
You can retry the push, after fixing the problem, if you like.
END
+
+ need_tagformat 'new', "quilt mode $quilt_mode"
+ if quiltmode_splitbrain;
+
prep_ud();
access_giturl(); # check that success is vaguely likely
responder_send_file('parsed-changelog', $clogpfn);
- my ($clogp, $cversion, $tag, $dscfn) =
+ my ($clogp, $cversion, $dscfn) =
push_parse_changelog("$clogpfn");
my $dscpath = "$buildproductsdir/$dscfn";
my $format = getfield $dsc, 'Format';
printdebug "format $format\n";
- my $head = git_rev_parse('HEAD');
+ my $actualhead = git_rev_parse('HEAD');
+ my $dgithead = $actualhead;
+ my $maintviewhead = undef;
if (madformat($format)) {
# user might have not used dgit build, so maybe do this now:
changedir $ud;
quilt_make_fake_dsc($upstreamversion);
my ($dgitview, $cachekey) =
- quilt_check_splitbrain_cache($head, $upstreamversion);
+ quilt_check_splitbrain_cache($actualhead, $upstreamversion);
$dgitview or fail
"--quilt=$quilt_mode but no cached dgit view:
perhaps tree changed since dgit build[-source] ?";
$split_brain = 1;
+ $dgithead = $dgitview;
+ $maintviewhead = $actualhead;
changedir '../../../..';
prep_ud(); # so _only_subdir() works, below
} else {
}
}
- die 'xxx fast forward (should not depend on quilt mode, but will always be needed if we did $split_brain)' if $split_brain;
-
check_not_dirty();
changedir $ud;
progress "checking that $dscfn corresponds to HEAD";
check_for_vendor_patches() if madformat($dsc->{format});
changedir '../../../..';
my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet';
- my @diffcmd = (@git, qw(diff), $diffopt, $tree);
+ my @diffcmd = (@git, qw(diff), $diffopt, $tree, $dgithead);
debugcmd "+",@diffcmd;
$!=0; $?=-1;
my $r = system @diffcmd;
}
responder_send_file('changes',$changesfile);
- responder_send_command("param head $head");
+ responder_send_command("param head $dgithead");
responder_send_command("param csuite $csuite");
+ responder_send_command("param tagformat $tagformat");
+ if (quiltmode_splitbrain) {
+ die unless ($protovsn//4) >= 4;
+ responder_send_command("param maint-view $maintviewhead");
+ }
if (deliberately_not_fast_forward) {
git_for_each_ref(lrfetchrefs, sub {
});
}
- my $tfn = sub { ".git/dgit/tag$_[0]"; };
- my $tagobjfn;
+ my @tagwants = push_tagwants($cversion, $dgithead, $maintviewhead,
+ ".git/dgit/tag");
+ my @tagobjfns;
supplementary_message(<<'END');
Push failed, while signing the tag.
END
# If we manage to sign but fail to record it anywhere, it's fine.
if ($we_are_responder) {
- $tagobjfn = $tfn->('.signed.tmp');
- responder_receive_files('signed-tag', $tagobjfn);
+ @tagobjfns = map { $_->{Tfn}('.signed-tmp') } @tagwants;
+ responder_receive_files('signed-tag', @tagobjfns);
} else {
- $tagobjfn =
- push_mktag($head,$clogp,$tag,
- $dscpath,
- $changesfile,$changesfile,
- $tfn);
+ @tagobjfns = push_mktags($clogp,$dscpath,
+ $changesfile,$changesfile,
+ \@tagwants);
}
supplementary_message(<<'END');
Push failed, *after* signing the tag.
If you want to try again, you should use a new version number.
END
- my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
- runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
- runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
+ pairwise { $a->{TagObjFn} = $b } @tagwants, @tagobjfns;
+
+ foreach my $tw (@tagwants) {
+ my $tag = $tw->{Tag};
+ my $tagobjfn = $tw->{TagObjFn};
+ my $tag_obj_hash =
+ cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
+ runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
+ runcmd_ordryrun_local
+ @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
+ }
supplementary_message(<<'END');
Push failed, while updating the remote git repository - see messages above.
if (!check_for_git()) {
create_remote_git_repo();
}
- runcmd_ordryrun @git, qw(push),access_giturl(),
- $forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag";
- runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
+
+ my @pushrefs = $forceflag."HEAD:".rrref();
+ foreach my $tw (@tagwants) {
+ my $view = $tw->{View};
+ next unless $view eq 'dgit'
+ or any { $_ eq $view } access_cfg_tagformats();
+ push @pushrefs, $forceflag."refs/tags/$tw->{Tag}";
+ }
+
+ runcmd_ordryrun @git, qw(push),access_giturl(), @pushrefs;
+ runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead;
supplementary_message(<<'END');
Push failed, after updating the remote git repository.
sub rpush_handle_protovsn_bothends () {
if ($protovsn < 4) {
- fail "rpush negotiated protocol version $protovsn".
- " which supports old tag format only".
- " but trying to use new format (".$tagformat->[1].")"
- if $tagformat && $tagformat->[0] ne 'old';
- $tagformat = ['old', "rpush negotiated protocol $protovsn", 0];
+ need_tagformat 'old', "rpush negotiated protocol $protovsn";
}
select_tagformat();
}
($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ };
die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support;
$supplementary_message = '' unless $protovsn >= 3;
+
+ fail "rpush negotiated protocol version $protovsn".
+ " which does not support quilt mode $quilt_mode"
+ if quiltmode_splitbrain;
+
rpush_handle_protovsn_bothends();
for (;;) {
my ($icmd,$iargs) = initiator_expect {
print RI "files-end\n" or die $!;
}
-our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn);
+our ($i_clogp, $i_version, $i_dscfn, $i_changesfn);
sub i_localname_parsed_changelog {
return "remote-changelog.822";
}
sub i_file_parsed_changelog {
- ($i_clogp, $i_version, $i_tag, $i_dscfn) =
+ ($i_clogp, $i_version, $i_dscfn) =
push_parse_changelog "$i_tmp/remote-changelog.822";
die if $i_dscfn =~ m#/|^\W#;
}
my $head = $i_param{'head'};
die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+ my $maintview = $i_param{'maint-view'};
+ die if defined $maintview && $maintview =~ m/[^0-9a-f]/;
+
+ select_tagformat();
+ if ($protovsn >= 4) {
+ my $p = $i_param{'tagformat'} // '<undef>';
+ $p eq $tagformat
+ or badproto \*RO, "tag format mismatch: $p vs. $tagformat";
+ }
+
die unless $i_param{'csuite'} =~ m/^$suite_re$/;
$csuite = $&;
push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
- my $tagobjfn =
- push_mktag $head, $i_clogp, $i_tag,
- $i_dscfn,
- $i_changesfn, 'remote changes',
- sub { "tag$_[0]"; };
+ my @tagwants = push_tagwants $i_version, $head, $maintview, "tag";
- return $tagobjfn;
+ return
+ push_mktags $i_clogp, $i_dscfn,
+ $i_changesfn, 'remote changes',
+ \@tagwants;
}
sub i_want_signed_dsc_changes {
} elsif (m/^--dgit-tag-format=(old|new)$/s) {
# undocumented, for testing
push @ropts, $_;
- $tagformat = [ $1, 'command line', 1 ];
+ $tagformat_want = [ $1, 'command line', 1 ];
# 1 menas overrides distro configuration
} elsif (m/^--always-split-source-build$/s) {
# undocumented, for testing
~ianmdlvl / dgit.git / blobdiff