#!/usr/bin/perl -w
# git-debrebase
# Script helping make fast-forwarding histories while still rebasing
# upstream deltas when working on Debian packaging
#
# Copyright (C)2017 Ian Jackson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# usages:
# git-debrebase launder # prints breakwater tip
# git-debrebase analyse
# git-debrebase start # like ffrebase start + debrebase launder
# git-debrebase new-upstream [-f] UPSTREAM
# git-debrebase # does debrebase start if necessary
#
# git-ffrebase start [BASE] # records previous HEAD so it can be overwritten
# # records base for future git-ffrebase
# git-ffrebase set-base BASE
# git-ffrebase
# git-ffrebase finish
# git-ffrebase status [BRANCH]
#
# refs/ffrebase-prev/BRANCH BRANCH may be refs/...; if not it means
# refs/ffrebase-base/BRANCH refs/heads/BRANCH
use strict;
use Memoize;
use Data::Dumper;
use Debian::Dgit qw(:DEFAULT $wa);
sub cfg ($) {
my ($k) = @_;
$/ = "\0";
my @cmd = qw(git config -z);
push @cmd, qw(--get-all) if wantarray;
push @cmd, $k;
my $out = cmdoutput @cmd;
return split /\0/, $out;
}
memoize('cfg');
sub get_commit ($) {
my ($objid) = @_;
my ($type,$data) = git_cat_file $objid;
die unless $type eq 'commit';
$data =~ m/(?<=\n)\n/;
return ($`,$');
}
sub D_DEB () { return 0x1; }
sub D_UPS () { return 0x2; }
sub D_PAT_ADD () { return 0x4; }
sub D_PAT_OTH () { return 0x8; }
our $rd = ".git/git-debrebase";
our $ud = "$rd/work";
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),
'XXX DUMMY COMMIT (git-debrebase)', "$basis:";
my ($h,$m) = get_commit $c;
$h =~ m/^committer .*$/m or confess "($h) ?";
return $&;
}
sub classify ($) {
my ($objid) = @_;
my ($h,$m) = get_commit $objid;
my ($t) = $h =~ m/^tree (\w+)$/m or die $cur;
my (@ph) = $h =~ m/^parent (\w+)$/m;
my @p;
my $r = {
CommitId => $objid,
Hdr => $hdr,
Msg => $m,
Tree => $t,
Parents => \@p,
};
foreach my $ph (@ph) {
push @p, {
Ix => $#p,
CommitId => $ph,
Differs => (get_differs $t, $ph),
};
}
my $classify = sub {
my ($type, @rest) = @_;
$r = { %r, Type => $type, @rest };
return $r;
};
my $unknown = sub {
my ($why) = @_;
$r = { %r, Type => Unknown };
return $r;
}
if (@p == 1) {
my $d = $r->{Parents}[0]{Differs};
if ($d == D_DPAT_ADD) {
return $classify->(qw(AddPatches));
} elsif ($d & (D_DPAT_ADD|D_DPAT_OTH)) {
return $unknown->("edits debian/patches");
} elsif ($d == D_DEB) {
return $classify->(qw(Packaging));
} elsif ($d == D_UPS) {
return $classify->(qw(Upstream));
} elsif ($d == D_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");
}
my @identical = grep { !$_->{Differs} } @p;
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 @bytime = nsort_by {
my ($ph,$pm) = get_commit $_->{CommitId};
$ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
$1;
} @p;
return $classify->(qw(Pseudomerge),
SubType => qw(Ambiguous),
Overwritten => $bytime[0],
Contributor => $bytime[1]);
}!
foreach my $p (@p) {
my ($p_h, $p_m) = get_commit $p;
$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' };
my $m2 = $m;
if (!(grep { !$_->{IsOrigin} } @p) and
(@origs >= @p - 1) and
$m2 =~ s{^\[(dgit import unpatched .*)\]$}{[was: $1]}m) {
$r->{NewMsg} = $m2;
return $classify->(qw(DgitImportUnpatched),
OrigParents => \@orig_ps);
}
my ($stype, $series) = git_cat_file "$t:debian/patches/series";
my $haspatches = $stype ne 'missing' && $series =~ m/^\s*[^#\n\t ]/m;
# How to decide about l/r ordering of breakwater merges ? 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).
if (@p == 2 &&
!$haspatches &&
!$p[0]{IsOrigin} && # breakwater merge never starts with an origin
!($p[0]{Differs} & ~D_DEB) &&
!($p[1]{Differs} & ~D_UPS)) {
return $classify->(qw(BreakwaterUpstreamMerge),
Upstream => $p[1]);
}
return $unknown->("complex merge");
}
sub launder ($;$) {
my ($cur, $pseudos_must_overwrite, $wantdebonly) = @_;
# go through commits backwards
# we generate two lists of commits to apply
my (@deb_cl, @ups_cl);
my %found;
my @pseudomerges;
my $cl;
my $xmsg = sub {
my ($appendinfo) = @_;
my $ms = $cl->{Msg};
chomp $ms;
$ms .= "\n\n[git-debrebase $appendinfo]\n";
return (Msg => $ms);
};
for (;;) {
$cl = classify $cur;
my $ty = $cl->{Type};
my $st = $cl->{SubType};
$found{$ty. ( defined($st) ? "-$st" : '' )}++;
my $p0 = $cl->{Parents}[0]{CommitId};
if ($ty eq 'AddPatches') {
$cur = $p0;
next;
} elsif ($ty eq 'Packaging') {
push @deb_cl, $cl;
$cur = $p0;
next;
} elsif ($ty eq 'Upstream') {
push @ups_cl, $cl;
$cur = $p0;
next;
} elsif ($ty eq 'Mixed') {
my $queue = sub {
my ($q, $wh) = @_;
my $cls = { $cl, $xmsg->("split mixed commit: $wh part") };
push @$q, $cls;
};
$queue->(\@deb_cl, "debian");
$queue->(\@ups_cl, "upstream");
next;
} elsif ($ty eq 'Pseudomerge') {
if (defined $pseudos_must_overwrite) {
}
push @pseudomerges, $cl;
$cur = $ty->{Contributor};
next;
} elsif ($ty eq 'BreakwaterUpstreamMerge') {
$basis = $cur;
last;
} elsif ($ty eq 'DgitImportUnpatched' &&
@pseudomerges == 1) {
# This import has a tree which is just like a breakwater
# tree, but it has the wrong history. Its ought to have
# the previous breakwater (which dgit ought to have
# generated a pseudomerge to overwrite) as an ancestor.
# That will make the history of the debian/ files correct.
# As for the upstream version: either it's the same upstream
# as the previous breakwater, in which case that history is
# precisely right. Otherwise, it was a non-gitish upload
# of a new upstream version. We can tell these apart
# by looking at the tree of the supposed upstream.
if ($differs & D_UPS) {
push @deb_cl, {
%r,
SpecialMethod => 'DgitImportUpstreamUpdate',
$xmsg->("convert dgit import: debian changes")
};
}
push @deb_cl, {
%r,
SpecialMethod => 'DgitImportDebianUpdate',
$xmsg->("convert dgit import: upstream changes")
};
my $differs = get_differs $previous_breakwater, $cl->{Tree};
$basis = launder $pseudomerges[0]{Overwritten}, 1;
last;
} else {
die "Reached difficult commit $cur: ".Dumper($cl);
}
}
# Now we build it back up again
workarea_fresh();
in_workarea sub { xxx attributes xxx };
my $build = $basis;
my $rm_tree_cached = sub {
my ($subdir) = @_;
runcmd @git, qw(rm --quiet -rf --cached), $subdir;
};
my $read_tree_debian = sub {
my ($treeish) = @_;
$rm_tree_cached->(qw(debian));
runcmd @git, qw(read-tree --prefix=debian/), "$treeish:debian";
};
my $read_tree_upstream = sub {
my ($treeish) = @_;
runcmd @git, qw(read-tree), $treeish;
$read_tree_debian->($build);
};
my $committer_authline = calculate_committer_authline();
in_workarea sub {
mkdir $rd or $!==EEXIST or die $!;
my $current_method;
foreach my $cl (qw(Debian), @deb_cl, qw(Upstream), @ups_cl) {
if (!ref $cl) {
$current_method = $cl;
next;
}
$method = $cl->{SpecialMethod} // $current_method;
my @parents = ($build);
my $cltree = $cl->{CommitId}
if ($method eq 'Debian') {
$read_tree_debian->($cltree);
} elsif ($method eq 'Upstream') {
$read_tree_upstream->($cltree);
} elsif ($method eq 'DgitImportDebianUpdate') {
$read_tree_debian->($cltree);
$rm_tree_cached(qw(debian/patches));
} elsif ($method eq 'DgitImportUpstreamUpdate') {
$read_tree_upstream->($cltree);
push @parents, map { $_->{CommitId} } @{ $cl->{OrigParents} };
} else {
confess "$method ?";
}
my $newtree = cmdoutput @git, qw(write-tree);
my $ch = $cl->{Msg};
$ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?";
$ch =~ s{^committer .*$}{$committer_authline}m or confess "$ch ?";
open CD, ">", "$rd/m" or die $!;
print CD $ch, "\n", $cl->{Msg}; or die $!;
close CD or die $!;
my $newcommit = cmdoutput @git, qw(hash-object -t commit), "$rd/m";
$build = $newcommit;
}
};
}
chdir $GIT_DIR
if ($ARGV[0] eq 'launder') {
launder();
}
use Data::Dumper;
print Dumper(cfg('wombat.foo.bar'));
((git_cat_file "$t:debian/patches/series"
my @
return $r;
$r->{Type} = '
$r->{Type} = '
return
# changes on debian/patches, discard it
$cur = $p[0];
next;
}
if ($d & DPAT) {
($r->{Tree},) =
when starting must record original start (for ff)
and new rebase basis