X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=53ccd724b821a9dcd59355f08011ff804f4951d7;hp=bf0d6398431340e1ff53feea1e478e472f75bb39;hb=4148272808e1c37f1077aa6a42e6057378730fa3;hpb=ee802f8a6760c88b641f05d4dee51439a9a42c96 diff --git a/dgit b/dgit index bf0d6398..53ccd724 100755 --- a/dgit +++ b/dgit @@ -34,12 +34,14 @@ use POSIX; 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'; @@ -65,6 +67,7 @@ our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|unapplied'; our $we_are_responder; our $initiator_tempdir; our $patches_applied_dirtily = 00; +our $tagformat_want; our $tagformat; our $tagformatfn; @@ -139,6 +142,12 @@ sub debiantag ($$) { 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(); } @@ -243,8 +252,10 @@ sub quiltmode_splitbrain () { # > 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 @@ -503,7 +514,7 @@ our %defcfg = ('dgit.default.distro' => 'debian', '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', @@ -1130,6 +1141,48 @@ sub archive_query_dummycat ($$) { 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 () { @@ -1239,32 +1292,6 @@ sub create_remote_git_repo () { } } -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 $ud = '.git/dgit/unpack'; @@ -1924,7 +1951,7 @@ sub push_parse_changelog ($) { my $dscfn = dscfn($cversion); - return ($clogp, $cversion, $tag, $dscfn); + return ($clogp, $cversion, $dscfn); } sub push_parse_dsc ($$$) { @@ -1937,13 +1964,38 @@ 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) = @_; + + die unless $tagwants->[0]{View} eq 'dgit'; - $dsc->{$ourdscfield[0]} = $head; + $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid}; $dsc->save("$dscfn.tmp") or die $!; my $changes = parsecontrol($changesfile,$changesfilewhat); @@ -1961,45 +2013,66 @@ sub push_mktag ($$$$$$$) { my $authline = clogp_authline $clogp; my $delibs = join(" ", "",@deliberatelies); my $declaredistro = access_basedistro(); - open TO, '>', $tfn->('.tmp') or die $!; - print TO <{Tfn}; + my $head = $tw->{Objid}; + my $tag = $tw->{Tag}; + + open TO, '>', $tfn->('.tmp') or die $!; + print TO <{View} eq 'dgit') { + print TO <{View} eq 'maint') { + print TO <('.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 ($) { @@ -2020,6 +2093,10 @@ sub dopush ($) { 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 @@ -2030,7 +2107,7 @@ END responder_send_file('parsed-changelog', $clogpfn); - my ($clogp, $cversion, $tag, $dscfn) = + my ($clogp, $cversion, $dscfn) = push_parse_changelog("$clogpfn"); my $dscpath = "$buildproductsdir/$dscfn"; @@ -2045,7 +2122,9 @@ END 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: @@ -2055,11 +2134,13 @@ END 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 { @@ -2067,8 +2148,6 @@ END } } - 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"; @@ -2078,7 +2157,7 @@ END 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; @@ -2105,8 +2184,13 @@ END } 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 { @@ -2117,8 +2201,9 @@ END }); } - 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. @@ -2126,23 +2211,29 @@ You can retry the push, after fixing the problem, if you like. 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. @@ -2151,9 +2242,17 @@ END 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. @@ -2380,11 +2479,7 @@ sub cmd_remote_push_responder { cmd_remote_push_build_host(); } 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(); } @@ -2447,6 +2542,11 @@ sub cmd_rpush { ($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 { @@ -2519,13 +2619,13 @@ sub i_resp_want ($) { 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#; } @@ -2552,17 +2652,26 @@ sub i_want_signed_tag { 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'} // ''; + $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 { @@ -3844,7 +3953,7 @@ sub parseopts () { } 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