git-debrebase

   1 #!/usr/bin/perl -w
   2 # git-debrebase
   3 # Script helping make fast-forwarding histories while still rebasing
   4 # upstream deltas when working on Debian packaging
   5 #
   6 # Copyright (C)2017,2018 Ian Jackson
   7 #
   8 # This program is free software: you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation, either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
  22 use Debian::Dgit::GDR;
  23 use Debian::Dgit::ExitStatus;
  24
  25 use strict;
  26
  27 use Debian::Dgit qw(:DEFAULT :playground);
  28 setup_sigwarn();
  29
  30 use Memoize;
  31 use Carp;
  32 use POSIX;
  33 use Data::Dumper;
  34 use Getopt::Long qw(:config posix_default gnu_compat bundling);
  35 use Dpkg::Version;
  36 use File::FnMatch qw(:fnmatch);
  37 use File::Copy;
  38
  39 our ($usage_message) = <<'END';
  40 usages:
  41   git-debrebase [<options>] [--|-i <git rebase options...>]
  42   git-debrebase [<options>] status
  43   git-debrebase [<options>] prepush [--prose=...]
  44   git-debrebase [<options>] quick|conclude
  45   git-debrebase [<options>] new-upstream <new-version> [<details ...>]
  46   git-debrebase [<options>] convert-from-gbp [<upstream-commitish>]
  47   ...
  48 See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit).
  49 END
  50
  51 our ($opt_force, $opt_noop_ok, @opt_anchors);
  52 our ($opt_defaultcmd_interactive);
  53
  54 our $us = qw(git-debrebase);
  55
  56 $|=1;
  57
  58 sub badusage ($) {
  59     my ($m) = @_;
  60     print STDERR "$us: bad usage: $m\n";
  61     finish 8;
  62 }
  63
  64 sub getoptions_main {
  65     my $m = shift;
  66     local $SIG{__WARN__}; # GetOptions calls `warn' to print messages
  67     GetOptions @_ or badusage $m;
  68 }
  69 sub getoptions {
  70     my $sc = shift;
  71     getoptions_main "bad options follow \`git-debrebase $sc'", @_;
  72 }
  73
  74 sub cfg ($;$) {
  75     my ($k, $optional) = @_;
  76     local $/ = "\0";
  77     my @cmd = qw(git config -z);
  78     push @cmd, qw(--get-all) if wantarray;
  79     push @cmd, $k;
  80     my $out = cmdoutput_errok @cmd;
  81     if (!defined $out) {
  82         fail "missing required git config $k" unless $optional;
  83         return ();
  84     }
  85     my @l = split /\0/, $out;
  86     return wantarray ? @l : $l[0];
  87 }
  88
  89 memoize('cfg');
  90
  91 sub dd ($) {
  92     my ($v) = @_;
  93     my $dd = new Data::Dumper [ $v ];
  94     Terse $dd 1; Indent $dd 0; Useqq $dd 1;
  95     return Dump $dd;
  96 }
  97
  98 sub get_commit ($) {
  99     my ($objid) = @_;
 100     my $data = (git_cat_file $objid, 'commit');
 101     $data =~ m/(?<=\n)\n/ or die "$objid ($data) ?";
 102     return ($`,$');
 103 }
 104
 105 sub D_UPS ()      { 0x02; } # upstream files
 106 sub D_PAT_ADD ()  { 0x04; } # debian/patches/ extra patches at end
 107 sub D_PAT_OTH ()  { 0x08; } # debian/patches other changes
 108 sub D_DEB_CLOG () { 0x10; } # debian/ (not patches/ or changelog)
 109 sub D_DEB_OTH ()  { 0x20; } # debian/changelog
 110 sub DS_DEB ()     { D_DEB_CLOG | D_DEB_OTH; } # debian/ (not patches/)
 111
 112 our $playprefix = 'debrebase';
 113 our $rd;
 114 our $workarea;
 115
 116 our @git = qw(git);
 117 our @dgit = qw(dgit);
 118
 119 sub in_workarea ($) {
 120     my ($sub) = @_;
 121     changedir $workarea;
 122     my $r = eval { $sub->(); };
 123     { local $@; changedir $maindir; }
 124     die $@ if $@;
 125 }
 126
 127 sub fresh_workarea () {
 128     $workarea = fresh_playground "$playprefix/work";
 129     in_workarea sub { playtree_setup };
 130 }
 131
 132 our $snags_forced = 0;
 133 our $snags_tripped = 0;
 134 our $snags_summarised = 0;
 135 our @deferred_updates;
 136 our @deferred_update_messages;
 137
 138 sub all_snags_summarised () {
 139     $snags_forced + $snags_tripped == $snags_summarised;
 140 }
 141 sub run_deferred_updates ($) {
 142     my ($mrest) = @_;
 143
 144     confess 'dangerous internal error' unless all_snags_summarised();
 145
 146     my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin));
 147     debugcmd '>|', @upd_cmd;
 148     open U, "|-", @upd_cmd or die $!;
 149     foreach (@deferred_updates) {
 150         printdebug ">= ", $_, "\n";
 151         print U $_, "\n" or die $!;
 152     }
 153     printdebug ">\$\n";
 154     close U or failedcmd @upd_cmd;
 155
 156     print $_, "\n" foreach @deferred_update_messages;
 157
 158     @deferred_updates = ();
 159     @deferred_update_messages = ();
 160 }
 161
 162 sub get_differs ($$) {
 163     my ($x,$y) = @_;
 164     # This resembles quiltify_trees_differ, in dgit, a bit.
 165     # But we don't care about modes, or dpkg-source-unrepresentable
 166     # changes, and we don't need the plethora of different modes.
 167     # Conversely we need to distinguish different kinds of changes to
 168     # debian/ and debian/patches/.
 169
 170     my $differs = 0;
 171
 172     my $rundiff = sub {
 173         my ($opts, $limits, $fn) = @_;
 174         my @cmd = (@git, qw(diff-tree -z --no-renames));
 175         push @cmd, @$opts;
 176         push @cmd, "$_:" foreach $x, $y;
 177         push @cmd, '--', @$limits;
 178         my $diffs = cmdoutput @cmd;
 179         foreach (split /\0/, $diffs) { $fn->(); }
 180     };
 181
 182     $rundiff->([qw(--name-only)], [], sub {
 183         $differs |= $_ eq 'debian' ? DS_DEB : D_UPS;
 184     });
 185
 186     if ($differs & DS_DEB) {
 187         $differs &= ~DS_DEB;
 188         $rundiff->([qw(--name-only -r)], [qw(debian)], sub {
 189             $differs |=
 190                 m{^debian/patches/}      ? D_PAT_OTH  :
 191                 $_ eq 'debian/changelog' ? D_DEB_CLOG :
 192                                            D_DEB_OTH;
 193         });
 194         die "mysterious debian changes $x..$y"
 195             unless $differs & (D_PAT_OTH|DS_DEB);
 196     }
 197
 198     if ($differs & D_PAT_OTH) {
 199         my $mode;
 200         $differs &= ~D_PAT_OTH;
 201         my $pat_oth = sub {
 202             $differs |= D_PAT_OTH;
 203             no warnings qw(exiting);  last;
 204         };
 205         $rundiff->([qw(--name-status -r)], [qw(debian/patches/)], sub {
 206             no warnings qw(exiting);
 207             if (!defined $mode) {
 208                 $mode = $_;  next;
 209             }
 210             die unless s{^debian/patches/}{};
 211             my $ok;
 212             if ($mode eq 'A' && !m/\.series$/s) {
 213                 $ok = 1;
 214             } elsif ($mode eq 'M' && $_ eq 'series') {
 215                 my $x_s = (git_cat_file "$x:debian/patches/series", 'blob');
 216                 my $y_s = (git_cat_file "$y:debian/patches/series", 'blob');
 217                 chomp $x_s;  $x_s .= "\n";
 218                 $ok = $x_s eq substr($y_s, 0, length $x_s);
 219             } else {
 220                 # nope
 221             }
 222             $mode = undef;
 223             $differs |= $ok ? D_PAT_ADD : D_PAT_OTH;
 224         });
 225         die "mysterious debian/patches changes $x..$y"
 226             unless $differs & (D_PAT_ADD|D_PAT_OTH);
 227     }
 228
 229     printdebug sprintf "get_differs %s, %s = %#x\n", $x, $y, $differs;
 230
 231     return $differs;
 232 }
 233
 234 sub commit_pr_info ($) {
 235     my ($r) = @_;
 236     return Data::Dumper->dump([$r], [qw(commit)]);
 237 }
 238
 239 sub calculate_committer_authline () {
 240     my $c = cmdoutput @git, qw(commit-tree --no-gpg-sign -m),
 241         'DUMMY COMMIT (git-debrebase)', "HEAD:";
 242     my ($h,$m) = get_commit $c;
 243     $h =~ m/^committer .*$/m or confess "($h) ?";
 244     return $&;
 245 }
 246
 247 sub rm_subdir_cached ($) {
 248     my ($subdir) = @_;
 249     runcmd @git, qw(rm --quiet -rf --cached --ignore-unmatch), $subdir;
 250 }
 251
 252 sub read_tree_subdir ($$) {
 253     my ($subdir, $new_tree_object) = @_;
 254     rm_subdir_cached $subdir;
 255     runcmd @git, qw(read-tree), "--prefix=$subdir/", $new_tree_object;
 256 }
 257
 258 sub read_tree_debian ($) {
 259     my ($treeish) = @_;
 260     read_tree_subdir 'debian', "$treeish:debian";
 261     rm_subdir_cached 'debian/patches';
 262 }
 263
 264 sub read_tree_upstream ($;$) {
 265     my ($treeish, $keep_patches) = @_;
 266     my $save = cmdoutput @git, qw(write-tree --prefix=debian/);
 267     runcmd @git, qw(read-tree), $treeish;
 268     read_tree_subdir 'debian', $save;
 269     rm_subdir_cached 'debian/patches' unless $keep_patches;
 270 };
 271
 272 sub make_commit ($$) {
 273     my ($parents, $message_paras) = @_;
 274     my $tree = cmdoutput @git, qw(write-tree);
 275     my @cmd = (@git, qw(commit-tree), $tree);
 276     push @cmd, qw(-p), $_ foreach @$parents;
 277     push @cmd, qw(-m), $_ foreach @$message_paras;
 278     return cmdoutput @cmd;
 279 }
 280
 281 our @snag_force_opts;
 282 sub snag ($$;@) {
 283     my ($tag,$msg) = @_; # ignores extra args, for benefit of keycommits
 284     if (grep { $_ eq $tag } @snag_force_opts) {
 285         $snags_forced++;
 286         print STDERR "git-debrebase: snag ignored (-f$tag): $msg\n";
 287     } else {
 288         $snags_tripped++;
 289         print STDERR "git-debrebase: snag detected (-f$tag): $msg\n";
 290     }
 291 }
 292
 293 # Important: all mainline code must call snags_maybe_bail after
 294 # any point where snag might be called, but before making changes
 295 # (eg before any call to run_deferred_updates).  snags_maybe_bail
 296 # may be called more than once if necessary (but this is not ideal
 297 # because then the messages about number of snags may be confusing).
 298 sub snags_maybe_bail () {
 299     return if all_snags_summarised();
 300     if ($snags_forced) {
 301         printf STDERR
 302             "%s: snags: %d overriden by individual -f options\n",
 303             $us, $snags_forced;
 304     }
 305     if ($snags_tripped) {
 306         if ($opt_force) {
 307             printf STDERR
 308                 "%s: snags: %d overriden by global --force\n",
 309                 $us, $snags_tripped;
 310         } else {
 311             fail sprintf
 312   "%s: snags: %d blocker(s) (you could -f<tag>, or --force)",
 313                 $us, $snags_tripped;
 314         }
 315     }
 316     $snags_summarised = $snags_forced + $snags_tripped;
 317 }
 318 sub snags_maybe_bail_early () {
 319     # useful to bail out early without doing a lot of work;
 320     # not a substitute for snags_maybe_bail.
 321     snags_maybe_bail() if $snags_tripped && !$opt_force;
 322 }
 323 sub any_snags () {
 324     return $snags_forced || $snags_tripped;
 325 }
 326
 327 sub gbp_pq_export ($$$) {
 328     my ($bname, $base, $tip) = @_;
 329     # must be run in a workarea.  $bname and patch-queue/$bname
 330     # ought not to exist.  Leaves you on patch-queue/$bname with
 331     # the patches staged but not committed.
 332     runcmd @git, qw(checkout -q -b), $bname, $base;
 333     runcmd @git, qw(checkout -q -b), "patch-queue/$bname", $tip;
 334     my @gbp_cmd = (qw(gbp pq export));
 335     my $r = system shell_cmd 'exec >../gbp-pq-err 2>&1', @gbp_cmd;
 336     if ($r) {
 337         { local ($!,$?); copy('../gbp-pq-err', \*STDERR); }
 338         failedcmd @gbp_cmd;
 339     }
 340     runcmd @git, qw(add -f debian/patches);
 341 }
 342
 343
 344 # xxx allow merge separately from laundering
 345 #
 346 # xxx docs highlight forbidden things
 347 # xxx docs list allowable things ?
 348 # xxx docs explicitly forbid some rebase
 349 #
 350 # xxx provide a way for the user to help
 351 # xxx (eg, provide wreckage provide way to continue)
 352
 353 # later/rework?
 354 #  use git-format-patch?
 355 #  our own patch identification algorithm?
 356 #  this is an alternative strategy
 357
 358 sub merge_series ($$;@) {
 359     my ($newbase, $base_q, @input_qs) = @_;
 360     # $base_q{SeriesBase}  $input_qs[]{SeriesBase}
 361     # $base_q{SeriesTip}   $input_qs[]{SeriesTip}
 362     # ^ specifies several patch series (currently we only support exactly 2)
 363     # return value is a commit which is the result of
 364     # merging the two versions of the same topic branch
 365     #   $input_q[0] and $input_q[1]
 366     # with respect to the old version
 367     #   $base_q
 368     # all onto $newbase.
 369
 370     # Creates, in *_q, a key MR for its private use
 371
 372     $input_qs[$_]{MR}{S} = $_ foreach (0..$#input_qs);
 373     $base_q->{MR}{S} = 'base';
 374
 375     my %prereq;
 376     # $prereq{<patch filename>}{<possible prereq}{<S>} = 1 or absent
 377     # $prereq{<patch filename>}{<possible prereq}  exists or not (later)
 378     # $prereq{<patch filename>}               exists or not (even later)
 379
 380     my $result;
 381
 382     local $workarea = fresh_playground "$playprefix/merge";
 383     my $seriesfile = "debian/patches/series";
 384     in_workarea sub {
 385         playtree_setup();
 386         foreach my $q ($base_q, reverse @input_qs) {
 387             my $s = $q->{MR}{S};
 388             gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
 389             if (open S, $seriesfile) {
 390                 my @earlier;
 391                 while (my $patch = <S>) {
 392                     chomp $patch or die $!;
 393                     foreach my $earlier (@earlier) {
 394                         $prereq{$patch}{$earlier}{$s}++ and die;
 395                     }
 396                     push @earlier, $patch;
 397                     stat "debian/patches/$patch" or die "$patch ?";
 398                 }
 399                 S->error and die "$seriesfile $!";
 400                 close S;
 401             } else {
 402                 die "$seriesfile $!" unless $!==ENOENT;
 403             }
 404             read_tree_upstream $newbase, 1;
 405             my $pec = make_commit [ grep { defined } $base_q->{MR}{PEC} ], [
 406                 "Convert $s to patch queue for merging",
 407                 "[git-debrebase merge-innards patch-queue import:".
 408                 " $q->{SeriesTip}]"
 409             ];
 410             runcmd @git, qw(rm -q --cached), $seriesfile;
 411             $pec = make_commit [ $pec ], [
 412                 "Drop series file from $s to avoid merge trouble",
 413                 "[git-debrebase merge-innards patch-queue prep:".
 414                 " $q->{SeriesTip}]"
 415             ];
 416             runcmd @git, qw(reset -q --hard), $pec;
 417             $q->{MR}{PEC} = $pec;
 418         }
 419         # now, because of reverse, we are on $input_q->{MR}{OQC}
 420         runcmd @git, qw(checkout -q -b merge);
 421         my @mergecmd = (@git, qw(merge --quiet --no-edit), "p-1");
 422         debugcmd '+', @mergecmd;
 423         $!=0; $?=-1;
 424         if (system @mergecmd) {
 425             failedcmd @mergecmd;
 426         }
 427
 428         # We need to construct a new series file
 429         # Firstly, resolve prereq
 430         foreach my $f (keys %prereq) {
 431             if (!stat_exists "debian/patches/$f") {
 432                 # git merge deleted it; that's how we tell it's not wanted
 433                 delete $prereq{$f};
 434                 next;
 435             }
 436             foreach my $g (keys %{ $prereq{$f} }) {
 437                 my $gfp = $prereq{$f}{$g};
 438                 next unless
 439                     # want to keep it
 440                     !!$gfp->{0} == !!$gfp->{1}
 441                     ? $gfp->{0}
 442                     : !$gfp->{base}
 443                     ;
 444                 delete $prereq{$f}{$g};
 445             }
 446         }
 447
 448         my $unsat = sub {
 449             my ($f) = @_;
 450             return scalar keys %{ $prereq{$f} };
 451         };
 452
 453         my $nodate = time + 1;
 454         my %authordate;
 455         # $authordate{<patch filename>};
 456         my $authordate = sub {
 457             my ($f) = @_;
 458             $authordate{$f} //= do {
 459                 open PF, "<", "debian/patches/$f" or die "$f $!";
 460                 while (<PF>) {
 461                     return $nodate if m/^$/;
 462                     last if s{^Date: }{};
 463                 }
 464                 chomp;
 465                 return cmdoutput qw(date +%s -d), $_;
 466             };
 467         };
 468
 469         open NS, '>', $seriesfile or die $!;
 470
 471         while (keys %prereq) {
 472             my $best;
 473             foreach my $try (sort keys %prereq) {
 474                 if ($best) {
 475                     next if (
 476                              $unsat->($try) <=> $unsat->($best) or
 477                              $authordate->($try) <=> $authordate->($best) or
 478                              $try cmp $best
 479                             ) >= 0;
 480                 }
 481                 $best = $try;
 482             }
 483             print NS "$best\n" or die $!;
 484             delete $prereq{$best};
 485             foreach my $gp (values %prereq) {
 486                 delete $gp->{$best};
 487             }
 488         }
 489
 490         runcmd @git, qw(add), $seriesfile;
 491         runcmd @git, qw(commit --quiet -m), 'Merged series';
 492
 493         runcmd qw(gbp pq import);
 494
 495         # OK now we are on patch-queue/merge, and we need to rebase
 496         # onto the intended parent and drop the patches from each one
 497
 498         my $build = $newbase;
 499         my @lcmd = (@git, qw(rev-list --reverse merge..patch-queue/merge));
 500         foreach my $c (grep /./, split /\n/, cmdoutput @lcmd) {
 501             my $commit = git_cat_file $c, 'commit';
 502             read_tree_upstream $c;
 503             my $tree = cmdoutput @git, qw(write-tree);
 504             $commit =~ s{^parent (\S+)$}{parent $build}m or confess;
 505             $commit =~ s{^tree (\S+)$}{tree $tree}m      or confess;
 506             open C, ">", "../mcommit" or die $!;
 507             print C $commit or die $!;
 508             close C or die $!;
 509             $build = cmdoutput @git, qw(hash-object -w -t commit ../mcommit);
 510         }
 511         $result = $build;
 512         runcmd @git, qw(update-ref refs/heads/result), $result;
 513     };
 514     printdebug "merge_series returns $result\n";
 515     return $result;
 516 }
 517
 518 # classify returns an info hash like this
 519 #   CommitId => $objid
 520 #   Hdr => # commit headers, including 1 final newline
 521 #   Msg => # commit message (so one newline is dropped)
 522 #   Tree => $treeobjid
 523 #   Type => (see below)
 524 #   Parents = [ {
 525 #       Ix => $index # ie 0, 1, 2, ...
 526 #       CommitId
 527 #       Differs => return value from get_differs
 528 #       IsOrigin
 529 #       IsDggitImport => 'orig' 'tarball' 'unpatched' 'package' (as from dgit)
 530 #     } ...]
 531 #   NewMsg => # commit message, but with any [dgit import ...] edited
 532 #             # to say "[was: ...]"
 533 #
 534 # Types:
 535 #   Packaging
 536 #   Changelog
 537 #   Upstream
 538 #   AddPatches
 539 #   Mixed
 540 #
 541 #   Pseudomerge
 542 #     has additional entres in classification result
 543 #       Overwritten = [ subset of Parents ]
 544 #       Contributor = $the_remaining_Parent
 545 #
 546 #   DgitImportUnpatched
 547 #     has additional entry in classification result
 548 #       OrigParents = [ subset of Parents ]
 549 #
 550 #   Anchor
 551 #     has additional entry in classification result
 552 #       OrigParents = [ subset of Parents ]  # singleton list
 553 #
 554 #   TreatAsAnchor
 555 #
 556 #   BreakwaterStart
 557 #
 558 #   Unknown
 559 #     has additional entry in classification result
 560 #       Why => "prose"
 561
 562 sub parsecommit ($;$) {
 563     my ($objid, $p_ref) = @_;
 564     # => hash with                   CommitId Hdr Msg Tree Parents
 565     #    Parents entries have only   Ix CommitId
 566     #    $p_ref, if provided, must be [] and is used as a base for Parents
 567
 568     $p_ref //= [];
 569     die if @$p_ref;
 570
 571     my ($h,$m) = get_commit $objid;
 572
 573     my ($t) = $h =~ m/^tree (\w+)$/m or die $objid;
 574     my (@ph) = $h =~ m/^parent (\w+)$/mg;
 575
 576     my $r = {
 577         CommitId => $objid,
 578         Hdr => $h,
 579         Msg => $m,
 580         Tree => $t,
 581         Parents => $p_ref,
 582     };
 583
 584     foreach my $ph (@ph) {
 585         push @$p_ref, {
 586             Ix => scalar @$p_ref,
 587             CommitId => $ph,
 588         };
 589     }
 590
 591     return $r;
 592 }
 593
 594 sub classify ($) {
 595     my ($objid) = @_;
 596
 597     my @p;
 598     my $r = parsecommit($objid, \@p);
 599     my $t = $r->{Tree};
 600
 601     foreach my $p (@p) {
 602         $p->{Differs} = (get_differs $p->{CommitId}, $t),
 603     }
 604
 605     printdebug "classify $objid \$t=$t \@p",
 606         (map { sprintf " %s/%#x", $_->{CommitId}, $_->{Differs} } @p),
 607         "\n";
 608
 609     my $classify = sub {
 610         my ($type, @rest) = @_;
 611         $r = { %$r, Type => $type, @rest };
 612         if ($debuglevel) {
 613             printdebug " = $type ".(dd $r)."\n";
 614         }
 615         return $r;
 616     };
 617     my $unknown = sub {
 618         my ($why) = @_;
 619         $r = { %$r, Type => qw(Unknown), Why => $why };
 620         printdebug " ** Unknown\n";
 621         return $r;
 622     };
 623
 624     if (grep { $_ eq $objid } @opt_anchors) {
 625         return $classify->('TreatAsAnchor');
 626     }
 627
 628     my @identical = grep { !$_->{Differs} } @p;
 629     my ($stype, $series) = git_cat_file "$t:debian/patches/series";
 630     my $haspatches = $stype ne 'missing' && $series =~ m/^\s*[^#\n\t ]/m;
 631
 632     if ($r->{Msg} =~ m{^\[git-debrebase anchor.*\]$}m) {
 633         # multi-orig upstreams are represented with an anchor merge
 634         # from a single upstream commit which combines the orig tarballs
 635
 636         # Every anchor tagged this way must be a merge.
 637         # We are relying on the
 638         #     [git-debrebase anchor: ...]
 639         # commit message annotation in "declare" anchor merges (which
 640         # do not have any upstream changes), to distinguish those
 641         # anchor merges from ordinary pseudomerges (which we might
 642         # just try to strip).
 643         #
 644         # However, the user is going to be doing git-rebase a lot.  We
 645         # really don't want them to rewrite an anchor commit.
 646         # git-rebase trips up on merges, so that is a useful safety
 647         # catch.
 648         #
 649         # BreakwaterStart commits are also anchors in the terminology
 650         # of git-debrebase(5), but they are untagged (and always
 651         # manually generated).
 652         #
 653         # We cannot not tolerate any tagged linear commit (ie,
 654         # BreakwaterStart commits tagged `[anchor:') because such a
 655         # thing could result from an erroneous linearising raw git
 656         # rebase of a merge anchor.  That would represent a corruption
 657         # of the branch. and we want to detect and reject the results
 658         # of such corruption before it makes it out anywhere.  If we
 659         # reject it here then we avoid making the pseudomerge which
 660         # would be needed to push it.
 661
 662         my $badanchor = sub { $unknown->("git-debrebase \`anchor' but @_"); };
 663         @p == 2 or return $badanchor->("has other than two parents");
 664         $haspatches and return $badanchor->("contains debian/patches");
 665
 666         # How to decide about l/r ordering of anchors ?  git
 667         # --topo-order prefers to expand 2nd parent first.  There's
 668         # already an easy rune to look for debian/ history anyway (git log
 669         # debian/) so debian breakwater branch should be 1st parent; that
 670         # way also there's also an easy rune to look for the upstream
 671         # patches (--topo-order).
 672
 673         # Also this makes --first-parent be slightly more likely to
 674         # be useful - it makes it provide a linearised breakwater history.
 675
 676         # Of course one can say somthing like
 677         #  gitk -- ':/' ':!/debian'
 678         # to get _just_ the commits touching upstream files, and by
 679         # the TREESAME logic in git-rev-list this will leave the
 680         # breakwater into upstream at the first anchor.  But that
 681         # doesn't report debian/ changes at all.
 682
 683         # Other observations about gitk: by default, gitk seems to
 684         # produce output in a different order to git-rev-list.  I
 685         # can't seem to find this documented anywhere.  gitk
 686         # --date-order DTRT.  But, gitk always seems to put the
 687         # parents from left to right, in order, so it's easy to see
 688         # which way round a pseudomerge is.
 689
 690         $p[0]{IsOrigin} and $badanchor->("is an origin commit");
 691         $p[1]{Differs} & ~DS_DEB and
 692             $badanchor->("upstream files differ from left parent");
 693         $p[0]{Differs} & ~D_UPS and
 694             $badanchor->("debian/ differs from right parent");
 695
 696         return $classify->(qw(Anchor),
 697                            OrigParents => [ $p[1] ]);
 698     }
 699
 700     if (@p == 1) {
 701         my $d = $r->{Parents}[0]{Differs};
 702         if ($d == D_PAT_ADD) {
 703             return $classify->(qw(AddPatches));
 704         } elsif ($d & (D_PAT_ADD|D_PAT_OTH)) {
 705             return $unknown->("edits debian/patches");
 706         } elsif ($d & DS_DEB and !($d & ~DS_DEB)) {
 707             my ($ty,$dummy) = git_cat_file "$p[0]{CommitId}:debian";
 708             if ($ty eq 'tree') {
 709                 if ($d == D_DEB_CLOG) {
 710                     return $classify->(qw(Changelog));
 711                 } else {
 712                     return $classify->(qw(Packaging));
 713                 }
 714             } elsif ($ty eq 'missing') {
 715                 return $classify->(qw(BreakwaterStart));
 716             } else {
 717                 return $unknown->("parent's debian is not a directory");
 718             }
 719         } elsif ($d == D_UPS) {
 720             return $classify->(qw(Upstream));
 721         } elsif ($d & DS_DEB and $d & D_UPS and !($d & ~(DS_DEB|D_UPS))) {
 722             return $classify->(qw(Mixed));
 723         } elsif ($d == 0) {
 724             return $unknown->("no changes");
 725         } else {
 726             confess "internal error $objid ?";
 727         }
 728     }
 729     if (!@p) {
 730         return $unknown->("origin commit");
 731     }
 732
 733     if (@p == 2 && @identical == 1) {
 734         my @overwritten = grep { $_->{Differs} } @p;
 735         confess "internal error $objid ?" unless @overwritten==1;
 736         return $classify->(qw(Pseudomerge),
 737                            Overwritten => [ $overwritten[0] ],
 738                            Contributor => $identical[0]);
 739     }
 740     if (@p == 2 && @identical == 2) {
 741         my $get_t = sub {
 742             my ($ph,$pm) = get_commit $_[0]{CommitId};
 743             $ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
 744             $1;
 745         };
 746         my @bytime = @p;
 747         my $order = $get_t->($bytime[0]) <=> $get_t->($bytime[1]);
 748         if ($order > 0) { # newer first
 749         } elsif ($order < 0) {
 750             @bytime = reverse @bytime;
 751         } else {
 752             # same age, default to order made by -s ours
 753             # that is, commit was made by someone who preferred L
 754         }
 755         return $classify->(qw(Pseudomerge),
 756                            SubType => qw(Ambiguous),
 757                            Contributor => $bytime[0],
 758                            Overwritten => [ $bytime[1] ]);
 759     }
 760     foreach my $p (@p) {
 761         my ($p_h, $p_m) = get_commit $p->{CommitId};
 762         $p->{IsOrigin} = $p_h !~ m/^parent \w+$/m;
 763         ($p->{IsDgitImport},) = $p_m =~ m/^\[dgit import ([0-9a-z]+) .*\]$/m;
 764     }
 765     my @orig_ps = grep { ($_->{IsDgitImport}//'X') eq 'orig' } @p;
 766     my $m2 = $r->{Msg};
 767     if (!(grep { !$_->{IsOrigin} } @p) and
 768         (@orig_ps >= @p - 1) and
 769         $m2 =~ s{^\[(dgit import unpatched .*)\]$}{[was: $1]}m) {
 770         $r->{NewMsg} = $m2;
 771         return $classify->(qw(DgitImportUnpatched),
 772                            OrigParents => \@orig_ps);
 773     }
 774
 775     if (@p == 2 and
 776         $r->{Msg} =~ m{^\[git-debrebase merged-breakwater.*\]$}m) {
 777         # xxx ^ metadata tag needs adding to (5)
 778         return $classify->("MergedBreakwaters");
 779     }
 780     if ($r->{Msg} =~ m{^\[(git-debrebase|dgit)[: ].*\]$}m) {
 781         return $unknown->("unknown kind of merge from $1");
 782     }
 783     if (@p > 2) {
 784         return $unknown->("octopus merge");
 785     }
 786
 787     if (!$ENV{GIT_DEBREBASE_EXPERIMENTAL_MERGE}) {
 788         return $unknown->("general two-parent merge");
 789     }
 790
 791     return $classify->("VanillaMerge");
 792 }
 793
 794 sub keycommits ($;$$$$) {
 795     my ($head, $furniture, $unclean, $trouble, $fatal) = @_;
 796     # => ($anchor, $breakwater)
 797
 798     # $unclean->("unclean-$tagsfx", $msg, $cl)
 799     # $furniture->("unclean-$tagsfx", $msg, $cl)
 800     # $dgitimport->("unclean-$tagsfx", $msg, $cl))
 801     #   is callled for each situation or commit that
 802     #   wouldn't be found in a laundered branch
 803     # $furniture is for furniture commits such as might be found on an
 804     #   interchange branch (pseudomerge, d/patches, changelog)
 805     # $trouble is for things whnich prevent the return of
 806     #   anchor and breakwater information; if that is ignored,
 807     #   then keycommits returns (undef, undef) instead.
 808     # $fatal is for unprocessable commits, and should normally cause
 809     #    a failure.  If ignored, agaion, (undef, undef) is returned.
 810     #
 811     # If a callback is undef, fail is called instead.
 812     # If a callback is defined but false, the situation is ignored.
 813     # Callbacks may say:
 814     #   no warnings qw(exiting); last;
 815     # if the answer is no longer wanted.
 816
 817     my ($anchor, $breakwater);
 818     my $clogonly;
 819     my $cl;
 820     my $found_pm;
 821     $fatal //= sub { fail $_[1]; };
 822     my $x = sub {
 823         my ($cb, $tagsfx, $mainwhy, $xwhy) = @_;
 824         my $why = $mainwhy.$xwhy;
 825         my $m = "branch needs laundering (run git-debrebase): $why";
 826         fail $m unless defined $cb;
 827         return unless $cb;
 828         $cb->("unclean-$tagsfx", $why, $cl, $mainwhy);
 829     };
 830     for (;;) {
 831         $cl = classify $head;
 832         my $ty = $cl->{Type};
 833         if ($ty eq 'Packaging') {
 834             $breakwater //= $clogonly;
 835             $breakwater //= $head;
 836         } elsif ($ty eq 'Changelog') {
 837             # this is going to count as the tip of the breakwater
 838             # only if it has no upstream stuff before it
 839             $clogonly //= $head;
 840         } elsif ($ty eq 'Anchor' or
 841                  $ty eq 'TreatAsAnchor' or
 842                  $ty eq 'BreakwaterStart') {
 843             $anchor = $head;
 844             $breakwater //= $clogonly;
 845             $breakwater //= $head;
 846             last;
 847         } elsif ($ty eq 'Upstream') {
 848             $x->($unclean, 'ordering',
 849  "packaging change ($breakwater) follows upstream change"," (eg $head)")
 850                 if defined $breakwater;
 851             $clogonly = undef;
 852             $breakwater = undef;
 853         } elsif ($ty eq 'Mixed') {
 854             $x->($unclean, 'mixed',
 855                  "found mixed upstream/packaging commit"," ($head)");
 856             $clogonly = undef;
 857             $breakwater = undef;
 858         } elsif ($ty eq 'Pseudomerge' or
 859                  $ty eq 'AddPatches') {
 860             my $found_pm = 1;
 861             $x->($furniture, (lc $ty),
 862                  "found interchange bureaucracy commit ($ty)"," ($head)");
 863         } elsif ($ty eq 'DgitImportUnpatched') {
 864             if ($found_pm) {
 865                 $x->($trouble, 'dgitimport',
 866                      "found dgit dsc import"," ($head)");
 867                 return (undef,undef);
 868             } else {
 869                 $x->($fatal, 'unprocessable',
 870                      "found bare dgit dsc import with no prior history",
 871                      " ($head)");
 872                 return (undef,undef);
 873             }
 874         } elsif ($ty eq 'VanillaMerge') {
 875             $x->($trouble, 'vanillamerge',
 876                  "found vanilla merge"," ($head)");
 877             return (undef,undef);
 878         } else {
 879             $x->($fatal, 'unprocessable',
 880                  "found unprocessable commit, cannot cope: $cl->{Why}",
 881                  " ($head)");
 882             return (undef,undef);
 883         }
 884         $head = $cl->{Parents}[0]{CommitId};
 885     }
 886     return ($anchor, $breakwater);
 887 }
 888
 889 sub walk ($;$$$);
 890 sub walk ($;$$$) {
 891     my ($input,
 892         $nogenerate,$report, $report_lprefix) = @_;
 893     # => ($tip, $breakwater_tip, $last_anchor)
 894     # (or nothing, if $nogenerate)
 895
 896     printdebug "*** WALK $input ".($nogenerate//0)." ".($report//'-')."\n";
 897     $report_lprefix //= '';
 898
 899     # go through commits backwards
 900     # we generate two lists of commits to apply:
 901     # breakwater branch and upstream patches
 902     my (@brw_cl, @upp_cl, @processed);
 903     my %found;
 904     my $upp_limit;
 905     my @pseudomerges;
 906
 907     my $cl;
 908     my $xmsg = sub {
 909         my ($prose, $info) = @_;
 910         my $ms = $cl->{Msg};
 911         chomp $ms;
 912         $info //= '';
 913         $ms .= "\n\n[git-debrebase$info: $prose]\n";
 914         return (Msg => $ms);
 915     };
 916     my $rewrite_from_here = sub {
 917         my ($cl) = @_;
 918         my $sp_cl = { SpecialMethod => 'StartRewrite' };
 919         push @$cl, $sp_cl;
 920         push @processed, $sp_cl;
 921     };
 922     my $cur = $input;
 923
 924     my $prdelim = "";
 925     my $prprdelim = sub { print $report $prdelim if $report; $prdelim=""; };
 926
 927     my $prline = sub {
 928         return unless $report;
 929         print $report $prdelim, $report_lprefix, @_;
 930         $prdelim = "\n";
 931     };
 932
 933     my $bomb = sub { # usage: return $bomb->();
 934         print $report " Unprocessable" if $report;
 935         print $report " ($cl->{Why})" if $report && defined $cl->{Why};
 936         $prprdelim->();
 937         if ($nogenerate) {
 938             return (undef,undef);
 939         }
 940         fail "found unprocessable commit, cannot cope".
 941             (defined $cl->{Why} ? "; $cl->{Why}:": ':').
 942             " (commit $cur) (d.".
 943             (join ' ', map { sprintf "%#x", $_->{Differs} }
 944              @{ $cl->{Parents} }).
 945                  ")";
 946     };
 947
 948     my $build;
 949     my $breakwater;
 950
 951     my $build_start = sub {
 952         my ($msg, $parent) = @_;
 953         $prline->(" $msg");
 954         $build = $parent;
 955         no warnings qw(exiting); last;
 956     };
 957
 958     my $nomerge = sub {
 959         fail "something useful about failed merge attempt @_ xxx".Dumper($cl);
 960     };
 961
 962     my $last_anchor;
 963
 964     for (;;) {
 965         $cl = classify $cur;
 966         my $ty = $cl->{Type};
 967         my $st = $cl->{SubType};
 968         $prline->("$cl->{CommitId} $cl->{Type}");
 969         $found{$ty. ( defined($st) ? "-$st" : '' )}++;
 970         push @processed, $cl;
 971         my $p0 = @{ $cl->{Parents} }==1 ? $cl->{Parents}[0]{CommitId} : undef;
 972         if ($ty eq 'AddPatches') {
 973             $cur = $p0;
 974             $rewrite_from_here->(\@upp_cl);
 975             next;
 976         } elsif ($ty eq 'Packaging' or $ty eq 'Changelog') {
 977             push @brw_cl, $cl;
 978             $cur = $p0;
 979             next;
 980         } elsif ($ty eq 'BreakwaterStart') {
 981             $last_anchor = $cur;
 982             $build_start->('FirstPackaging', $cur);
 983         } elsif ($ty eq 'Upstream') {
 984             push @upp_cl, $cl;
 985             $cur = $p0;
 986             next;
 987         } elsif ($ty eq 'Mixed') {
 988             my $queue = sub {
 989                 my ($q, $wh) = @_;
 990                 my $cls = { %$cl, $xmsg->("split mixed commit: $wh part") };
 991                 push @$q, $cls;
 992             };
 993             $queue->(\@brw_cl, "debian");
 994             $queue->(\@upp_cl, "upstream");
 995             $rewrite_from_here->(\@brw_cl);
 996             $cur = $p0;
 997             next;
 998         } elsif ($ty eq 'Pseudomerge') {
 999             my $contrib = $cl->{Contributor}{CommitId};
1000             print $report " Contributor=$contrib" if $report;
1001             push @pseudomerges, $cl;
1002             $rewrite_from_here->(\@upp_cl);
1003             $cur = $contrib;
1004             next;
1005         } elsif ($ty eq 'Anchor' or $ty eq 'TreatAsAnchor') {
1006             $last_anchor = $cur;
1007             $build_start->("Anchor", $cur);
1008         } elsif ($ty eq 'DgitImportUnpatched') {
1009             my $pm = $pseudomerges[-1];
1010             if (defined $pm) {
1011                 # To an extent, this is heuristic.  Imports don't have
1012                 # a useful history of the debian/ branch.  We assume
1013                 # that the first pseudomerge after an import has a
1014                 # useful history of debian/, and ignore the histories
1015                 # from later pseudomerges.  Often the first pseudomerge
1016                 # will be the dgit import of the upload to the actual
1017                 # suite intended by the non-dgit NMUer, and later
1018                 # pseudomerges may represent in-archive copies.
1019                 my $ovwrs = $pm->{Overwritten};
1020                 printf $report " PM=%s \@Overwr:%d",
1021                     $pm->{CommitId}, (scalar @$ovwrs)
1022                     if $report;
1023                 if (@$ovwrs != 1) {
1024                     printdebug "*** WALK BOMB DgitImportUnpatched\n";
1025                     return $bomb->();
1026                 }
1027                 my $ovwr = $ovwrs->[0]{CommitId};
1028                 printf $report " Overwr=%s", $ovwr if $report;
1029                 # This import has a tree which is just like a
1030                 # breakwater tree, but it has the wrong history.  It
1031                 # ought to have the previous breakwater (which the
1032                 # pseudomerge overwrote) as an ancestor.  That will
1033                 # make the history of the debian/ files correct.  As
1034                 # for the upstream version: either it's the same as
1035                 # was ovewritten (ie, same as the previous
1036                 # breakwater), in which case that history is precisely
1037                 # right; or, otherwise, it was a non-gitish upload of a
1038                 # new upstream version.  We can tell these apart by
1039                 # looking at the tree of the supposed upstream.
1040                 push @brw_cl, {
1041                     %$cl,
1042                     SpecialMethod => 'DgitImportDebianUpdate',
1043                     $xmsg->("convert dgit import: debian changes")
1044                 }, {
1045                     %$cl,
1046                     SpecialMethod => 'DgitImportUpstreamUpdate',
1047                     $xmsg->("convert dgit import: upstream update",
1048                             " anchor")
1049                 };
1050                 $prline->(" Import");
1051                 $rewrite_from_here->(\@brw_cl);
1052                 $upp_limit //= $#upp_cl; # further, deeper, patches discarded
1053                 $cur = $ovwr;
1054                 next;
1055             } else {
1056                 # Everything is from this import.  This kind of import
1057                 # is already nearly in valid breakwater format, with the
1058                 # patches as commits.  Unfortunately it contains
1059                 # debian/patches/.
1060                 printdebug "*** WALK BOMB bare dgit import\n";
1061                 $cl->{Why} = "bare dgit dsc import";
1062                 return $bomb->();
1063             }
1064             die "$ty ?";
1065         } elsif ($ty eq 'VanillaMerge' or $ty eq 'MergedBreakwaters') {
1066             # xxx need to handle ffq if one side was unstitched
1067             # wait both of them may be!
1068             my $ok=1;
1069             my $best_anchor;
1070             # We expect to find a dominating anchor amongst the
1071             # inputs' anchors.  That will be the new anchor.
1072             #
1073             # More complicated is finding a merge base for the
1074             # breakwaters.  We need a merge base that is a breakwater
1075             # commit.  The ancestors of breakwater commits are more
1076             # breakwater commits and possibly upstream commits and the
1077             # ancestors of those upstream.  Upstreams might have
1078             # arbitrary ancestors.  But any upstream commit U is
1079             # either included in both anchors, in which case the
1080             # earlier anchor is a better merge base than any of U's
1081             # ancestors; or U is not included in the older anchor, in
1082             # which case U is not an ancestor of the vanilla merge at
1083             # all.  So no upstream commit, nor any ancestor thereof,
1084             # is a best merge base.  As for non-breakwater Debian
1085             # commits: these are never ancestors of any breakwater.
1086             #
1087             # So any best merge base as found by git-merge-base
1088             # is a suitable breakwater anchor.  Usually there will
1089             # be only one.
1090
1091             printdebug "*** MERGE\n";
1092
1093             # xxx avoid calling walk without nogenerate when
1094             # we have a MergedBreakwater; instead call keycommits ?
1095
1096             my @bwbcmd = (@git, qw(merge-base));
1097             my @ibcmd = (@git, qw(merge-base --all));
1098             my $might_be_in_bw = 1;
1099
1100             my $ps = $cl->{Parents};
1101
1102             foreach my $p (@$ps) {
1103                 $prline->(" VanillaMerge ".$p->{Ix});
1104                 $prprdelim->();
1105                 my ($ptip, $pbw, $panchor) =
1106                     walk $p->{CommitId}, 0, $report,
1107                          $report_lprefix.'  ';
1108                 $p->{Laundered} = $p->{SeriesTip} = $ptip;
1109                 $p->{Breakwater} = $p->{SeriesBase} = $pbw;
1110                 $p->{Anchor} = $panchor;
1111
1112                 $best_anchor = $panchor if
1113                     !defined $best_anchor or
1114                     is_fast_fwd $best_anchor, $panchor;
1115
1116                 printdebug " MERGE BA best=".($best_anchor//'-').
1117                     " p=$panchor\n";
1118             }
1119
1120             foreach my $p (@$ps) {
1121                 $prline->(" VanillaMerge ".$p->{Ix});
1122                 if (!is_fast_fwd $p->{Anchor}, $best_anchor) {
1123                     $nomerge->('DivergentAnchor');
1124                 } elsif ($p->{Anchor} eq $best_anchor) {
1125                     print $report " SameAnchor" if $report;
1126                 } else {
1127                     print $report " SupersededAnchor" if $report;
1128                 }
1129                 if ($p->{Breakwater} eq $p->{CommitId}) {
1130                     # this parent commit was its own breakwater,
1131                     # ie it is part of the breakwater
1132                     print $report " Breakwater" if $report;
1133                 } else {
1134                     $might_be_in_bw = 0;
1135                 }
1136                 push @bwbcmd, $p->{Breakwater};
1137                 push @ibcmd, $p->{CommitId};
1138             }
1139
1140             if ($ok && $might_be_in_bw) {
1141                 $prline->(" VanillaMerge MergedBreakwaters");
1142                 $last_anchor = $best_anchor;
1143                 $build_start->('MergedBreakwaters', $cur);
1144             }
1145
1146             $nomerge->("alleged merged-breakwater is not a breakwater")
1147                 unless $ty eq 'VanillaMerge';
1148
1149             my $bwb = cmdoutput @bwbcmd;
1150
1151             # OK, now we have a breakwater base, but we need the merge
1152             # base for the interchange branch because we need the delta
1153             # queue.
1154             #
1155             # This a the best merge base of our inputs which has the
1156             # breakwater merge base as an ancestor.
1157
1158             my @ibs =
1159                 grep { is_fast_fwd $bwb, $_ }
1160                 grep /./,
1161                 split /\n/,
1162                 cmdoutput @ibcmd;
1163             my ($ib) = @ibs
1164                 or $nomerge->("no suitable interchange merge base");
1165
1166             $prline->("  VanillaMerge Base");
1167             $prprdelim->();
1168             my ($btip, $bbw, $banchor) =
1169                 walk $ib, 0, $report, $report_lprefix.'  ';
1170
1171             my $ibinfo = { SeriesTip => $btip,
1172                            SeriesBase => $bbw,
1173                            Anchor => $banchor };
1174             $bbw eq $bwb
1175                 or $nomerge->("interchange merge-base ($ib)'s".
1176                               " breakwater ($bbw)".
1177                               " != breakwaters' merge-base ($bwb)");
1178             grep { $_->{Anchor} eq $ibinfo->{Anchor} } @$ps
1179                  or $nomerge->("interchange merge-base ($ib)'s".
1180                                " anchor ($ibinfo->{SeriesBase})".
1181                                " != any merge input's anchor (".
1182                                (join ' ', map { $_->{Anchor} } @$ps).
1183                                ")");
1184
1185
1186             $cl->{MergeInterchangeBaseInfo} = $ibinfo;
1187             $cl->{MergeBestAnchor} = $best_anchor;
1188             push @brw_cl, {
1189                 %$cl,
1190                 SpecialMethod => 'MergeCreateMergedBreakwaters',
1191                 $xmsg->('construct merged breakwater from vanilla merge'),
1192             };
1193             push @upp_cl, {
1194                 %$cl,
1195                 SpecialMethod => 'MergeMergeSeries',
1196             };
1197             $build_start->('MergeBreakwaters', $cur);
1198         } else {
1199             printdebug "*** WALK BOMB unrecognised\n";
1200             return $bomb->();
1201         }
1202     }
1203     $prprdelim->();
1204
1205     printdebug "*** WALK prep done cur=$cur".
1206         " brw $#brw_cl upp $#upp_cl proc $#processed pm $#pseudomerges\n";
1207
1208     return if $nogenerate;
1209
1210     # Now we build it back up again
1211
1212     fresh_workarea();
1213
1214     my $rewriting = 0;
1215
1216     $#upp_cl = $upp_limit if defined $upp_limit;
1217
1218     my $committer_authline = calculate_committer_authline();
1219
1220     printdebug "WALK REBUILD $build ".(scalar @processed)."\n";
1221
1222     confess "internal error" unless $build eq (pop @processed)->{CommitId};
1223
1224     in_workarea sub {
1225         mkdir $rd or $!==EEXIST or die $!;
1226         my $current_method;
1227         runcmd @git, qw(read-tree), $build;
1228         foreach my $cl (qw(Debian), (reverse @brw_cl),
1229                         { SpecialMethod => 'RecordBreakwaterTip' },
1230                         qw(Upstream), (reverse @upp_cl)) {
1231             if (!ref $cl) {
1232                 $current_method = $cl;
1233                 next;
1234             }
1235             my $method = $cl->{SpecialMethod} // $current_method;
1236             my @parents = ($build);
1237             my $cltree = $cl->{CommitId};
1238             printdebug "WALK BUILD ".($cltree//'undef').
1239                 " $method (rewriting=$rewriting)\n";
1240             if ($method eq 'Debian') {
1241                 read_tree_debian($cltree);
1242             } elsif ($method eq 'Upstream') {
1243                 read_tree_upstream($cltree);
1244             } elsif ($method eq 'StartRewrite') {
1245                 $rewriting = 1;
1246                 next;
1247             } elsif ($method eq 'RecordBreakwaterTip') {
1248                 $breakwater = $build;
1249                 next;
1250             } elsif ($method eq 'DgitImportDebianUpdate') {
1251                 read_tree_debian($cltree);
1252             } elsif ($method eq 'DgitImportUpstreamUpdate') {
1253                 confess unless $rewriting;
1254                 my $differs = (get_differs $build, $cltree);
1255                 next unless $differs & D_UPS;
1256                 read_tree_upstream($cltree);
1257                 push @parents, map { $_->{CommitId} } @{ $cl->{OrigParents} };
1258             } elsif ($method eq 'MergeCreateMergedBreakwaters') {
1259                 print "Found a general merge, will try to tidy it up.\n";
1260                 $rewriting = 1;
1261                 read_tree_upstream($cl->{MergeBestAnchor});
1262                 read_tree_upstream($cl->{MergeBestAnchor});
1263                 read_tree_debian($cltree);
1264                 @parents = map { $_->{Breakwater} } @{ $cl->{Parents} };
1265             } elsif ($method eq 'MergeMergeSeries') {
1266                 print "Running merge resolution for $cl->{CommitId}...\n";
1267                 $build = merge_series
1268                     $build,
1269                     $cl->{MergeInterchangeBaseInfo},
1270                     @{ $cl->{Parents} };
1271                 $last_anchor = $cl->{MergeBestAnchor};
1272                 # xxx need to check the tree somehow
1273                 print "Merge resolution successful.\n";
1274                 next;
1275             } else {
1276                 confess "$method ?";
1277             }
1278             if (!$rewriting) {
1279                 my $procd = (pop @processed) // 'UNDEF';
1280                 if ($cl ne $procd) {
1281                     $rewriting = 1;
1282                     printdebug "WALK REWRITING NOW cl=$cl procd=$procd\n";
1283                 }
1284             }
1285             my $newtree = cmdoutput @git, qw(write-tree);
1286             my $ch = $cl->{Hdr};
1287             $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?";
1288             $ch =~ s{^parent .*\n}{}mg;
1289             $ch =~ s{(?=^author)}{
1290                 join '', map { "parent $_\n" } @parents
1291             }me or confess "$ch ?";
1292             if ($rewriting) {
1293                 $ch =~ s{^committer .*$}{$committer_authline}m
1294                     or confess "$ch ?";
1295             }
1296             my $cf = "$rd/m$rewriting";
1297             open CD, ">", $cf or die $!;
1298             print CD $ch, "\n", $cl->{Msg} or die $!;
1299             close CD or die $!;
1300             my @cmd = (@git, qw(hash-object));
1301             push @cmd, qw(-w) if $rewriting;
1302             push @cmd, qw(-t commit), $cf;
1303             my $newcommit = cmdoutput @cmd;
1304             confess "$ch ?" unless $rewriting or $newcommit eq $cl->{CommitId};
1305             $build = $newcommit;
1306             if (grep { $method eq $_ } qw(DgitImportUpstreamUpdate)) {
1307                 $last_anchor = $cur;
1308             }
1309         }
1310     };
1311
1312     my $final_check = get_differs $build, $input;
1313     die sprintf "internal error %#x %s %s", $final_check, $build, $input
1314         if $final_check & ~D_PAT_ADD;
1315
1316     my @r = ($build, $breakwater, $last_anchor);
1317     printdebug "*** WALK RETURN @r\n";
1318     return @r
1319 }
1320
1321 sub get_head () {
1322     git_check_unmodified();
1323     return git_rev_parse qw(HEAD);
1324 }
1325
1326 sub update_head ($$$) {
1327     my ($old, $new, $mrest) = @_;
1328     push @deferred_updates, "update HEAD $new $old";
1329     run_deferred_updates $mrest;
1330 }
1331
1332 sub update_head_checkout ($$$) {
1333     my ($old, $new, $mrest) = @_;
1334     update_head $old, $new, $mrest;
1335     runcmd @git, qw(reset --hard);
1336 }
1337
1338 sub update_head_postlaunder ($$$) {
1339     my ($old, $tip, $reflogmsg) = @_;
1340     return if $tip eq $old;
1341     print "git-debrebase: laundered (head was $old)\n";
1342     update_head $old, $tip, $reflogmsg;
1343     # no tree changes except debian/patches
1344     runcmd @git, qw(rm --quiet --ignore-unmatch -rf debian/patches);
1345 }
1346
1347 sub currently_rebasing() {
1348     foreach (qw(rebase-merge rebase-apply)) {
1349         return 1 if stat_exists "$maindir_gitdir/$_";
1350     }
1351     return 0;
1352 }
1353
1354 sub bail_if_rebasing() {
1355     fail "you are in the middle of a git-rebase already"
1356         if currently_rebasing();
1357 }
1358
1359 sub do_launder_head ($) {
1360     my ($reflogmsg) = @_;
1361     my $old = get_head();
1362     record_ffq_auto();
1363     my ($tip,$breakwater) = walk $old;
1364     snags_maybe_bail();
1365     update_head_postlaunder $old, $tip, $reflogmsg;
1366     return ($tip,$breakwater);
1367 }
1368
1369 sub cmd_launder_v0 () {
1370     badusage "no arguments to launder-v0 allowed" if @ARGV;
1371     my $old = get_head();
1372     my ($tip,$breakwater,$last_anchor) = walk $old;
1373     update_head_postlaunder $old, $tip, 'launder';
1374     printf "# breakwater tip\n%s\n", $breakwater;
1375     printf "# working tip\n%s\n", $tip;
1376     printf "# last anchor\n%s\n", $last_anchor;
1377 }
1378
1379 sub defaultcmd_rebase () {
1380     push @ARGV, @{ $opt_defaultcmd_interactive // [] };
1381     my ($tip,$breakwater) = do_launder_head 'launder for rebase';
1382     runcmd @git, qw(rebase), @ARGV, $breakwater if @ARGV;
1383 }
1384
1385 sub cmd_analyse () {
1386     badusage "analyse does not support any options"
1387         if @ARGV and $ARGV[0] =~ m/^-/;
1388     badusage "too many arguments to analyse" if @ARGV>1;
1389     my ($old) = @ARGV;
1390     if (defined $old) {
1391         $old = git_rev_parse $old;
1392     } else {
1393         $old = git_rev_parse 'HEAD';
1394     }
1395     my ($dummy,$breakwater) = walk $old, 1,*STDOUT;
1396     STDOUT->error and die $!;
1397 }
1398
1399 sub ffq_prev_branchinfo () {
1400     my $current = git_get_symref();
1401     return gdr_ffq_prev_branchinfo($current);
1402 }
1403
1404 sub ffq_check ($;$$) {
1405     # calls $ff and/or $notff zero or more times
1406     # then returns either (status,message) where status is
1407     #    exists
1408     #    detached
1409     #    weird-symref
1410     #    notbranch
1411     # or (undef,undef, $ffq_prev,$gdrlast)
1412     # $ff and $notff are called like this:
1413     #   $ff->("message for stdout\n");
1414     #   $notff->('snag-name', $message);
1415     # normally $currentval should be HEAD
1416     my ($currentval, $ff, $notff) =@_;
1417
1418     $ff //= sub { print $_[0] or die $!; };
1419     $notff //= \&snag;
1420
1421     my ($status, $message, $current, $ffq_prev, $gdrlast)
1422         = ffq_prev_branchinfo();
1423     return ($status, $message) unless $status eq 'branch';
1424
1425     my $exists = git_get_ref $ffq_prev;
1426     return ('exists',"$ffq_prev already exists") if $exists;
1427
1428     return ('not-branch', 'HEAD symref is not to refs/heads/')
1429         unless $current =~ m{^refs/heads/};
1430     my $branch = $';
1431
1432     my @check_specs = split /\;/, (cfg "branch.$branch.ffq-ffrefs",1) // '*';
1433     my %checked;
1434
1435     printdebug "ffq check_specs @check_specs\n";
1436
1437     my $check = sub {
1438         my ($lrref, $desc) = @_;
1439         printdebug "ffq might check $lrref ($desc)\n";
1440         my $invert;
1441         for my $chk (@check_specs) {
1442             my $glob = $chk;
1443             $invert = $glob =~ s{^[!^]}{};
1444             last if fnmatch $glob, $lrref;
1445         }
1446         return if $invert;
1447         my $lrval = git_get_ref $lrref;
1448         return unless length $lrval;
1449
1450         if (is_fast_fwd $lrval, $currentval) {
1451             $ff->("OK, you are ahead of $lrref\n");
1452             $checked{$lrref} = 1;
1453         } elsif (is_fast_fwd $currentval, $lrval) {
1454             $checked{$lrref} = -1;
1455             $notff->('behind', "you are behind $lrref, divergence risk");
1456         } else {
1457             $checked{$lrref} = -1;
1458             $notff->('diverged', "you have diverged from $lrref");
1459         }
1460     };
1461
1462     my $merge = cfg "branch.$branch.merge",1;
1463     if (defined $merge and $merge =~ m{^refs/heads/}) {
1464         my $rhs = $';
1465         printdebug "ffq merge $rhs\n";
1466         my $check_remote = sub {
1467             my ($remote, $desc) = @_;
1468             printdebug "ffq check_remote ".($remote//'undef')." $desc\n";
1469             return unless defined $remote;
1470             $check->("refs/remotes/$remote/$rhs", $desc);
1471         };
1472         $check_remote->((scalar cfg "branch.$branch.remote",1),
1473                         'remote fetch/merge branch');
1474         $check_remote->((scalar cfg "branch.$branch.pushRemote",1) //
1475                         (scalar cfg "branch.$branch.pushDefault",1),
1476                         'remote push branch');
1477     }
1478     if ($branch =~ m{^dgit/}) {
1479         $check->("refs/remotes/dgit/$branch", 'remote dgit branch');
1480     } elsif ($branch =~ m{^master$}) {
1481         $check->("refs/remotes/dgit/dgit/sid", 'remote dgit branch for sid');
1482     }
1483     return (undef, undef, $ffq_prev, $gdrlast);
1484 }
1485
1486 sub record_ffq_prev_deferred () {
1487     # => ('status', "message")
1488     # 'status' may be
1489     #    deferred          message is undef
1490     #    exists
1491     #    detached
1492     #    weird-symref
1493     #    notbranch
1494     # if not ff from some branch we should be ff from, is an snag
1495     # if "deferred", will have added something about that to
1496     #   @deferred_update_messages, and also maybe printed (already)
1497     #   some messages about ff checks
1498     bail_if_rebasing();
1499     my $currentval = get_head();
1500
1501     my ($status,$message, $ffq_prev,$gdrlast) = ffq_check $currentval;
1502     return ($status,$message) if defined $status;
1503
1504     snags_maybe_bail();
1505
1506     push @deferred_updates, "update $ffq_prev $currentval $git_null_obj";
1507     push @deferred_updates, "delete $gdrlast";
1508     push @deferred_update_messages, "Recorded previous head for preservation";
1509     return ('deferred', undef);
1510 }
1511
1512 sub record_ffq_auto () {
1513     my ($status, $message) = record_ffq_prev_deferred();
1514     if ($status eq 'deferred' || $status eq 'exists') {
1515     } else {
1516         snag $status, "could not record ffq-prev: $message";
1517         snags_maybe_bail();
1518     }
1519 }
1520
1521 sub ffq_prev_info () {
1522     bail_if_rebasing();
1523     # => ($ffq_prev, $gdrlast, $ffq_prev_commitish)
1524     my ($status, $message, $current, $ffq_prev, $gdrlast)
1525         = ffq_prev_branchinfo();
1526     if ($status ne 'branch') {
1527         snag $status, "could not check ffq-prev: $message";
1528         snags_maybe_bail();
1529     }
1530     my $ffq_prev_commitish = $ffq_prev && git_get_ref $ffq_prev;
1531     return ($ffq_prev, $gdrlast, $ffq_prev_commitish);
1532 }
1533
1534 sub stitch ($$$$$) {
1535     my ($old_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose) = @_;
1536
1537     push @deferred_updates, "delete $ffq_prev $ffq_prev_commitish";
1538
1539     if (is_fast_fwd $old_head, $ffq_prev_commitish) {
1540         my $differs = get_differs $old_head, $ffq_prev_commitish;
1541         unless ($differs & ~D_PAT_ADD) {
1542             # ffq-prev is ahead of us, and the only tree changes it has
1543             # are possibly addition of things in debian/patches/.
1544             # Just wind forwards rather than making a pointless pseudomerge.
1545             push @deferred_updates,
1546                 "update $gdrlast $ffq_prev_commitish $git_null_obj";
1547             update_head_checkout $old_head, $ffq_prev_commitish,
1548                 "stitch (fast forward)";
1549             return;
1550         }
1551     }
1552     fresh_workarea();
1553     # We make pseudomerges with L as the contributing parent.
1554     # This makes git rev-list --first-parent work properly.
1555     my $new_head = make_commit [ $old_head, $ffq_prev ], [
1556         'Declare fast forward / record previous work',
1557         "[git-debrebase pseudomerge: $prose]",
1558     ];
1559     push @deferred_updates, "update $gdrlast $new_head $git_null_obj";
1560     update_head $old_head, $new_head, "stitch: $prose";
1561 }
1562
1563 sub do_stitch ($;$) {
1564     my ($prose, $unclean) = @_;
1565
1566     my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
1567     if (!$ffq_prev_commitish) {
1568         fail "No ffq-prev to stitch." unless $opt_noop_ok;
1569         return;
1570     }
1571     my $dangling_head = get_head();
1572
1573     keycommits $dangling_head, $unclean,$unclean,$unclean;
1574     snags_maybe_bail();
1575
1576     stitch($dangling_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose);
1577 }
1578
1579 sub upstream_commitish_search ($$) {
1580     my ($upstream_version, $tried) = @_;
1581     # todo: at some point maybe use git-deborig to do this
1582     foreach my $tagpfx ('', 'v', 'upstream/') {
1583         my $tag = $tagpfx.(dep14_version_mangle $upstream_version);
1584         my $new_upstream = git_get_ref "refs/tags/$tag";
1585         push @$tried, $tag;
1586         return $new_upstream if length $new_upstream;
1587     }
1588 }
1589
1590 sub resolve_upstream_version ($$) {
1591     my ($new_upstream, $upstream_version) = @_;
1592
1593     if (!defined $new_upstream) {
1594         my @tried;
1595         $new_upstream = upstream_commitish_search $upstream_version, \@tried;
1596         if (!length $new_upstream) {
1597             fail "Could not determine appropriate upstream commitish.\n".
1598                 " (Tried these tags: @tried)\n".
1599                 " Check version, and specify upstream commitish explicitly.";
1600         }
1601     }
1602     $new_upstream = git_rev_parse $new_upstream;
1603
1604     return $new_upstream;
1605 }
1606
1607 sub cmd_new_upstream () {
1608     # automatically and unconditionally launders before rebasing
1609     # if rebase --abort is used, laundering has still been done
1610
1611     my %pieces;
1612
1613     badusage "need NEW-VERSION [UPS-COMMITTISH]" unless @ARGV >= 1;
1614
1615     # parse args - low commitment
1616     my $spec_version = shift @ARGV;
1617     my $new_version = (new Dpkg::Version $spec_version, check => 1);
1618     fail "bad version number \`$spec_version'" unless defined $new_version;
1619     if ($new_version->is_native()) {
1620         $new_version = (new Dpkg::Version "$spec_version-1", check => 1);
1621     }
1622
1623     my $new_upstream = shift @ARGV;
1624     my $new_upstream_version = upstreamversion  $new_version;
1625     $new_upstream =
1626         resolve_upstream_version $new_upstream, $new_upstream_version;
1627
1628     record_ffq_auto();
1629
1630     my $piece = sub {
1631         my ($n, @x) = @_; # may be ''
1632         my $pc = $pieces{$n} //= {
1633             Name => $n,
1634             Desc => ($n ? "upstream piece \`$n'" : "upstream (main piece"),
1635         };
1636         while (my $k = shift @x) { $pc->{$k} = shift @x; }
1637         $pc;
1638     };
1639
1640     my @newpieces;
1641     my $newpiece = sub {
1642         my ($n, @x) = @_; # may be ''
1643         my $pc = $piece->($n, @x, NewIx => (scalar @newpieces));
1644         push @newpieces, $pc;
1645     };
1646
1647     $newpiece->('',
1648         OldIx => 0,
1649         New => $new_upstream,
1650     );
1651     while (@ARGV && $ARGV[0] !~ m{^-}) {
1652         my $n = shift @ARGV;
1653
1654         badusage "for each EXTRA-UPS-NAME need EXTRA-UPS-COMMITISH"
1655             unless @ARGV && $ARGV[0] !~ m{^-};
1656
1657         my $c = git_rev_parse shift @ARGV;
1658         die unless $n =~ m/^$extra_orig_namepart_re$/;
1659         $newpiece->($n, New => $c);
1660     }
1661
1662     # now we need to investigate the branch this generates the
1663     # laundered version but we don't switch to it yet
1664     my $old_head = get_head();
1665     my ($old_laundered_tip,$old_bw,$old_anchor) = walk $old_head;
1666
1667     my $old_bw_cl = classify $old_bw;
1668     my $old_anchor_cl = classify $old_anchor;
1669     my $old_upstream;
1670     if (!$old_anchor_cl->{OrigParents}) {
1671         snag 'anchor-treated',
1672             'old anchor is recognised due to --anchor, cannot check upstream';
1673     } else {
1674         $old_upstream = parsecommit
1675             $old_anchor_cl->{OrigParents}[0]{CommitId};
1676         $piece->('', Old => $old_upstream->{CommitId});
1677     }
1678
1679     if ($old_upstream && $old_upstream->{Msg} =~ m{^\[git-debrebase }m) {
1680         if ($old_upstream->{Msg} =~
1681  m{^\[git-debrebase upstream-combine (\.(?: $extra_orig_namepart_re)+)\:.*\]$}m
1682            ) {
1683             my @oldpieces = (split / /, $1);
1684             my $old_n_parents = scalar @{ $old_upstream->{Parents} };
1685             if ($old_n_parents != @oldpieces &&
1686                 $old_n_parents != @oldpieces + 1) {
1687                 snag 'upstream-confusing', sprintf
1688                     "previous upstream combine %s".
1689                     " mentions %d pieces (each implying one parent)".
1690                     " but has %d parents".
1691                     " (one per piece plus maybe a previous combine)",
1692                     $old_upstream->{CommitId},
1693                     (scalar @oldpieces),
1694                     $old_n_parents;
1695             } elsif ($oldpieces[0] ne '.') {
1696                 snag 'upstream-confusing', sprintf
1697                     "previous upstream combine %s".
1698                     " first piece is not \`.'",
1699                     $oldpieces[0];
1700             } else {
1701                 $oldpieces[0] = '';
1702                 foreach my $i (0..$#oldpieces) {
1703                     my $n = $oldpieces[$i];
1704                     my $hat = 1 + $i + ($old_n_parents - @oldpieces);
1705                     $piece->($n, Old => $old_upstream->{CommitId}.'^'.$hat);
1706                 }
1707             }
1708         } else {
1709             snag 'upstream-confusing',
1710                 "previous upstream $old_upstream->{CommitId} is from".
1711                " git-debrebase but not an \`upstream-combine' commit";
1712         }
1713     }
1714
1715     foreach my $pc (values %pieces) {
1716         if (!$old_upstream) {
1717             # we have complained already
1718         } elsif (!$pc->{Old}) {
1719             snag 'upstream-new-piece',
1720                 "introducing upstream piece \`$pc->{Name}'";
1721         } elsif (!$pc->{New}) {
1722             snag 'upstream-rm-piece',
1723                 "dropping upstream piece \`$pc->{Name}'";
1724         } elsif (!is_fast_fwd $pc->{Old}, $pc->{New}) {
1725             snag 'upstream-not-ff',
1726                 "not fast forward: $pc->{Name} $pc->{Old}..$pc->{New}";
1727         }
1728     }
1729
1730     printdebug "%pieces = ", (dd \%pieces), "\n";
1731     printdebug "\@newpieces = ", (dd \@newpieces), "\n";
1732
1733     snags_maybe_bail();
1734
1735     my $new_bw;
1736
1737     fresh_workarea();
1738     in_workarea sub {
1739         my @upstream_merge_parents;
1740
1741         if (!any_snags()) {
1742             push @upstream_merge_parents, $old_upstream->{CommitId};
1743         }
1744
1745         foreach my $pc (@newpieces) { # always has '' first
1746             if ($pc->{Name}) {
1747                 read_tree_subdir $pc->{Name}, $pc->{New};
1748             } else {
1749                 runcmd @git, qw(read-tree), $pc->{New};
1750             }
1751             push @upstream_merge_parents, $pc->{New};
1752         }
1753
1754         # index now contains the new upstream
1755
1756         if (@newpieces > 1) {
1757             # need to make the upstream subtree merge commit
1758             $new_upstream = make_commit \@upstream_merge_parents,
1759                 [ "Combine upstreams for $new_upstream_version",
1760  ("[git-debrebase upstream-combine . ".
1761  (join " ", map { $_->{Name} } @newpieces[1..$#newpieces]).
1762  ": new upstream]"),
1763                 ];
1764         }
1765
1766         # $new_upstream is either the single upstream commit, or the
1767         # combined commit we just made.  Either way it will be the
1768         # "upstream" parent of the anchor merge.
1769
1770         read_tree_subdir 'debian', "$old_bw:debian";
1771
1772         # index now contains the anchor merge contents
1773         $new_bw = make_commit [ $old_bw, $new_upstream ],
1774             [ "Update to upstream $new_upstream_version",
1775  "[git-debrebase anchor: new upstream $new_upstream_version, merge]",
1776             ];
1777
1778         my $clogsignoff = cmdoutput qw(git show),
1779             '--pretty=format:%an <%ae>  %aD',
1780             $new_bw;
1781
1782         # Now we have to add a changelog stanza so the Debian version
1783         # is right.
1784         die if unlink "debian";
1785         die $! unless $!==ENOENT or $!==ENOTEMPTY;
1786         unlink "debian/changelog" or $!==ENOENT or die $!;
1787         mkdir "debian" or die $!;
1788         open CN, ">", "debian/changelog" or die $!;
1789         my $oldclog = git_cat_file ":debian/changelog";
1790         $oldclog =~ m/^($package_re) \(\S+\) / or
1791             fail "cannot parse old changelog to get package name";
1792         my $p = $1;
1793         print CN <<END, $oldclog or die $!;
1794 $p ($new_version) UNRELEASED; urgency=medium
1795
1796   * Update to new upstream version $new_upstream_version.
1797
1798  -- $clogsignoff
1799
1800 END
1801         close CN or die $!;
1802         runcmd @git, qw(update-index --add --replace), 'debian/changelog';
1803
1804         # Now we have the final new breakwater branch in the index
1805         $new_bw = make_commit [ $new_bw ],
1806             [ "Update changelog for new upstream $new_upstream_version",
1807               "[git-debrebase: new upstream $new_upstream_version, changelog]",
1808             ];
1809     };
1810
1811     # we have constructed the new breakwater. we now need to commit to
1812     # the laundering output, because git-rebase can't easily be made
1813     # to make a replay list which is based on some other branch
1814
1815     update_head_postlaunder $old_head, $old_laundered_tip,
1816         'launder for new upstream';
1817
1818     my @cmd = (@git, qw(rebase --onto), $new_bw, $old_bw, @ARGV);
1819     local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg
1820         "debrebase new-upstream $new_version: rebase";
1821     runcmd @cmd;
1822     # now it's for the user to sort out
1823 }
1824
1825 sub cmd_record_ffq_prev () {
1826     badusage "no arguments allowed" if @ARGV;
1827     my ($status, $msg) = record_ffq_prev_deferred();
1828     if ($status eq 'exists' && $opt_noop_ok) {
1829         print "Previous head already recorded\n" or die $!;
1830     } elsif ($status eq 'deferred') {
1831         run_deferred_updates 'record-ffq-prev';
1832     } else {
1833         fail "Could not preserve: $msg";
1834     }
1835 }
1836
1837 sub cmd_anchor () {
1838     badusage "no arguments allowed" if @ARGV;
1839     my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
1840     print "$bw\n" or die $!;
1841 }
1842
1843 sub cmd_breakwater () {
1844     badusage "no arguments allowed" if @ARGV;
1845     my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
1846     print "$bw\n" or die $!;
1847 }
1848
1849 sub cmd_status () {
1850     badusage "no arguments allowed" if @ARGV;
1851
1852     # todo: gdr status should print divergence info
1853     # todo: gdr status should print upstream component(s) info
1854     # todo: gdr should leave/maintain some refs with this kind of info ?
1855
1856     my $oldest = { Badness => 0 };
1857     my $newest;
1858     my $note = sub {
1859         my ($badness, $ourmsg, $snagname, $dummy, $cl, $kcmsg) = @_;
1860         if ($oldest->{Badness} < $badness) {
1861             $oldest = $newest = undef;
1862         }
1863         $oldest = {
1864                    Badness => $badness,
1865                    CommitId => $cl->{CommitId},
1866                    OurMsg => $ourmsg,
1867                    KcMsg => $kcmsg,
1868                   };
1869         $newest //= $oldest;
1870     };
1871     my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'),
1872         sub { $note->(1, 'branch contains furniture (not laundered)', @_); },
1873         sub { $note->(2, 'branch is unlaundered', @_); },
1874         sub { $note->(3, 'branch needs laundering', @_); },
1875         sub { $note->(4, 'branch not in git-debrebase form', @_); };
1876
1877     my $prcommitinfo = sub {
1878         my ($cid) = @_;
1879         flush STDOUT or die $!;
1880         runcmd @git, qw(--no-pager log -n1),
1881             '--pretty=format:    %h %s%n',
1882             $cid;
1883     };
1884
1885     print "current branch contents, in git-debrebase terms:\n";
1886     if (!$oldest->{Badness}) {
1887         print "  branch is laundered\n";
1888     } else {
1889         print "  $oldest->{OurMsg}\n";
1890         my $printed = '';
1891         foreach my $info ($oldest, $newest) {
1892             my $cid = $info->{CommitId};
1893             next if $cid eq $printed;
1894             $printed = $cid;
1895             print "  $info->{KcMsg}\n";
1896             $prcommitinfo->($cid);
1897         }
1898     }
1899
1900     my $prab = sub {
1901         my ($cid, $what) = @_;
1902         if (!defined $cid) {
1903             print "  $what is not well-defined\n";
1904         } else {
1905             print "  $what\n";
1906             $prcommitinfo->($cid);
1907         }
1908     };
1909     print "key git-debrebase commits:\n";
1910     $prab->($anchor, 'anchor');
1911     $prab->($bw, 'breakwater');
1912
1913     my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) =
1914         ffq_prev_branchinfo();
1915
1916     print "branch and ref status, in git-debrebase terms:\n";
1917     if ($ffq_msg) {
1918         print "  $ffq_msg\n";
1919     } else {
1920         $ffq_prev = git_get_ref $ffq_prev;
1921         $gdrlast = git_get_ref $gdrlast;
1922         if ($ffq_prev) {
1923             print "  unstitched; previous tip was:\n";
1924             $prcommitinfo->($ffq_prev);
1925         } elsif (!$gdrlast) {
1926             print "  stitched? (no record of git-debrebase work)\n";
1927         } elsif (is_fast_fwd $gdrlast, 'HEAD') {
1928             print "  stitched\n";
1929         } else {
1930             print "  not git-debrebase (diverged since last stitch)\n"
1931         }
1932     }
1933     print "you are currently rebasing\n" if currently_rebasing();
1934 }
1935
1936 sub cmd_stitch () {
1937     my $prose = 'stitch';
1938     getoptions("stitch",
1939                'prose=s', \$prose);
1940     badusage "no arguments allowed" if @ARGV;
1941     do_stitch $prose, 0;
1942 }
1943 sub cmd_prepush () { cmd_stitch(); }
1944
1945 sub cmd_quick () {
1946     badusage "no arguments allowed" if @ARGV;
1947     do_launder_head 'launder for git-debrebase quick';
1948     do_stitch 'quick';
1949 }
1950
1951 sub cmd_conclude () {
1952     my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
1953     if (!$ffq_prev_commitish) {
1954         fail "No ongoing git-debrebase session." unless $opt_noop_ok;
1955         return;
1956     }
1957     my $dangling_head = get_head();
1958
1959     badusage "no arguments allowed" if @ARGV;
1960     do_launder_head 'launder for git-debrebase quick';
1961     do_stitch 'quick';
1962 }
1963
1964 sub cmd_scrap () {
1965     if (currently_rebasing()) {
1966         runcmd @git, qw(rebase --abort);
1967     }
1968     my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
1969     if (!$ffq_prev_commitish) {
1970         fail "No ongoing git-debrebase session." unless $opt_noop_ok;
1971         finish 0;
1972     }
1973     my $scrapping_head = get_head();
1974     badusage "no arguments allowed" if @ARGV;
1975     push @deferred_updates,
1976         "update $gdrlast $ffq_prev_commitish $git_null_obj",
1977         "update $ffq_prev $git_null_obj $ffq_prev_commitish";
1978     snags_maybe_bail();
1979     update_head_checkout $scrapping_head, $ffq_prev_commitish, "scrap";
1980 }
1981
1982 sub make_patches_staged ($) {
1983     my ($head) = @_;
1984     # Produces the patches that would result from $head if it were
1985     # laundered.
1986     my ($secret_head, $secret_bw, $last_anchor) = walk $head;
1987     fresh_workarea();
1988     in_workarea sub {
1989         gbp_pq_export 'bw', $secret_bw, $secret_head;
1990     };
1991 }
1992
1993 sub make_patches ($) {
1994     my ($head) = @_;
1995     keycommits $head, 0, \&snag;
1996     make_patches_staged $head;
1997     my $out;
1998     in_workarea sub {
1999         my $ptree = cmdoutput @git, qw(write-tree --prefix=debian/patches/);
2000         runcmd @git, qw(read-tree), $head;
2001         read_tree_subdir 'debian/patches', $ptree;
2002         $out = make_commit [$head], [
2003             'Commit patch queue (exported by git-debrebase)',
2004             '[git-debrebase: export and commit patches]',
2005         ];
2006     };
2007     return $out;
2008 }
2009
2010 sub cmd_make_patches () {
2011     my $opt_quiet_would_amend;
2012     getoptions("make-patches",
2013                'quiet-would-amend!', \$opt_quiet_would_amend);
2014     badusage "no arguments allowed" if @ARGV;
2015     bail_if_rebasing();
2016     my $old_head = get_head();
2017     my $new = make_patches $old_head;
2018     my $d = get_differs $old_head, $new;
2019     if ($d == 0) {
2020         fail "No (more) patches to export." unless $opt_noop_ok;
2021         return;
2022     } elsif ($d == D_PAT_ADD) {
2023         snags_maybe_bail();
2024         update_head_checkout $old_head, $new, 'make-patches';
2025     } else {
2026         print STDERR failmsg
2027             "Patch export produced patch amendments".
2028             " (abandoned output commit $new).".
2029             "  Try laundering first."
2030             unless $opt_quiet_would_amend;
2031         finish 7;
2032     }
2033 }
2034
2035 sub cmd_convert_from_gbp () {
2036     badusage "want only 1 optional argument, the upstream git commitish"
2037         unless @ARGV<=1;
2038
2039     my $clogp = parsechangelog();
2040     my $version = $clogp->{'Version'}
2041         // die "missing Version from changelog";
2042
2043     my ($upstream_spec) = @ARGV;
2044
2045     my $upstream_version = upstreamversion $version;
2046     my $upstream =
2047         resolve_upstream_version($upstream_spec, $upstream_version);
2048
2049     my $old_head = get_head();
2050
2051     my $upsdiff = get_differs $upstream, $old_head;
2052     if ($upsdiff & D_UPS) {
2053         runcmd @git, qw(--no-pager diff --stat),
2054             $upstream, $old_head,
2055             qw( -- :!/debian :/);
2056         fail <<END;
2057 upstream ($upstream_spec) and HEAD are not
2058 identical in upstream files.  See diffstat above, or run
2059   git diff $upstream_spec HEAD -- :!/debian :/
2060 END
2061     }
2062
2063     if (!is_fast_fwd $upstream, $old_head) {
2064         snag 'upstream-not-ancestor',
2065             "upstream ($upstream) is not an ancestor of HEAD";
2066     } else {
2067         my $wrong = cmdoutput
2068             (@git, qw(rev-list --ancestry-path), "$upstream..HEAD",
2069              qw(-- :/ :!/debian));
2070         if (length $wrong) {
2071             snag 'unexpected-upstream-changes',
2072                 "history between upstream ($upstream) and HEAD contains direct changes to upstream files - are you sure this is a gbp (patches-unapplied) branch?";
2073             print STDERR "list expected changes with:  git log --stat --ancestry-path $upstream_spec..HEAD -- :/ ':!/debian'\n";
2074         }
2075     }
2076
2077     if ((git_cat_file "$upstream:debian")[0] ne 'missing') {
2078         snag 'upstream-has-debian',
2079             "upstream ($upstream) contains debian/ directory";
2080     }
2081
2082     my $previous_dgit_view = eval {
2083         my @clogcmd = qw(dpkg-parsechangelog --format rfc822 -n2);
2084         my ($lvsn, $suite);
2085         parsechangelog_loop \@clogcmd, 'debian/changelog', sub {
2086             my ($stz, $desc) = @_;
2087             no warnings qw(exiting);
2088             printdebug 'CHANGELOG ', Dumper($desc, $stz);
2089             next unless $stz->{Date};
2090             next unless $stz->{Distribution} ne 'UNRELEASED';
2091             $lvsn = $stz->{Version};
2092             $suite = $stz->{Distribution};
2093             last;
2094         };
2095         die "neither of the first two changelog entries are released\n"
2096             unless defined $lvsn;
2097         print "last finished-looking changelog entry: ($lvsn) $suite\n";
2098         my $mtag_pat = debiantag_maintview $lvsn, '*';
2099         my $mtag = cmdoutput @git, qw(describe --always --abbrev=0 --match),
2100             $mtag_pat;
2101         die "could not find suitable maintainer view tag $mtag_pat\n"
2102             unless $mtag_pat =~ m{/};
2103         is_fast_fwd $mtag, 'HEAD' or
2104             die "HEAD is not FF from maintainer tag $mtag!";
2105         my $dtag = "archive/$mtag";
2106         is_fast_fwd $mtag, $dtag or
2107             die "dgit view tag $dtag is not FF from maintainer tag $mtag";
2108         print "will stitch in dgit view, $dtag\n";
2109         git_rev_parse $dtag;
2110     };
2111     if (!$previous_dgit_view) {
2112         $@ =~ s/^\n+//;
2113         chomp $@;
2114         print STDERR "cannot stitch in dgit view: $@\n";
2115     }
2116
2117     snags_maybe_bail_early();
2118
2119     my $work;
2120
2121     fresh_workarea();
2122     in_workarea sub {
2123         runcmd @git, qw(checkout -q -b gdr-internal), $old_head;
2124         # make a branch out of the patch queue - we'll want this in a mo
2125         runcmd qw(gbp pq import);
2126         # strip the patches out
2127         runcmd @git, qw(checkout -q gdr-internal~0);
2128         rm_subdir_cached 'debian/patches';
2129         $work = make_commit ['HEAD'], [
2130  'git-debrebase convert-from-gbp: drop patches from tree',
2131  'Delete debian/patches, as part of converting to git-debrebase format.',
2132  '[git-debrebase convert-from-gbp: drop patches from tree]'
2133                               ];
2134         # make the anchor merge
2135         # the tree is already exactly right
2136         $work = make_commit [$work, $upstream], [
2137  'git-debrebase import: declare upstream',
2138  'First breakwater merge.',
2139  '[git-debrebase anchor: declare upstream]'
2140                               ];
2141
2142         # rebase the patch queue onto the new breakwater
2143         runcmd @git, qw(reset --quiet --hard patch-queue/gdr-internal);
2144         runcmd @git, qw(rebase --quiet --onto), $work, qw(gdr-internal);
2145         $work = git_rev_parse 'HEAD';
2146
2147         if ($previous_dgit_view) {
2148             $work = make_commit [$work, $previous_dgit_view], [
2149  'git-debrebase import: declare ff from dgit archive view',
2150  '[git-debrebase pseudomerge: import-from-gbp]',
2151             ];
2152         }
2153     };
2154
2155     ffq_check $work;
2156     snags_maybe_bail();
2157     update_head_checkout $old_head, $work, 'convert-from-gbp';
2158 }
2159
2160 sub cmd_convert_to_gbp () {
2161     badusage "no arguments allowed" if @ARGV;
2162     my $head = get_head();
2163     my (undef, undef, undef, $ffq, $gdrlast) = ffq_prev_branchinfo();
2164     keycommits $head, 0;
2165     my $out;
2166     make_patches_staged $head;
2167     in_workarea sub {
2168         $out = make_commit ['HEAD'], [
2169             'Commit patch queue (converted from git-debrebase format)',
2170             '[git-debrebase convert-to-gbp: commit patches]',
2171         ];
2172     };
2173     if (defined $ffq) {
2174         push @deferred_updates, "delete $ffq";
2175         push @deferred_updates, "delete $gdrlast";
2176     }
2177     snags_maybe_bail();
2178     update_head_checkout $head, $out, "convert to gbp (v0)";
2179     print <<END or die $!;
2180 git-debrebase: converted to git-buildpackage branch format
2181 git-debrebase: WARNING: do not now run "git-debrebase" any more
2182 git-debrebase: WARNING: doing so would drop all upstream patches!
2183 END
2184 }
2185
2186 sub cmd_convert_from_dgit_view () {
2187     my $clogp = parsechangelog();
2188
2189     my $bpd = (cfg 'dgit.default.build-products-dir',1) // '..';
2190     my $do_origs = 1;
2191     my $do_tags = 1;
2192     my $always = 0;
2193     my $diagnose = 0;
2194
2195     getoptions("convert-from-dgit-view",
2196                'diagnose!', \$diagnose,
2197                'build-products-dir:s', \$bpd,
2198                'origs!', \$do_origs,
2199                'tags!', \$do_tags,
2200                'always-convert-anyway!', \$always);
2201     fail "takes 1 optional argument, the upstream commitish" if @ARGV>1;
2202
2203     my @upstreams;
2204
2205     if (@ARGV) {
2206         my $spec = shift @ARGV;
2207         my $commit = git_rev_parse "$spec^{commit}";
2208         push @upstreams, { Commit => $commit,
2209                            Source => "$ARGV[0], from command line",
2210                            Only => 1,
2211                          };
2212     }
2213
2214     my $head = get_head();
2215
2216     if (!$always) {
2217         my $troubles = 0;
2218         my $trouble = sub { $troubles++; };
2219         keycommits $head, sub{}, sub{}, $trouble, $trouble;
2220         printdebug "troubles=$troubles\n";
2221         if (!$troubles) {
2222             print STDERR <<END;
2223 $us: Branch already seems to be in git-debrebase format!
2224 $us: --always-convert-anyway would do the conversion operation anyway
2225 $us: but is probably a bad idea.  Probably, you wanted to do nothing.
2226 END
2227             fail "Branch already in git-debrebase format." unless $opt_noop_ok;
2228             finish 0;
2229         }
2230     }
2231
2232     snags_maybe_bail_early();
2233
2234     my $version = upstreamversion $clogp->{Version};
2235     print STDERR "Considering possible commits corresponding to upstream:\n";
2236
2237     if (!@upstreams) {
2238         if ($do_tags) {
2239             my @tried;
2240             my $ups_tag = upstream_commitish_search $version, \@tried;
2241             if ($ups_tag) {
2242                 my $this = "git tag $tried[-1]";
2243                 push @upstreams, { Commit => $ups_tag,
2244                                    Source => $this,
2245                                  };
2246             } else {
2247                 printf STDERR
2248                     " git tag: no suitable tag found (tried %s)\n",
2249                     "@tried";
2250             }
2251         }
2252         if ($do_origs) {
2253             my $p = $clogp->{'Source'};
2254             # we do a quick check to see if there are plausible origs
2255             my $something=0;
2256             if (!opendir BPD, $bpd) {
2257                 die "$bpd: opendir: $!" unless $!==ENOENT;
2258             } else {
2259                 while ($!=0, my $f = readdir BPD) {
2260                     next unless is_orig_file_of_p_v $f, $p, $version;
2261                     printf STDERR
2262                         " orig: found what looks like a .orig, %s\n",
2263                         "$bpd/$f";
2264                     $something=1;
2265                     last;
2266                 }
2267                 die "read $bpd: $!" if $!;
2268                 closedir BPD;
2269             }
2270             if ($something) {
2271                 my $tree = cmdoutput
2272                     @dgit, qw(--build-products-dir), $bpd,
2273                     qw(print-unapplied-treeish);
2274                 fresh_workarea();
2275                 in_workarea sub {
2276                     runcmd @git, qw(reset --quiet), $tree, qw(-- .);
2277                     rm_subdir_cached 'debian';
2278                     $tree = cmdoutput @git, qw(write-tree);
2279                     my $ups_synth = make_commit [], [ <<END, <<END,
2280 Import effective orig tree for upstream version $version
2281 END
2282 This includes the contents of the .orig(s), minus any debian/ directory.
2283
2284 [git-debrebase import-from-dgit-view upstream-import-convert: $version]
2285 END
2286                                                     ];
2287                     push @upstreams, { Commit => $ups_synth,
2288                                        Source => "orig(s) imported via dgit",
2289                                      };
2290                 }
2291             } else {
2292                 printf STDERR
2293                     " orig: no suitable origs found (looked for %s in %s)\n",
2294                     "${p}_".(stripeoch $version)."...", $bpd;
2295             }
2296         }
2297     }
2298
2299     my $some_patches = stat_exists 'debian/patches/series';
2300
2301     print STDERR "Evaluating possible commits corresponding to upstream:\n";
2302
2303     my $result;
2304     foreach my $u (@upstreams) {
2305         my $work = $head;
2306         fresh_workarea();
2307         in_workarea sub {
2308             runcmd @git, qw(reset --quiet), $u->{Commit}, qw(-- .);
2309             runcmd @git, qw(checkout), $u->{Commit}, qw(-- .);
2310             runcmd @git, qw(clean -xdff);
2311             runcmd @git, qw(checkout), $head, qw(-- debian);
2312             if ($some_patches) {
2313                 rm_subdir_cached 'debian/patches';
2314                 $work = make_commit [ $work ], [
2315  'git-debrebase convert-from-dgit-view: drop upstream changes from breakwater',
2316  "Drop upstream changes, and delete debian/patches, as part of converting\n".
2317  "to git-debrebase format.  Upstream changes will appear as commits.",
2318  '[git-debrebase convert-from-dgit-view: drop patches from tree]'
2319                                            ];
2320             }
2321             $work = make_commit [ $work, $u->{Commit} ], [
2322  'git-debrebase convert-from-dgit-view: declare upstream',
2323  '(Re)constructed breakwater merge.',
2324  '[git-debrebase anchor: declare upstream]'
2325                                                          ];
2326             runcmd @git, qw(checkout --quiet -b mk), $work;
2327             if ($some_patches) {
2328                 runcmd @git, qw(checkout), $head, qw(-- debian/patches);
2329                 runcmd @git, qw(reset --quiet);
2330                 my @gbp_cmd = (qw(gbp pq import));
2331                 if (!$diagnose) {
2332                     my $gbp_err = "../gbp-pq-err";
2333                     @gbp_cmd = shell_cmd "exec >$gbp_err 2>&1", @gbp_cmd;
2334                 }
2335                 my $r = system @gbp_cmd;
2336                 if ($r) {
2337                     printf STDERR
2338                         " %s: couldn't apply patches: gbp pq %s",
2339                         $u->{Source}, waitstatusmsg();
2340                     return;
2341                 }
2342             }
2343             my $work = git_rev_parse qw(HEAD);
2344             my $diffout = cmdoutput @git, qw(diff-tree --stat HEAD), $work;
2345             if (length $diffout) {
2346                 print STDERR
2347                     " $u->{Source}: applying patches gives different tree\n";
2348                 print STDERR $diffout if $diagnose;
2349                 return;
2350             }
2351             # OMG!
2352             $u->{Result} = $work;
2353             $result = $u;
2354         };
2355         last if $result;
2356     }
2357
2358     if (!$result) {
2359         fail <<END;
2360 Could not find or construct a suitable upstream commit.
2361 Rerun adding --diagnose after convert-from-dgit-view, or pass a
2362 upstream commmit explicitly or provide suitable origs.
2363 END
2364     }
2365
2366     printf STDERR "Yes, will base new branch on %s\n", $result->{Source};
2367
2368     ffq_check $result->{Result};
2369     snags_maybe_bail();
2370     update_head_checkout $head, $result->{Result},
2371         'convert-from-dgit-view';
2372 }
2373
2374 sub cmd_downstream_rebase_launder_v0 () {
2375     badusage "needs 1 argument, the baseline" unless @ARGV==1;
2376     my ($base) = @ARGV;
2377     $base = git_rev_parse $base;
2378     my $old_head = get_head();
2379     my $current = $old_head;
2380     my $topmost_keep;
2381     for (;;) {
2382         if ($current eq $base) {
2383             $topmost_keep //= $current;
2384             print " $current BASE stop\n";
2385             last;
2386         }
2387         my $cl = classify $current;
2388         print " $current $cl->{Type}";
2389         my $keep = 0;
2390         my $p0 = $cl->{Parents}[0]{CommitId};
2391         my $next;
2392         if ($cl->{Type} eq 'Pseudomerge') {
2393             print " ^".($cl->{Contributor}{Ix}+1);
2394             $next = $cl->{Contributor}{CommitId};
2395         } elsif ($cl->{Type} eq 'AddPatches' or
2396                  $cl->{Type} eq 'Changelog') {
2397             print " strip";
2398             $next = $p0;
2399         } else {
2400             print " keep";
2401             $next = $p0;
2402             $keep = 1;
2403         }
2404         print "\n";
2405         if ($keep) {
2406             $topmost_keep //= $current;
2407         } else {
2408             die "to-be stripped changes not on top of the branch\n"
2409                 if $topmost_keep;
2410         }
2411         $current = $next;
2412     }
2413     if ($topmost_keep eq $old_head) {
2414         print "unchanged\n";
2415     } else {
2416         print "updating to $topmost_keep\n";
2417         update_head_checkout
2418             $old_head, $topmost_keep,
2419             'downstream-rebase-launder-v0';
2420     }
2421 }
2422
2423 getoptions_main
2424           ("bad options\n",
2425            "D+" => \$debuglevel,
2426            'noop-ok', => \$opt_noop_ok,
2427            'f=s' => \@snag_force_opts,
2428            'anchor=s' => \@opt_anchors,
2429            '--dgit=s' => \($dgit[0]),
2430            'force!',
2431            '-i:s' => sub {
2432                my ($opt,$val) = @_;
2433                badusage "git-debrebase: no cuddling to -i for git-rebase"
2434                    if length $val;
2435                die if $opt_defaultcmd_interactive; # should not happen
2436                $opt_defaultcmd_interactive = [ qw(-i) ];
2437                # This access to @ARGV is excessive familiarity with
2438                # Getopt::Long, but there isn't another sensible
2439                # approach.  '-i=s{0,}' does not work with bundling.
2440                push @$opt_defaultcmd_interactive, @ARGV;
2441                @ARGV=();
2442            },
2443            'help' => sub { print $usage_message or die $!; finish 0; },
2444            );
2445
2446 initdebug('git-debrebase ');
2447 enabledebug if $debuglevel;
2448
2449 my $toplevel = cmdoutput @git, qw(rev-parse --show-toplevel);
2450 chdir $toplevel or die "chdir $toplevel: $!";
2451
2452 $rd = fresh_playground "$playprefix/misc";
2453
2454 @opt_anchors = map { git_rev_parse $_ } @opt_anchors;
2455
2456 if (!@ARGV || $opt_defaultcmd_interactive || $ARGV[0] =~ m{^-}) {
2457     defaultcmd_rebase();
2458 } else {
2459     my $cmd = shift @ARGV;
2460     my $cmdfn = $cmd;
2461     $cmdfn =~ y/-/_/;
2462     $cmdfn = ${*::}{"cmd_$cmdfn"};
2463
2464     $cmdfn or badusage "unknown git-debrebase sub-operation $cmd";
2465     $cmdfn->();
2466 }
2467
2468 finish 0;