TODO.BRANCH: Synthetic ff is not to do with $tag, really

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 4aefa085a6b3835d16384b1a218ff5cf18f0cf73..53ccd724b821a9dcd59355f08011ff804f4951d7 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -34,12 +34,14 @@ use POSIX;
 use IPC::Open2;
 use Digest::SHA;
 use Digest::MD5;
 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###
 
 
 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 $protovsn;
 
 our $isuite = 'unstable';


@@ -140,6 +142,12 @@ sub debiantag ($$) {
     return $tagformatfn->($v, $distro);
 }
 
     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 lbranch () { return "$branchprefix/$csuite"; }
 my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$';
 sub lref () { return "refs/heads/".lbranch(); }


@@ -244,9 +252,10 @@ sub quiltmode_splitbrain () {
 #  > file changes
 #  [etc]
 #
 #  > file changes
 #  [etc]
 #

-#  > param head HEAD
+#  > param head DGIT-VIEW-HEAD

 #  > param csuite SUITE
 #  > param tagformat old|new
 #  > 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
 #
 #  > previously REFNAME=OBJNAME       # if --deliberately-not-fast-forward
 #                                     # goes into tag, for replay prevention


@@ -505,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.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',
               'dgit-distro.debian.archive-query' => 'ftpmasterapi:',
               'dgit-distro.debian.git-check' => 'url',
               'dgit-distro.debian.git-check-suffix' => '/info/refs',


@@ -1132,6 +1141,48 @@ sub archive_query_dummycat ($$) {
     return sort { -version_compare($a->[0],$b->[0]); } @rows;
 }
 
     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 () {
 #---------- archive query entrypoints and rest of program ----------
 
 sub canonicalise_suite () {


@@ -1241,33 +1292,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;
-    $tagformat = $fmt;
-    $tagformatfn = ${*::}{"debiantag_$fmt"};
-
-    fail "trying to use unknown tag format \`$fmt' ($why) !"
-       unless $tagformatfn;
-}
-

 our ($dsc_hash,$lastpush_hash);
 
 our $ud = '.git/dgit/unpack';
 our ($dsc_hash,$lastpush_hash);
 
 our $ud = '.git/dgit/unpack';


@@ -1927,7 +1951,7 @@ sub push_parse_changelog ($) {
 
     my $dscfn = dscfn($cversion);
 
 
     my $dscfn = dscfn($cversion);
 

-    return ($clogp, $cversion, $tag, $dscfn);
+    return ($clogp, $cversion, $dscfn);

 }
 
 sub push_parse_dsc ($$$) {
 }
 
 sub push_parse_dsc ($$$) {


@@ -1940,13 +1964,38 @@ sub push_parse_dsc ($$$) {
            " but debian/changelog is for $package $cversion";
 }
 
            " but debian/changelog is for $package $cversion";
 }
 

-sub push_mktag ($$$$$$$) {
-    my ($dgithead,$clogp,$dgittag,
-       $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,
        $changesfile,$changesfilewhat,

-       $tfnbase) = @_;
+        $tagwants) = @_;
+
+    die unless $tagwants->[0]{View} eq 'dgit';

 
 

-    $dsc->{$ourdscfield[0]} = $dgithead;
+    $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid};

     $dsc->save("$dscfn.tmp") or die $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);
     $dsc->save("$dscfn.tmp") or die $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);


@@ -1966,7 +2015,10 @@ sub push_mktag ($$$$$$$) {
     my $declaredistro = access_basedistro();
 
     my $mktag = sub {
     my $declaredistro = access_basedistro();
 
     my $mktag = sub {

-       my ($tfn, $head, $tag) = @_;
+       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 $!;
 
        open TO, '>', $tfn->('.tmp') or die $!;
        print TO <<END or die $!;


@@ -1975,13 +2027,24 @@ type commit
 tag $tag
 tagger $authline
 
 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
 $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
 [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 $!;


@@ -2008,8 +2071,7 @@ END
        return $tagobjfn;
     };
 
        return $tagobjfn;
     };
 

-    my @r;
-    push @r, $mktag->($tfnbase, $dgithead, $dgittag);
+    my @r = map { $mktag->($_); } @$tagwants;

     return @r;
 }
 
     return @r;
 }
 


