+sub D_UPS () { 0x02; } # upstream files
+sub D_PAT_ADD () { 0x04; } # debian/patches/ extra patches at end
+sub D_PAT_OTH () { 0x08; } # debian/patches other changes
+sub D_DEB_CLOG () { 0x10; } # debian/ (not patches/ or changelog)
+sub D_DEB_OTH () { 0x20; } # debian/changelog
+sub DS_DEB () { D_DEB_CLOG | D_DEB_OTH; } # debian/ (not patches/)
+
+our $playprefix = 'debrebase';
+our $rd;
+our $workarea;
+
+our @git = qw(git);
+
+sub in_workarea ($) {
+ my ($sub) = @_;
+ changedir $workarea;
+ my $r = eval { $sub->(); };
+ { local $@; changedir $maindir; }
+ die $@ if $@;
+}
+
+sub fresh_workarea () {
+ $workarea = fresh_playground "$playprefix/work";
+ in_workarea sub { playtree_setup };
+}
+
+our @deferred_updates;
+our @deferred_update_messages;
+
+sub run_deferred_updates ($) {
+ my ($mrest) = @_;
+
+ my @upd_cmd = (@git, qw(update-ref --stdin -m), "debrebase: $mrest");
+ debugcmd '>|', @upd_cmd;
+ open U, "|-", @upd_cmd or die $!;
+ foreach (@deferred_updates) {
+ printdebug ">= ", $_, "\n";
+ print U $_, "\n" or die $!;
+ }
+ printdebug ">\$\n";
+ close U or failedcmd @upd_cmd;
+
+ print $_, "\n" foreach @deferred_update_messages;
+
+ @deferred_updates = ();
+ @deferred_update_messages = ();
+}
+
+sub get_differs ($$) {
+ my ($x,$y) = @_;
+ # This resembles quiltify_trees_differ, in dgit, a bit.
+ # But we don't care about modes, or dpkg-source-unrepresentable
+ # changes, and we don't need the plethora of different modes.
+ # Conversely we need to distinguish different kinds of changes to
+ # debian/ and debian/patches/.
+
+ my $differs = 0;
+
+ my $rundiff = sub {
+ my ($opts, $limits, $fn) = @_;
+ my @cmd = (@git, qw(diff-tree -z --no-renames));
+ push @cmd, @$opts;
+ push @cmd, "$_:" foreach $x, $y;
+ push @cmd, '--', @$limits;
+ my $diffs = cmdoutput @cmd;
+ foreach (split /\0/, $diffs) { $fn->(); }
+ };
+
+ $rundiff->([qw(--name-only)], [], sub {
+ $differs |= $_ eq 'debian' ? DS_DEB : D_UPS;
+ });
+
+ if ($differs & DS_DEB) {
+ $differs &= ~DS_DEB;
+ $rundiff->([qw(--name-only -r)], [qw(debian)], sub {
+ $differs |=
+ m{^debian/patches/} ? D_PAT_OTH :
+ $_ eq 'debian/changelog' ? D_DEB_CLOG :
+ D_DEB_OTH;
+ });
+ die "mysterious debian changes $x..$y"
+ unless $differs & (D_PAT_OTH|DS_DEB);
+ }
+
+ if ($differs & D_PAT_OTH) {
+ my $mode;
+ $differs &= ~D_PAT_OTH;
+ my $pat_oth = sub {
+ $differs |= D_PAT_OTH;
+ no warnings qw(exiting); last;
+ };
+ $rundiff->([qw(--name-status -r)], [qw(debian/patches/)], sub {
+ no warnings qw(exiting);
+ if (!defined $mode) {
+ $mode = $_; next;
+ }
+ die unless s{^debian/patches/}{};
+ my $ok;
+ if ($mode eq 'A' && !m/\.series$/s) {
+ $ok = 1;
+ } elsif ($mode eq 'M' && $_ eq 'series') {
+ my $x_s = (git_cat_file "$x:debian/patches/series", 'blob');
+ my $y_s = (git_cat_file "$y:debian/patches/series", 'blob');
+ chomp $x_s; $x_s .= "\n";
+ $ok = $x_s eq substr($y_s, 0, length $x_s);
+ } else {
+ # nope
+ }
+ $mode = undef;
+ $differs |= $ok ? D_PAT_ADD : D_PAT_OTH;
+ });
+ die "mysterious debian/patches changes $x..$y"
+ unless $differs & (D_PAT_ADD|D_PAT_OTH);
+ }
+
+ printdebug sprintf "get_differs %s, %s = %#x\n", $x, $y, $differs;
+
+ return $differs;
+}
+
+sub commit_pr_info ($) {
+ my ($r) = @_;
+ return Data::Dumper->dump([$r], [qw(commit)]);
+}
+
+sub calculate_committer_authline () {
+ my $c = cmdoutput @git, qw(commit-tree --no-gpg-sign -m),
+ 'DUMMY COMMIT (git-debrebase)', "HEAD:";
+ my ($h,$m) = get_commit $c;
+ $h =~ m/^committer .*$/m or confess "($h) ?";
+ return $&;
+}
+
+sub rm_subdir_cached ($) {
+ my ($subdir) = @_;
+ runcmd @git, qw(rm --quiet -rf --cached --ignore-unmatch), $subdir;
+}
+
+sub read_tree_subdir ($$) {
+ my ($subdir, $new_tree_object) = @_;
+ rm_subdir_cached $subdir;
+ runcmd @git, qw(read-tree), "--prefix=$subdir/", $new_tree_object;
+}
+
+sub make_commit ($$) {
+ my ($parents, $message_paras) = @_;
+ my $tree = cmdoutput @git, qw(write-tree);
+ my @cmd = (@git, qw(commit-tree), $tree);
+ push @cmd, qw(-p), $_ foreach @$parents;
+ push @cmd, qw(-m), $_ foreach @$message_paras;
+ return cmdoutput @cmd;
+}
+
+our @snag_force_opts;
+our $snags_forced;
+our $snags_tripped;
+sub snag ($$) {
+ my ($tag,$msg) = @_;
+ if (grep { $_ eq $tag } @snag_force_opts) {
+ $snags_forced++;
+ print STDERR "git-debrebase: snag ignored (-f$tag): $msg\n";
+ } else {
+ $snags_tripped++;
+ print STDERR "git-debrebase: snag detected (-f$tag): $msg\n";
+ }
+}
+
+sub snags_maybe_bail () {
+ if ($snags_forced) {
+ printf STDERR
+ "%s: snags: %d overriden by individual -f options\n",
+ $us, $snags_forced;
+ }
+ if ($snags_tripped) {
+ if ($opt_force) {
+ printf STDERR
+ "%s: snags: %d overriden by global --force\n",
+ $us, $snags_tripped;
+ } else {
+ fail sprintf
+ "%s: snags: %d blockers (you could -f<tag>, or --force)",
+ $us, $snags_tripped;
+ }
+ }
+}
+sub any_snags () {
+ return $snags_forced || $snags_tripped;
+}
+
+# classify returns an info hash like this
+# CommitId => $objid
+# Hdr => # commit headers, including 1 final newline
+# Msg => # commit message (so one newline is dropped)
+# Tree => $treeobjid
+# Type => (see below)
+# Parents = [ {
+# Ix => $index # ie 0, 1, 2, ...
+# CommitId
+# Differs => return value from get_differs
+# IsOrigin
+# IsDggitImport => 'orig' 'tarball' 'unpatched' 'package' (as from dgit)
+# } ...]
+# NewMsg => # commit message, but with any [dgit import ...] edited
+# # to say "[was: ...]"
+#
+# Types:
+# Packaging
+# Changelog
+# Upstream
+# AddPatches
+# Mixed
+#
+# Pseudomerge
+# has additional entres in classification result
+# Overwritten = [ subset of Parents ]
+# Contributor = $the_remaining_Parent
+#
+# DgitImportUnpatched
+# has additional entry in classification result
+# OrigParents = [ subset of Parents ]
+#
+# Anchor
+# has additional entry in classification result
+# OrigParents = [ subset of Parents ] # singleton list
+#
+# TreatAsAnchor
+#
+# BreakwaterStart
+#
+# Unknown
+# has additional entry in classification result
+# Why => "prose"
+
+sub parsecommit ($;$) {
+ my ($objid, $p_ref) = @_;
+ # => hash with CommitId Hdr Msg Tree Parents
+ # Parents entries have only Ix CommitId
+ # $p_ref, if provided, must be [] and is used as a base for Parents
+
+ $p_ref //= [];
+ die if @$p_ref;
+
+ my ($h,$m) = get_commit $objid;
+
+ my ($t) = $h =~ m/^tree (\w+)$/m or die $objid;
+ my (@ph) = $h =~ m/^parent (\w+)$/mg;
+
+ my $r = {
+ CommitId => $objid,
+ Hdr => $h,
+ Msg => $m,
+ Tree => $t,
+ Parents => $p_ref,
+ };
+
+ foreach my $ph (@ph) {
+ push @$p_ref, {
+ Ix => scalar @$p_ref,
+ CommitId => $ph,
+ };
+ }
+
+ return $r;
+}
+
+sub classify ($) {
+ my ($objid) = @_;
+
+ my @p;
+ my $r = parsecommit($objid, \@p);
+ my $t = $r->{Tree};
+
+ foreach my $p (@p) {
+ $p->{Differs} = (get_differs $p->{CommitId}, $t),
+ }
+
+ printdebug "classify $objid \$t=$t \@p",
+ (map { sprintf " %s/%#x", $_->{CommitId}, $_->{Differs} } @p),
+ "\n";
+
+ my $classify = sub {
+ my ($type, @rest) = @_;
+ $r = { %$r, Type => $type, @rest };
+ if ($debuglevel) {
+ printdebug " = $type ".(dd $r)."\n";
+ }
+ return $r;
+ };
+ my $unknown = sub {
+ my ($why) = @_;
+ $r = { %$r, Type => qw(Unknown), Why => $why };
+ printdebug " ** Unknown\n";
+ return $r;
+ };
+
+ if (grep { $_ eq $objid } @opt_anchors) {
+ return $classify->('TreatAsAnchor');
+ }
+
+ my @identical = grep { !$_->{Differs} } @p;
+ my ($stype, $series) = git_cat_file "$t:debian/patches/series";
+ my $haspatches = $stype ne 'missing' && $series =~ m/^\s*[^#\n\t ]/m;
+
+ if ($r->{Msg} =~ m{^\[git-debrebase anchor.*\]$}m) {
+ # multi-orig upstreams are represented with an anchor merge
+ # from a single upstream commit which combines the orig tarballs
+
+ # Every anchor tagged this way must be a merge.
+ # We are relying on the
+ # [git-debrebase anchor: ...]
+ # commit message annotation in "declare" anchor merges (which
+ # do not have any upstream changes), to distinguish those
+ # anchor merges from ordinary pseudomerges (which we might
+ # just try to strip).
+ #
+ # However, the user is going to be doing git-rebase a lot. We
+ # really don't want them to rewrite an anchor commit.
+ # git-rebase trips up on merges, so that is a useful safety
+ # catch.
+ #
+ # BreakwaterStart commits are also anchors in the terminology
+ # of git-debrebase(5), but they are untagged (and always
+ # manually generated).
+ #
+ # We cannot not tolerate any tagged linear commit (ie,
+ # BreakwaterStart commits tagged `[anchor:') because such a
+ # thing could result from an erroneous linearising raw git
+ # rebase of a merge anchor. That would represent a corruption
+ # of the branch. and we want to detect and reject the results
+ # of such corruption before it makes it out anywhere. If we
+ # reject it here then we avoid making the pseudomerge which
+ # would be needed to push it.
+
+ my $badanchor = sub { $unknown->("git-debrebase \`anchor' but @_"); };
+ @p == 2 or return $badanchor->("has other than two parents");
+ $haspatches and return $badanchor->("contains debian/patches");
+
+ # How to decide about l/r ordering of anchors ? git
+ # --topo-order prefers to expand 2nd parent first. There's
+ # already an easy rune to look for debian/ history anyway (git log
+ # debian/) so debian breakwater branch should be 1st parent; that
+ # way also there's also an easy rune to look for the upstream
+ # patches (--topo-order).
+
+ $p[0]{IsOrigin} and $badanchor->("is an origin commit");
+ $p[1]{Differs} & ~DS_DEB and
+ $badanchor->("upstream files differ from left parent");
+ $p[0]{Differs} & ~D_UPS and
+ $badanchor->("debian/ differs from right parent");
+
+ return $classify->(qw(Anchor),
+ OrigParents => [ $p[1] ]);
+ }
+
+ if (@p == 1) {
+ my $d = $r->{Parents}[0]{Differs};
+ if ($d == D_PAT_ADD) {
+ return $classify->(qw(AddPatches));
+ } elsif ($d & (D_PAT_ADD|D_PAT_OTH)) {
+ return $unknown->("edits debian/patches");
+ } elsif ($d & DS_DEB and !($d & ~DS_DEB)) {
+ my ($ty,$dummy) = git_cat_file "$p[0]{CommitId}:debian";
+ if ($ty eq 'tree') {
+ if ($d == D_DEB_CLOG) {
+ return $classify->(qw(Changelog));
+ } else {
+ return $classify->(qw(Packaging));
+ }
+ } elsif ($ty eq 'missing') {
+ return $classify->(qw(BreakwaterStart));
+ } else {
+ return $unknown->("parent's debian is not a directory");
+ }
+ } elsif ($d == D_UPS) {
+ return $classify->(qw(Upstream));
+ } elsif ($d & DS_DEB and $d & D_UPS and !($d & ~(DS_DEB|D_UPS))) {
+ return $classify->(qw(Mixed));
+ } elsif ($d == 0) {
+ return $unknown->("no changes");
+ } else {
+ confess "internal error $objid ?";
+ }
+ }
+ if (!@p) {
+ return $unknown->("origin commit");
+ }
+
+ if (@p == 2 && @identical == 1) {
+ my @overwritten = grep { $_->{Differs} } @p;
+ confess "internal error $objid ?" unless @overwritten==1;
+ return $classify->(qw(Pseudomerge),
+ Overwritten => [ $overwritten[0] ],
+ Contributor => $identical[0]);
+ }
+ if (@p == 2 && @identical == 2) {
+ my $get_t = sub {
+ my ($ph,$pm) = get_commit $_[0]{CommitId};
+ $ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
+ $1;
+ };
+ my @bytime = @p;
+ my $order = $get_t->($bytime[0]) <=> $get_t->($bytime[1]);
+ if ($order > 0) { # newer first
+ } elsif ($order < 0) {
+ @bytime = reverse @bytime;
+ } else {
+ # same age, default to order made by -s ours
+ # that is, commit was made by someone who preferred L
+ }
+ return $classify->(qw(Pseudomerge),
+ SubType => qw(Ambiguous),
+ Contributor => $bytime[0],
+ Overwritten => [ $bytime[1] ]);
+ }
+ foreach my $p (@p) {
+ my ($p_h, $p_m) = get_commit $p->{CommitId};
+ $p->{IsOrigin} = $p_h !~ m/^parent \w+$/m;
+ ($p->{IsDgitImport},) = $p_m =~ m/^\[dgit import ([0-9a-z]+) .*\]$/m;
+ }
+ my @orig_ps = grep { ($_->{IsDgitImport}//'X') eq 'orig' } @p;
+ my $m2 = $r->{Msg};
+ if (!(grep { !$_->{IsOrigin} } @p) and
+ (@orig_ps >= @p - 1) and
+ $m2 =~ s{^\[(dgit import unpatched .*)\]$}{[was: $1]}m) {
+ $r->{NewMsg} = $m2;
+ return $classify->(qw(DgitImportUnpatched),
+ OrigParents => \@orig_ps);
+ }
+
+ return $unknown->("complex merge");
+}
+
+sub keycommits ($;$$$) {
+ my ($head, $furniture, $unclean, $trouble) = @_;
+ # => ($anchor, $breakwater)
+
+ # $unclean->("unclean-$tagsfx", $msg)
+ # $furniture->("unclean-$tagsfx", $msg)
+ # $dgitimport->("unclean-$tagsfx", $msg)
+ # is callled for each situation or commit that
+ # wouldn't be found in a laundered branch
+ # $furniture is for furniture commits such as might be found on an
+ # interchange branch (pseudomerge, d/patches, changelog)
+ # $trouble is for things whnich prevent the return of
+ # anchor and breakwater information; if that is ignored,
+ # then keycommits returns (undef, undef) instead.
+ #
+ # If a callback is undef, fail is called instead.
+ # If a callback is defined but false, the situation is ignored.
+ # Callbacks may say:
+ # no warnings qw(exiting); last;
+ # if the answer is no longer wanted.
+
+ my ($anchor, $breakwater);
+ my $clogonly;
+ my $x = sub {
+ my ($cb, $tagsfx, $why) = @_;
+ my $m = "branch needs laundering (run git-debrebase): $why";
+ fail $m unless defined $cb;
+ return unless $cb;
+ $cb->("unclean-$tagsfx", $why);
+ };
+ for (;;) {
+ my $cl = classify $head;
+ my $ty = $cl->{Type};
+ if ($ty eq 'Packaging') {
+ $breakwater //= $clogonly;
+ $breakwater //= $head;
+ } elsif ($ty eq 'Changelog') {
+ # this is going to count as the tip of the breakwater
+ # only if it has no upstream stuff before it
+ $clogonly //= $head;
+ } elsif ($ty eq 'Anchor' or
+ $ty eq 'TreatAsAnchor' or
+ $ty eq 'BreakwaterStart') {
+ $anchor = $head;
+ $breakwater //= $clogonly;
+ $breakwater //= $head;
+ last;
+ } elsif ($ty eq 'Upstream') {
+ $x->($unclean, 'ordering',
+ "packaging change ($breakwater) follows upstream change (eg $head)")
+ if defined $breakwater;
+ $clogonly = undef;
+ $breakwater = undef;
+ } elsif ($ty eq 'Mixed') {
+ $x->($unclean, 'mixed',
+ 'found mixed upstream/packaging commit ($head)');
+ $clogonly = undef;
+ $breakwater = undef;
+ } elsif ($ty eq 'Pseudomerge' or
+ $ty eq 'AddPatches') {
+ $x->($furniture, (lc $ty),
+ "found interchange bureaucracy commit ($ty, $head)");
+ } elsif ($ty eq 'DgitImportUnpatched') {
+ $x->($trouble, 'dgitimport',
+ "found dgit dsc import ($head)");
+ $breakwater = undef;
+ $anchor = undef;
+ no warnings qw(exiting);
+ last;
+ } else {
+ fail "found unprocessable commit, cannot cope: $head; $cl->{Why}";
+ }
+ $head = $cl->{Parents}[0]{CommitId};
+ }
+ return ($anchor, $breakwater);
+}
+
+sub walk ($;$$);
+sub walk ($;$$) {
+ my ($input,
+ $nogenerate,$report) = @_;
+ # => ($tip, $breakwater_tip, $last_anchor)
+ # (or nothing, if $nogenerate)