chiark / gitweb /
Test suite: examplegit setup script
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 7306d7d1214abfa0fa8216c21387fd962e164260..53ccd724b821a9dcd59355f08011ff804f4951d7 100755 (executable)
--- 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(3 2); # 4 is new tag format
 our $protovsn;
 
 our $isuite = 'unstable';
@@ -140,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(); }
@@ -244,9 +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
@@ -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.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',
@@ -1138,13 +1147,22 @@ 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();
+    my (@supported) = grep { $_ ne 'maint' } access_cfg_tagformats();
     printdebug "select_tagformat supported @supported\n";
 
     $tagformat_want //= [ $supported[0], "distro access configuration", 0 ];
@@ -1933,7 +1951,7 @@ sub push_parse_changelog ($) {
 
     my $dscfn = dscfn($cversion);
 
-    return ($clogp, $cversion, $tag, $dscfn);
+    return ($clogp, $cversion, $dscfn);
 }
 
 sub push_parse_dsc ($$$) {
@@ -1946,13 +1964,38 @@ sub push_parse_dsc ($$$) {
            " 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,
-       $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);
@@ -1972,7 +2015,10 @@ sub push_mktag ($$$$$$$) {
     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 $!;
@@ -1981,13 +2027,24 @@ 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 $!;
@@ -2014,8 +2071,7 @@ END
        return $tagobjfn;
     };
 
-    my @r;
-    push @r, $mktag->($tfnbase, $dgithead, $dgittag);
+    my @r = map { $mktag->($_); } @$tagwants;
     return @r;
 }
 
@@ -2037,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
@@ -2047,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";
@@ -2062,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:
@@ -2072,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 {
@@ -2084,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";
@@ -2095,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;
@@ -2122,9 +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 {
@@ -2135,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.
@@ -2144,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.
@@ -2169,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.
@@ -2398,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_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();
 }
@@ -2465,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 {
@@ -2537,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#;
 }
@@ -2570,6 +2652,9 @@ 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'} // '<undef>';
@@ -2581,13 +2666,12 @@ sub i_want_signed_tag {
     $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 {