+ my ($laundered_tip,$breakwater) = walk $old;
+
+ my $breakwater_cl = classify $breakwater;
+ my $old_orig = parsecommit $breakwater_cl->{OrigParents}[0]{CommitId};
+
+ my $problems = 0;
+ my $problem = sub {
+ my ($msg) = @_;
+ $problems++;
+ print STDERR "preflight check failed: $msg\n";
+ };
+
+ $piece->('', Old => $old_orig);
+
+ if ($old_orig_ci =~ m{^\[git-debrebase }m) {
+ if ($old_orig_ci =~
+ m{^\[git-debrebase new-upstream combine \.((?: $extra_orig_namepart_re)+)\]}
+ ) {
+ my @oldpieces = ('', split / /, $1);
+ my $parentix = -1 + scalar @{ $old_orig->{Parents} };
+ foreach my $i (0..$#$oldpieces) {
+ my $n = $oldpieces[$i];
+ $piece->($n, Old => $old_orig.'^'.$parentix);
+ }
+ } else {
+ $problem->("previous upstream $old_orig->{CommitId} is from".
+ " git-debrebase but not a \`new-upstream combine' commit");
+ }
+ }
+
+ foreach my $pc (values %pieces) {
+ if (!$pc->{Old}) {
+ $problem->("introducing upstream piece $pc->{Name}");
+ } elsif (!$pc->{New}) {
+ $problem->("dropping upstream piece $pc->{Name}");
+ } elsif (!is_fast_fwd $pc->{Old}, $pc->{New}) {
+ $problem->("not fast forward: $pc->{Name} $pc->{Old}..$pc->{New}");
+ }
+ }
+
+ if ($problems) {
+ if ($opt_force) {
+ printf STDERR
+ "preflight check failures (%d) overriden by --force\n",
+ $problems;
+ } else {
+ fail sprintf
+ "preflight check failures (%d) (you could --force)",
+ $problems;
+ }
+ }
+
+ fresh_workarea();
+ in_workarea sub {
+ my @upstream_merge_parents;
+
+ if (!$problems) {
+ push @upstream_merge_parents, $old_orig->{CommitId};
+ }
+
+ foreach my $pc (@newpieces) { # always has '' first
+ if ($pc->{Name}) {
+ read_tree_subdir $pcname, $pc->{New];
+ } else {
+ runcmd @git, qw(read-tree), $pc->{New};
+ }
+ push @upstream_merge_parents, $pc->{New};
+ }
+
+ # index now contains the new upstream
+
+ if (@newpieces > 1) {
+ # need to make the upstream subtree merge commit
+ my $us_tree = cmdoutput @git, qw(write-tree);
+ my @cmd = (@git, qw(commit-tree), $us_tree);
+ push @cmd, qw(-p), $_ foreach @upstream_merge_parents;
+ push @cmd, qw(-m), "Combine upstreams for $new_upstream_version";
+ push @cmd, qw(-m),
+ "[git-debrebase new-upstream combine . ".
+ (join " ", map { $_->{Name} } @newpieces[1..$#newpieces]).
+ "]";
+ $new_upstream = cmdoutput @cmd;
+ }
+
+ # $new_upstream is either the single upstream commit, or the
+ # combined commit we just made. Either way it will be the
+ # "upstream" parent of the breakwater special merge.
+
+ read_tree_subdir 'debian', "$breakwater:debian";
+
+ # index now contains the breakwater merge contents
+
+ my $bw_tree = cmdoutput @git, qw(write_tree);
+ my @cmd = (@git, qw(commit-tree), $bw_tree);
+ push @cmd, qw(-p), $breakwater, qw(-p), $new_upstream;
+ push @cmd, qw(-m), "Update to upstream $new_upstream_version";
+ push @cmd, qw(-m),
+ "[git-debrebase new-upstream breakwater $new_upstream_version]";
+ my $new_bw = cmdoutput @git;
+
+ # Now we have to add a changelog stanza so the Debian version
+ # is right.
+
+ die if unlink "debian";
+ die unless $!==ENOTEMPTY;
+ unlink "debian/changelog" or die $!;
+ open CN, ">", "debian/changelog" or die $!;
+ my $oldclog = git_cat_file ":debian/changelog";
+ $oldclog =~ m/^($package_re) \(\S+\) / or
+ fail "cannot parse old changelog to get package name";
+ my $p = $1;
+ print CN, <<END, $oldclog or die $!;
+$p ($new_version) UNRELEASED; urgency=medium
+
+ * Update to new upstream version $new_upstream_version.
+
+ --
+
+END
+ close CN or die $!;
+ runcmd @git, qw(update-index --add --replace), 'debian/changelog';
+
+ # Now we have the final new breakwater branch in the index
+
+ $bw_tree = cmdoutput @git, qw(write_tree);
+ @cmd = (@git, qw(commit-tree), $bw_tree);
+ push @cmd, qw(-p), $new_bw;
+ push @cmd, qw(-m),
+ "Update changelog for new upstream $new_upstream_version";
+ push @cmd, qw(-m),
+ "[git-debrebase new-upstream changelog $new_upstream_version]";
+ $new_bw = cmdoutput @git;
+
+
+ update_head
+ xxx check new orig version is reasonable;
+ xxx decorate new orig version to get new debian version;
+
+
+sub cmd_downstream_rebase_launder_v0 () {
+ badusage "needs 1 argument, the baseline" unless @ARGV==1;
+ my ($base) = @ARGV;
+ $base = git_rev_parse $base;
+ my $old_head = get_head();
+ my $current = $old_head;
+ my $topmost_keep;
+ for (;;) {
+ if ($current eq $base) {
+ $topmost_keep //= $current;
+ print " $current BASE stop\n";
+ last;
+ }
+ my $cl = classify $current;
+ print " $current $cl->{Type}";
+ my $keep = 0;
+ my $p0 = $cl->{Parents}[0]{CommitId};
+ my $next;
+ if ($cl->{Type} eq 'Pseudomerge') {
+ print " ^".($cl->{Contributor}{Ix}+1);
+ $next = $cl->{Contributor}{CommitId};
+ } elsif ($cl->{Type} eq 'AddPatches' or
+ $cl->{Type} eq 'Changelog') {
+ print " strip";
+ $next = $p0;
+ } else {
+ print " keep";
+ $next = $p0;
+ $keep = 1;
+ }
+ print "\n";
+ if ($keep) {
+ $topmost_keep //= $current;
+ } else {
+ die "to-be stripped changes not on top of the branch\n"
+ if $topmost_keep;
+ }
+ $current = $next;
+ }
+ if ($topmost_keep eq $old_head) {
+ print "unchanged\n";
+ } else {
+ print "updating to $topmost_keep\n";
+ update_head_checkout
+ $old_head, $topmost_keep,
+ 'downstream-rebase-launder-v0';
+ }