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';
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',
die 'bug' if $tagformatfn && $tagformat_want;
# ... $tagformat_want assigned after previous select_tagformat
- my (@supported) = access_cfg_tagformats();
+ my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats();
printdebug "select_tagformat supported @supported\n";
$tagformat_want //= [ $supported[0], "distro access configuration", 0 ];
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) {
+ 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 $!;
" but debian/changelog is for $package $cversion";
}
-sub push_tagwants ($$$) {
- my ($cversion, $dgithead, $tfbase) = @_;
+sub push_tagwants ($$$$) {
+ my ($cversion, $dgithead, $maintviewhead, $tfbase) = @_;
my @tagwants;
push @tagwants, {
TagFn => \&debiantag,
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]; };
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 $!;
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
}
}
- 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";
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 @tagwants = push_tagwants($cversion, $dgithead,
+ my @tagwants = push_tagwants($cversion, $dgithead, $maintviewhead,
".git/dgit/tag");
my @tagobjfns;
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}";
}
($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 {
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>';
$csuite = $&;
push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
- my @tagwants = push_tagwants $i_version, $head, "tag";
+ my @tagwants = push_tagwants $i_version, $head, $maintview, "tag";
return
push_mktags $i_clogp, $i_dscfn,
~ianmdlvl / dgit.git / blobdiff