chiark / gitweb /
git-debrebase: bomb on totally ambiguous pseudomerges
[dgit.git] / git-debrebase
index 11a1896217e10ef51a1288d99c647904f3a5817d..b69450baaa4f952463e6bbcb925ad0be6a0788e1 100755 (executable)
 #
 #    git-debrebase [<options> --] [<git-rebase options...>]
 #    git-debrebase [<options>] analyse
+#    git-debrebase [<options>] breakwater      # prints breakwater tip only
 #    git-debrebase [<options>] launder         # prints breakwater tip etc.
+#    git-debrebase [<options>] stitch [--prose=<for commit message>]
 #    git-debrebase [<options>] downstream-rebase-launder-v0  # experimental
 #
-#    git-debrebase [<options>] gbp2debrebase-v0 \
-#             <upstream>
+#    git-debrebase [<options>] convert-from-gbp [<upstream-git-rev>]
+#    git-debrebase [<options>] convert-to-gbp
 
 # problems / outstanding questions:
 #
@@ -87,21 +89,28 @@ use POSIX;
 use Data::Dumper;
 use Getopt::Long qw(:config posix_default gnu_compat bundling);
 use Dpkg::Version;
+use File::FnMatch qw(:fnmatch);
 
-our ($opt_force);
+our ($opt_force, $opt_noop_ok);
+
+our $us = qw(git-debrebase);
 
 sub badusage ($) {
     my ($m) = @_;
     die "bad usage: $m\n";
 }
 
