X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=9127ff694d4f9a87aa55ae67d4a369832638f210;hb=26794272ebaac24b6e13795d0dfdeed35ec9e575;hp=65e8666cf3b2a4573918dfb8a98e6cf0eb02f067;hpb=11139d3b482e1503263833230a85b7fc1729895a;p=dgit.git

diff --git a/dgit b/dgit
index 65e8666c..9127ff69 100755
--- a/dgit
+++ b/dgit
@@ -34,6 +34,7 @@ use POSIX;
 use IPC::Open2;
 use Digest::SHA;
 use Digest::MD5;
+use List::MoreUtils qw(pairwise);
 
 use Debian::Dgit;
 
@@ -66,6 +67,7 @@ our $we_are_responder;
 our $initiator_tempdir;
 our $patches_applied_dirtily = 00;
 our $tagformat_want;
+our $tagformat;
 our $tagformatfn;
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
@@ -245,6 +247,7 @@ sub quiltmode_splitbrain () {
 #
 #  > param head HEAD
 #  > param csuite SUITE
+#  > param tagformat old|new
 #
 #  > previously REFNAME=OBJNAME       # if --deliberately-not-fast-forward
 #                                     # goes into tag, for replay prevention
@@ -1130,6 +1133,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) = 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 +1284,6 @@ sub create_remote_git_repo () {
     }
 }
 
-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) = split /\,/, access_cfg('dgit-tag-format');
-    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;
-    $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 +1943,7 @@ sub push_parse_changelog ($) {
 
     my $dscfn = dscfn($cversion);
 
-    return ($clogp, $cversion, $tag, $dscfn);
+    return ($clogp, $cversion, $dscfn);
 }
 
 sub push_parse_dsc ($$$) {
@@ -1937,13 +1956,30 @@ 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, $tfbase) = @_;
+    my @tagwants;
+    push @tagwants, {
+        TagFn => \&debiantag,
+	Objid => $dgithead,
+        TfSuffix => '',
+        View => 'dgit',
+    };
+    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,8 +1997,15 @@ sub push_mktag ($$$$$$$) {
     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
@@ -1971,35 +2014,38 @@ tagger $authline
 $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
-    }
+	}
 
-    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 ($) {
@@ -2030,7 +2076,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";
@@ -2107,6 +2153,7 @@ END
     responder_send_file('changes',$changesfile);
     responder_send_command("param head $head");
     responder_send_command("param csuite $csuite");
+    responder_send_command("param tagformat $tagformat");
 
     if (deliberately_not_fast_forward) {
 	git_for_each_ref(lrfetchrefs, sub {
@@ -2117,8 +2164,9 @@ END
 	});
     }
 
-    my $tfn = sub { ".git/dgit/tag$_[0]"; };
-    my $tagobjfn;
+    my @tagwants = push_tagwants($cversion, $head,
+				 ".git/dgit/tag");
+    my @tagobjfns;
 
     supplementary_message(<<'END');
 Push failed, while signing the tag.
@@ -2126,23 +2174,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,8 +2205,13 @@ END
     if (!check_for_git()) {
 	create_remote_git_repo();
     }
-    runcmd_ordryrun @git, qw(push),access_giturl(),
-        $forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag";
+
+    my @pushrefs = $forceflag."HEAD:".rrref();
+    foreach my $tw (@tagwants) {
+	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(), 'HEAD';
 
     supplementary_message(<<'END');
@@ -2380,11 +2439,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_want->[1].")"
-	    if $tagformat_want && $tagformat_want->[0] ne 'old';
-	$tagformat_want = ['old', "rpush negotiated protocol $protovsn", 0];
+	need_tagformat 'old', "rpush negotiated protocol $protovsn";
     }
     select_tagformat();
 }
@@ -2519,13 +2574,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 +2607,23 @@ sub i_want_signed_tag {
     my $head = $i_param{'head'};
     die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
 
+    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, "tag";
 
-    return $tagobjfn;
+    return
+	push_mktags $i_clogp, $i_dscfn,
+	    $i_changesfn, 'remote changes',
+	    \@tagwants;
 }
 
 sub i_want_signed_dsc_changes {