@@ -2031,6 +2093,10 @@ sub dopush ($) {
 Push failed, while preparing your push.
 You can retry the push, after fixing the problem, if you like.
 END
 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
     prep_ud();
 
     access_giturl(); # check that success is vaguely likely


@@ -2041,7 +2107,7 @@ END
 
     responder_send_file('parsed-changelog', $clogpfn);
 
 
     responder_send_file('parsed-changelog', $clogpfn);
 

-    my ($clogp, $cversion, $tag, $dscfn) =
+    my ($clogp, $cversion, $dscfn) =

        push_parse_changelog("$clogpfn");
 
     my $dscpath = "$buildproductsdir/$dscfn";
        push_parse_changelog("$clogpfn");
 
     my $dscpath = "$buildproductsdir/$dscfn";


@@ -2056,7 +2122,9 @@ END
     my $format = getfield $dsc, 'Format';
     printdebug "format $format\n";
 
     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:
 
     if (madformat($format)) {
        # user might have not used dgit build, so maybe do this now:


@@ -2066,11 +2134,13 @@ END
            changedir $ud;
            quilt_make_fake_dsc($upstreamversion);
            my ($dgitview, $cachekey) =
            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;
            $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 {
            changedir '../../../..';
            prep_ud(); # so _only_subdir() works, below
        } else {


@@ -2078,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";
     check_not_dirty();
     changedir $ud;
     progress "checking that $dscfn corresponds to HEAD";


@@ -2089,7 +2157,7 @@ END
     check_for_vendor_patches() if madformat($dsc->{format});
     changedir '../../../..';
     my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet';
     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;
     debugcmd "+",@diffcmd;
     $!=0; $?=-1;
     my $r = system @diffcmd;


@@ -2116,9 +2184,13 @@ END
     }
 
     responder_send_file('changes',$changesfile);
     }
 
     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");
     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 {
 
     if (deliberately_not_fast_forward) {
        git_for_each_ref(lrfetchrefs, sub {


@@ -2129,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.
 
     supplementary_message(<<'END');
 Push failed, while signing the tag.


@@ -2138,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) {
 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 {
     } 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
 
     }
     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.
 
     supplementary_message(<<'END');
 Push failed, while updating the remote git repository - see messages above.


@@ -2163,9 +2242,17 @@ END
     if (!check_for_git()) {
        create_remote_git_repo();
     }
     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.
 
     supplementary_message(<<'END');
 Push failed, after updating the remote git repository.


@@ -2392,11 +2479,7 @@ sub cmd_remote_push_responder { cmd_remote_push_build_host(); }
 
 sub rpush_handle_protovsn_bothends () {
     if ($protovsn < 4) {
 
 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();
 }
     }
     select_tagformat();
 }


@@ -2459,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;
     ($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 {
     rpush_handle_protovsn_bothends();
     for (;;) {
        my ($icmd,$iargs) = initiator_expect {


@@ -2531,13 +2619,13 @@ sub i_resp_want ($) {
     print RI "files-end\n" or die $!;
 }
 
     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 {
 
 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#;
 }
        push_parse_changelog "$i_tmp/remote-changelog.822";
     die if $i_dscfn =~ m#/|^\W#;
 }


@@ -2564,6 +2652,9 @@ sub i_want_signed_tag {
     my $head = $i_param{'head'};
     die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
 
     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>';
     select_tagformat();
     if ($protovsn >= 4) {
        my $p = $i_param{'tagformat'} // '<undef>';


@@ -2575,13 +2666,12 @@ sub i_want_signed_tag {
     $csuite = $&;
     push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
 
     $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 {
 }
 
 sub i_want_signed_dsc_changes {