-sub cfg ($) {
-    my ($k) = @_;
-    $/ = "\0";
+sub cfg ($;$) {
+    my ($k, $optional) = @_;
+    local $/ = "\0";
     my @cmd = qw(git config -z);
     push @cmd, qw(--get-all) if wantarray;
     push @cmd, $k;
-    my $out = cmdoutput @cmd;
+    my $out = cmdoutput_errok @cmd;
+    if (!defined $out) {
+       fail "missing required git config $k" unless $optional;
+       return ();
+    }
     return split /\0/, $out;
 }
 
@@ -252,27 +261,40 @@ sub make_commit ($$) {
     return cmdoutput @cmd;
 }
 
-our $fproblems;
+our @fproblem_force_opts;
+our $fproblems_forced;
+our $fproblems_tripped;
 sub fproblem ($$) {
     my ($tag,$msg) = @_;
-    $fproblems++;
-    print STDERR "git-debrebase: safety catch tripped: $msg\n";
+    if (grep { $_ eq $tag } @fproblem_force_opts) {
+       $fproblems_forced++;
+       print STDERR "git-debrebase: safety catch overridden (-f$tag): $msg\n";
+    } else {
+       $fproblems_tripped++;
+       print STDERR "git-debrebase: safety catch tripped (-f$tag): $msg\n";
+    }
 }
+
 sub fproblems_maybe_bail () {
-    if ($fproblems) {
+    if ($fproblems_forced) {
+       printf STDERR
+           "%s: safety catch trips: %d overriden by individual -f options\n",
+           $us, $fproblems_forced;
+    }
+    if ($fproblems_tripped) {
        if ($opt_force) {
            printf STDERR
-               "safety catch trips (%d) overriden by --force\n",
-               $fproblems;
+               "%s: safety catch trips: %d overriden by global --force\n",
+               $us, $fproblems_tripped;
        } else {
            fail sprintf
-               "safety catch trips (%d) (you could --force)",
-               $fproblems;
+  "%s: safety catch trips: %d blockers (you could -f<tag>, or --force)",
+               $us, $fproblems_tripped;
        }
     }
 }
 sub any_fproblems () {
-    return !!$fproblems;
+    return $fproblems_forced || $fproblems_tripped;
 }
 
 # classify returns an info hash like this
@@ -297,7 +319,6 @@ sub any_fproblems () {
 #   Upstream
 #   AddPatches
 #   Mixed
-#   Unknown
 #
 #   Pseudomerge
 #     has additional entres in classification result
@@ -311,6 +332,10 @@ sub any_fproblems () {
 #   BreakwaterUpstreamMerge
 #     has additional entry in classification result
 #       OrigParents = [ subset of Parents ]  # singleton list
+#
+#   Unknown
+#     has additional entry in classification result
+#       Why => "prose"
 
 sub parsecommit ($;$) {
     my ($objid, $p_ref) = @_;
@@ -369,7 +394,7 @@ sub classify ($) {
     };
     my $unknown = sub {
        my ($why) = @_;
-       $r = { %$r, Type => qw(Unknown) };
+       $r = { %$r, Type => qw(Unknown), Why => $why };
        printdebug " ** Unknown\n";
        return $r;
     };
@@ -421,19 +446,27 @@ sub classify ($) {
        my @overwritten = grep { $_->{Differs} } @p;
        confess "internal error $objid ?" unless @overwritten==1;
        return $classify->(qw(Pseudomerge),
-                          Overwritten => $overwritten[0],
+                          Overwritten => [ $overwritten[0] ],
                           Contributor => $identical[0]);
     }
     if (@p == 2 && @identical == 2) {
-       my @bytime = nsort_by {
-           my ($ph,$pm) = get_commit $_->{CommitId};
+       my $get_t = sub {
+           my ($ph,$pm) = get_commit $_[0]{CommitId};
            $ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
            $1;
-       } @p;
+       };
+       my @bytime = @p;
+       my $order = $get_t->($bytime[0]) <=> $get_t->($bytime[1]);
+       if ($order > 0) { # newer first
+       } elsif ($order < 0) {
+           @bytime = reverse @bytime;
+       } else {
+           return $unknown->('merge of two identical same-age parents');
+       }
        return $classify->(qw(Pseudomerge),
                           SubType => qw(Ambiguous),
-                          Overwritten => $bytime[0],
-                          Contributor => $bytime[1]);
+                          Contributor => $bytime[0],
+                          Overwritten => [ $bytime[1] ]);
     }
     foreach my $p (@p) {
        my ($p_h, $p_m) = get_commit $p->{CommitId};
@@ -485,6 +518,42 @@ sub classify ($) {
     return $unknown->("complex merge");
 }
 
+sub breakwater_of ($) {
+    my ($head) = @_; # must be laundered
+    my $breakwater;
+    my $unclean = sub {
+       my ($why) = @_;
+       fail "branch needs laundering (run git-debrebase): $why";
+    };
+    for (;;) {
+       my $cl = classify $head;
+       my $ty = $cl->{Type};
+       if ($ty eq 'Packaging' or
+           $ty eq 'Changelog') {
+           $breakwater //= $head;
+       } elsif ($ty eq 'BreakwaterUpstreamMerge' or
+                $ty eq 'BreakwaterStart') {
+           $breakwater //= $head;
+           last;
+       } elsif ($ty eq 'Upstream') {
+           $unclean->("packaging change ($breakwater)".
+                      " follows upstream change (eg $head)")
+               if defined $breakwater;
+       } elsif ($ty eq 'Mixed') {
+           $unclean->('found mixed upstream/packaging commit ($head)');
+       } elsif ($ty eq 'Pseudomerge' or
+                $ty eq 'AddPatches') {
+           $unclean->("found interchange conversion commit ($ty, $head)");
+       } elsif ($ty eq 'DgitImportUnpatched') {
+           $unclean->("found dgit dsc import ($head)");
+       } else {
+           fail "found unprocessable commit, cannot cope: $head; $cl->{Why}";
+       }
+       $head = $cl->{Parents}[0]{CommitId};
+    }
+    return $breakwater;
+}
+
 sub walk ($;$$);
 sub walk ($;$$) {
     my ($input,
@@ -606,7 +675,8 @@ sub walk ($;$$) {
                # suite intended by the non-dgit NMUer, and later
                # pseudomerges may represent in-archive copies.
                my $ovwrs = $pm->{Overwritten};
-               printf $report " PM=%s \@Overwr:%d", $pm, (scalar @$ovwrs)
+               printf $report " PM=%s \@Overwr:%d",
+                   $pm->{CommitId}, (scalar @$ovwrs)
                    if $report;
                if (@$ovwrs != 1) {
                     printdebug "*** WALK BOMB DgitImportUnpatched\n";
@@ -629,26 +699,15 @@ sub walk ($;$$) {
                    %$cl,
                    SpecialMethod => 'DgitImportDebianUpdate',
                     $xmsg->("convert dgit import: debian changes")
+               }, {
+                   %$cl,
+                   SpecialMethod => 'DgitImportUpstreamUpdate',
+                    $xmsg->("convert dgit import: upstream update",
+                           " breakwater")
                };
-               my $differs = (get_differs $ovwr, $cl->{Tree});
-               printf $report " Differs=%#x", $differs if $report;
-               if ($differs & D_UPS) {
-                   printf $report " D_UPS" if $report;
-                   # This will also trigger if a non-dgit git-based NMU
-                   # deleted .gitignore (which is a thing that some of
-                   # the existing git tools do if the user doesn't
-                   # somehow tell them not to).  Ah well.
-                   push @brw_cl, {
-                       %$cl,
-                       SpecialMethod => 'DgitImportUpstreamUpdate',
-                       $xmsg->("convert dgit import: upstream changes",
-                               " breakwater")
-                   };
-               }
                $prline->(" Import");
                $rewrite_from_here->();
                $upp_limit //= $#upp_cl; # further, deeper, patches discarded
-                die 'BUG $upp_limit is not used anywhere?';
                $cur = $ovwr;
                next;
            } else {
@@ -690,6 +749,8 @@ sub walk ($;$$) {
        runcmd @git, qw(read-tree), $treeish;
        $read_tree_debian->($build);
     };
+
+    $#upp_cl = $upp_limit if defined $upp_limit;
  
     my $committer_authline = calculate_committer_authline();
 
@@ -725,8 +786,10 @@ sub walk ($;$$) {
                next;
            } elsif ($method eq 'DgitImportDebianUpdate') {
                $read_tree_debian->($cltree);
-               rm_subdir_cached qw(debian/patches);
            } elsif ($method eq 'DgitImportUpstreamUpdate') {
+               confess unless $rewriting;
+               my $differs = (get_differs $build, $cltree);
+               next unless $differs & D_UPS;
                $read_tree_upstream->($cltree);
                push @parents, map { $_->{CommitId} } @{ $cl->{OrigParents} };
            } else {
@@ -742,7 +805,7 @@ sub walk ($;$$) {
            my $newtree = cmdoutput @git, qw(write-tree);
            my $ch = $cl->{Hdr};
            $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?";
-           $ch =~ s{^parent .*\n}{}m;
+           $ch =~ s{^parent .*\n}{}mg;
            $ch =~ s{(?=^author)}{
                join '', map { "parent $_\n" } @parents
            }me or confess "$ch ?";
@@ -775,7 +838,10 @@ sub walk ($;$$) {
     return @r
 }
 
-sub get_head () { return git_rev_parse qw(HEAD); }
+sub get_head () {
+    git_check_unmodified();
+    return git_rev_parse qw(HEAD);
+}
 
 sub update_head ($$$) {
     my ($old, $new, $mrest) = @_;
@@ -809,9 +875,14 @@ sub cmd_launder () {
 
 sub defaultcmd_rebase () {
     my $old = get_head();
+    my ($status, $message) = record_ffq_prev();
+    if ($status eq 'written' || $status eq 'exists') {
+    } else {
+       fproblem $status, "could not record ffq-prev: $message";
+       fproblems_maybe_bail();
+    }
     my ($tip,$breakwater) = walk $old;
     update_head_postlaunder $old, $tip, 'launder for rebase';
-    @ARGV = qw(-i) unless @ARGV; # make configurable
     runcmd @git, qw(rebase), @ARGV, $breakwater;
 }
 
@@ -822,14 +893,104 @@ sub cmd_analyse () {
     if (defined $old) {
        $old = git_rev_parse $old;
     } else {
-       $old = get_head();
+       $old = git_rev_parse 'HEAD';
     }
     my ($dummy,$breakwater) = walk $old, 1,*STDOUT;
     STDOUT->error and die $!;
 }
 
+sub ffq_prev_branchinfo () {
+    # => ('status', "message", [$current, $ffq_prev])
+    # 'status' may be
+    #    branch         message is undef
+    #    weird-symref   } no $current,
+    #    notbranch      }  no $ffq_prev
+    my $current = git_get_symref();
+    return ('detached', 'detached HEAD') unless defined $current;
+    return ('weird-symref', 'HEAD symref is not to refs/')
+       unless $current =~ m{^refs/};
+    my $ffq_prev = "refs/$ffq_refprefix/$'";
+    return ('branch', undef, $current, $ffq_prev);
+}
+
+sub record_ffq_prev () {
+    # => ('status', "message")
+    # 'status' may be
+    #    written          message is undef
+    #    exists
+    #    detached
+    #    weird-symref
+    #    notbranch
+    # if not ff from some branch we should be ff from, is an fproblem
+    # if "written", will have printed something about that to stdout,
+    #   and also some messages about ff checks
+    my ($status, $message, $current, $ffq_prev) = ffq_prev_branchinfo();
+    return ($status, $message) unless $status eq 'branch';
+
+    my $currentval = get_head();
+
+    my $exists = git_get_ref $ffq_prev;
+    return ('exists',"$ffq_prev already exists") if $exists;
+
+    return ('not-branch', 'HEAD symref is not to refs/heads/')
+       unless $current =~ m{^refs/heads/};
+    my $branch = $';
+
+    my @check_specs = split /\;/, (cfg "branch.$branch.ffq-ffrefs",1) // '*';
+    my %checked;
+
+    my $check = sub {
+       my ($lrref, $desc) = @_;
+       my $invert;
+       for my $chk (@check_specs) {
+           my $glob = $chk;
+           $invert = $glob =~ s{^[^!]}{};
+           last if fnmatch $glob, $lrref;
+       }
+       return if $invert;
+       my $lrval = git_get_ref $lrref;
+       return unless defined $lrval;
+
+       if (is_fast_fwd $lrval, $currentval) {
+           print "OK, you are ahead of $lrref\n" or die $!;
+           $checked{$lrref} = 1;
+       } if (is_fast_fwd $currentval, $lrval) {
+           $checked{$lrref} = -1;
+           fproblem 'behind', "you are behind $lrref, divergence risk";
+       } else {
+           $checked{$lrref} = -1;
+           fproblem 'diverged', "you have diverged from $lrref";
+       }
+    };
+
+    my $merge = cfg "branch.$branch.merge",1;
+    if (defined $merge && $merge =~ m{^refs/heads/}) {
+       my $rhs = $';
+       my $check_remote = sub {
+           my ($remote, $desc) = (@_);
+           return unless defined $remote;
+           $check->("refs/remotes/$remote/$rhs", $desc);
+       };
+       $check_remote->((cfg "branch.$branch.remote",1),
+                       'remote fetch/merge branch');
+       $check_remote->((cfg "branch.$branch.pushRemote",1) //
+                       (cfg "branch.$branch.pushDefault",1),
+                       'remote push branch');
+    }
+    if ($branch =~ m{^dgit/}) {
+       $check->("remotes/dgit/$branch", 'remote dgit branch');
+    } elsif ($branch =~ m{^master$}) {
+       $check->("remotes/dgit/dgit/sid", 'remote dgit branch for sid');
+    }
+
+    fproblems_maybe_bail();
+    runcmd @git, qw(update-ref -m), "record current head for preservation",
+       $ffq_prev, $currentval, $git_null_obj;
+    print "Recorded current head for preservation\n" or die $!;
+    return ('written', undef);
+}
+
 sub cmd_new_upstream_v0 () {
-    # tree should be clean and this is not checked
     # automatically and unconditionally launders before rebasing
     # if rebase --abort is used, laundering has still been done
 
@@ -1007,8 +1168,58 @@ END
     # now it's for the user to sort out
 }
 
-sub cmd_gbp2debrebase () {
-    badusage "needs 1 optional argument, the upstream" unless @ARGV<=1;
+sub cmd_record_ffq_prev () {
+    badusage "no arguments allowed" if @ARGV;
+    my ($status, $msg) = record_ffq_prev();
+    if ($status eq 'exists' && $opt_noop_ok) {
+       print "Previous head already recorded\n" or die $!;
+    } elsif ($status eq 'written') {
+    } else {
+       fail "Could not preserve: $msg";
+    }
+}
+
+sub cmd_breakwater () {
+    badusage "no arguments allowed" if @ARGV;
+    my $bw = breakwater_of git_rev_parse 'HEAD';
+    print "$bw\n" or die $!;
+}
+
+sub cmd_stitch () {
+    my $prose = '';
+    GetOptions('prose=s', \$prose) or die badusage("bad options to stitch");
+    badusage "no arguments allowed" if @ARGV;
+    my ($status, $message, $current, $ffq_prev) = ffq_prev_branchinfo();
+    if ($status ne 'branch') {
+       fproblem $status, "could not check ffq-prev: $message";
+       fproblems_maybe_bail();
+    }
+    my $prev = $ffq_prev && git_get_ref $ffq_prev;
+    if (!$prev) {
+       fail "No ffq-prev to stitch." unless $opt_noop_ok;
+    }
+    fresh_workarea();
+    my $old_head = get_head();
+    my $new_head = make_commit [ $old_head, $ffq_prev ], [
+       'Declare fast forward / record previous work',
+        "[git-debrebase pseudomerge: stitch$prose]",
+    ];
+    my @upd_cmd = (@git, qw(update-ref --stdin));
+    debugcmd '>|', @upd_cmd;
+    open U, "|-", @upd_cmd or die $!;
+    my $u = <<END;
+update HEAD $new_head $old_head
+delete $ffq_prev $prev
+END
+    printdebug ">= ", $_, "\n" foreach split /\n/, $u;
+    print U $u;
+    printdebug ">\$\n";
+    close U or failedcmd @upd_cmd;
+}
+
+sub cmd_convert_from_gbp () {
+    badusage "needs 1 optional argument, the upstream git rev"
+       unless @ARGV<=1;
     my ($upstream_spec) = @ARGV;
     $upstream_spec //= 'refs/heads/upstream';
     my $upstream = git_rev_parse $upstream_spec;
@@ -1054,9 +1265,9 @@ sub cmd_gbp2debrebase () {
        runcmd @git, qw(checkout -q gdr-internal~0);
        rm_subdir_cached 'debian/patches';
        $work = make_commit ['HEAD'], [
- 'git-debrebase import: drop patch queue',
+ 'git-debrebase convert-from-gbp: drop patches from tree',
  'Delete debian/patches, as part of converting to git-debrebase format.',
- '[git-debrebase: gbp2debrebase, drop patches]'
+ '[git-debrebase convert-from-gbp: drop patches from tree]'
                              ];
        # make the breakwater pseudomerge
        # the tree is already exactly right
@@ -1069,10 +1280,40 @@ sub cmd_gbp2debrebase () {
        # rebase the patch queue onto the new breakwater
        runcmd @git, qw(reset --quiet --hard patch-queue/gdr-internal);
        runcmd @git, qw(rebase --quiet --onto), $work, qw(gdr-internal);
-       $work = get_head();
+       $work = git_rev_parse 'HEAD';
     };
 
-    update_head_checkout $old_head, $work, 'gbp2debrebase';
+    update_head_checkout $old_head, $work, 'convert-from-gbp';
+}
+
+sub cmd_convert_to_gbp () {
+    badusage "no arguments allowed" if @ARGV;
+    my $head = get_head();
+    my $ffq = (ffq_prev_branchinfo())[3];
+    my $bw = breakwater_of $head;
+    fresh_workarea();
+    my $out;
+    in_workarea sub {
+       runcmd @git, qw(checkout -q -b bw), $bw;
+       runcmd @git, qw(checkout -q -b patch-queue/bw), $head;
+       runcmd qw(gbp pq export);
+       runcmd @git, qw(add debian/patches);
+       $out = make_commit ['HEAD'], [
+            'Commit patch queue (converted from git-debrebase format)',
+            '[git-debrebase convert-to-gbp: commit patches]',
+        ];
+    };
+    if (defined $ffq) {
+       runcmd @git, qw(update-ref -m),
+           "debrebase: converting corresponding main branch to gbp format",
+           $ffq, $git_null_obj;
+    }
+    update_head_checkout $head, $out, "convert to gbp (v0)";
+    print <<END or die $!;
+git-debrebase: converted to git-buildpackage branch format
+git-debrebase: WARNING: do not now run "git-debrebase" any more
+git-debrebase: WARNING: doing so would drop all upstream patches!
+END
 }
 
 sub cmd_downstream_rebase_launder_v0 () {
@@ -1125,6 +1366,8 @@ sub cmd_downstream_rebase_launder_v0 () {
 }
 
 GetOptions("D+" => \$debuglevel,
+          'noop-ok', => \$opt_noop_ok,
+          'f=s' => \@fproblem_force_opts,
           'force!') or die badusage "bad options\n";
 initdebug('git-debrebase ');
 enabledebug if $debuglevel;