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 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 use strict;
  22
  23 use Memoize;
  24 use Data::Dumper;
  25
  26 use Debian::Dgit qw(:DEFAULT $wa);
  27
  28 sub cfg ($) {
  29     my ($k) = @_;
  30     $/ = "\0";
  31     my @cmd = qw(git config -z);
  32     push @cmd, qw(--get-all) if wantarray;
  33     push @cmd, $k;
  34     my $out = cmdoutput @cmd;
  35     return split /\0/, $out;
  36 }
  37
  38 memoize('cfg');
  39
  40 # usage
  41 #  git debrebase launder
  42
  43 sub get_commit ($) {
  44     my ($objid) = @_;
  45     my ($type,$data) = git_cat_file $objid;
  46     die unless $type eq 'commit';
  47     $data =~ m/(?<=\n)\n/;
  48     return ($`,$');
  49 }
  50
  51 sub D_DEB ()     { return 0x1; }
  52 sub D_UPS ()     { return 0x2; }
  53 sub D_PAT_ADD () { return 0x4; }
  54 sub D_PAT_OTH () { return 0x8; }
  55
  56 our $rd = ".git/git-debrebase";
  57 our $ud = "$rd/work";
  58
  59 sub commit_pr_info ($) {
  60     my ($r) = @_;
  61     return Data::Dumper->dump([$r], [qw(commit)]);
  62 }
  63
  64 sub calculate_committer_authline () {
  65     my $c = cmdoutput @git, qw(commit-tree --no-gpg-sign -m),
  66         'XXX DUMMY COMMIT (git-debrebase)', "$basis:";
  67     my ($h,$m) = get_commit $c;
  68     $h =~ m/^committer .*$/m or confess "($h) ?";
  69     return $&;
  70 }
  71
  72 sub classify ($) {
  73     my ($objid) = @_;
  74
  75     my ($h,$m) = get_commit $objid;
  76
  77     my ($t) = $h =~ m/^tree (\w+)$/m or die $cur;
  78     my (@ph) = $h =~ m/^parent (\w+)$/m;
  79     my @p;
  80
  81     my $r = {
  82         CommitId => $objid,
  83         Hdr => $hdr,
  84         Msg => $m,
  85         Tree => $t,
  86         Parents => \@p,
  87     };
  88
  89     foreach my $ph (@ph) {
  90         push @p, {
  91             Ix => $#p,
  92             CommitId => $ph,
  93             Differs => (get_differs $t, $ph),
  94         };
  95     }
  96
  97     my $classify = sub {
  98         my ($type, @rest) = @_;
  99         $r = { %r, Type => $type, @rest };
 100         return $r;
 101     };
 102     my $unknown = sub {
 103         my ($why) = @_;
 104         $r = { %r, Type => Unknown };
 105         return $r;
 106     }
 107
 108     if (@p == 1) {
 109         my $d = $r->{Parents}[0]{Differs};
 110         if ($d == D_DPAT_ADD) {
 111             return $classify->(qw(AddPatches));
 112         } elsif ($d & (D_DPAT_ADD|D_DPAT_OTH)) {
 113             return $unknown->("edits debian/patches");
 114         } elsif ($d == D_DEB) {
 115             return $classify->(qw(Packaging));
 116         } elsif ($d == D_UPS) {
 117             return $classify->(qw(Upstream));
 118         } elsif ($d == D_DEB|D_UPS) {
 119             return $classify->(qw(Mixed));
 120         } elsif ($d == 0) {
 121             return $unknown->("no changes");
 122         } else {
 123             confess "internal error $objid ?";
 124         }
 125     }
 126     if (!@p) {
 127         return $unknown->("origin commit");
 128     }
 129
 130     my @identical = grep { !$_->{Differs} } @p;
 131     if (@p == 2 && @identical == 1) {
 132         my @overwritten = grep { $_->{Differs} } @p;
 133         confess "internal error $objid ?" unless @overwritten==1;
 134         return $classify->(qw(Pseudomerge),
 135                            Overwritten => $overwritten[0],
 136                            Contributor => $identical[0]);
 137     }
 138     if (@p == 2 && @identical == 2) {
 139         my @bytime = nsort_by {
 140             my ($ph,$pm) = get_commit $_->{CommitId};
 141             $ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
 142             $1;
 143         } @p;
 144         return $classify->(qw(Pseudomerge),
 145                            SubType => qw(Ambiguous),
 146                            Overwritten => $bytime[0],
 147                            Contributor => $bytime[1]);
 148     }!
 149     foreach my $p (@p) {
 150         my ($p_h, $p_m) = get_commit $p;
 151         $p->{IsOrigin} = $p_h !~ m/^parent \w+$/m;
 152         ($p->{IsDgitImport},) = $p_m =~ m/^\[dgit import ([0-9a-z]+) .*\]$/m;
 153     }
 154     my @orig_ps = grep { ($_->{IsDgitImport}//'X') eq 'orig' };
 155     my $m2 = $m;
 156     if (!(grep { !$_->{IsOrigin} } @p) and
 157         (@origs >= @p - 1) and
 158         $m2 =~ s{^\[(dgit import unpatched .*)\]$}{[was: $1]}m) {
 159         $r->{NewMsg} = $m2;
 160         return $classify->(qw(DgitImportUnpatched),
 161                            OrigParents => \@orig_ps);
 162     }
 163
 164     my ($stype, $series) = git_cat_file "$t:debian/patches/series";
 165     my $haspatches = $stype ne 'missing' && $series =~ m/^\s*[^#\n\t ]/m;
 166
 167     # How to decide about l/r ordering of breakwater merges ?  git
 168     # --topo-order prefers to expand 2nd parent first.  There's
 169     # already an easy rune to look for debian/ history anyway (git log
 170     # debian/) so debian breakwater branch should be 1st parent; that
 171     # way also there's also an easy rune to look for the upstream
 172     # patches (--topo-order).
 173     if (@p == 2 &&
 174         !$haspatches &&
 175         !$p[0]{IsOrigin} && # breakwater merge never starts with an origin
 176         !($p[0]{Differs} & ~D_DEB) &&
 177         !($p[1]{Differs} & ~D_UPS)) {
 178         return $classify->(qw(BreakwaterUpstreamMerge),
 179                            Upstream => $p[1]);
 180     }
 181
 182     return $unknown->("complex merge");
 183 }
 184
 185 sub launder ($;$) {
 186     my ($cur, $wantdebonly) = @_;
 187     # go through commits backwards
 188     # we generate two lists of commits to apply
 189     my (@deb_cl, @ups_cl);
 190     my %found;
 191     my @pseudomerges;
 192
 193     my $cl;
 194     my $xmsg = sub {
 195         my ($appendinfo) = @_;
 196         my $ms = $cl->{Msg};
 197         chomp $ms;
 198         $ms .= "\n\n[git-debrebase $appendinfo]\n";
 199         return (Msg => $ms);
 200     };
 201
 202     for (;;) {
 203         $cl = classify $cur;
 204         my $ty = $cl->{Type};
 205         my $st = $cl->{SubType};
 206         $found{$ty. ( defined($st) ? "-$st" : '' )}++;
 207         my $p0 = $cl->{Parents}[0]{CommitId};
 208         if ($ty eq 'AddPatches') {
 209             $cur = $p0;
 210             next;
 211         } elsif ($ty eq 'Packaging') {
 212             push @deb_cl, $cl;
 213             $cur = $p0;
 214             next;
 215         } elsif ($ty eq 'Upstream') {
 216             push @ups_cl, $cl;
 217             $cur = $p0;
 218             next;
 219         } elsif ($ty eq 'Mixed') {
 220             my $queue = sub {
 221                 my ($q, $wh) = @_;
 222                 my $cls = { $cl, $xmsg->("split mixed commit: $wh part") };
 223                 push @$q, $cls;
 224             };
 225             $queue->(\@deb_cl, "debian");
 226             $queue->(\@ups_cl, "upstream");
 227             next;
 228         } elsif ($ty eq 'Pseudomerge') {
 229             push @pseudomerges, $cl;
 230             $cur = $ty->{Contributor};
 231             next;
 232         } elsif ($ty eq 'BreakwaterUpstreamMerge') {
 233             $basis = $cur;
 234             last;
 235         } elsif ($ty eq 'DgitImportUnpatched' &&
 236                  @pseudomerges == 1) {
 237             # This import has a tree which is just like a breakwater
 238             # tree, but it has the wrong history.  Its ought to have
 239             # the previous breakwater (which dgit ought to have
 240             # generated a pseudomerge to overwrite) as an ancestor.
 241             # That will make the history of the debian/ files correct.
 242             # As for the upstream version: either it's the same upstream
 243             # as the previous breakwater, in which case that history is
 244             # precisely right.  Otherwise, it was a non-gitish upload
 245             # of a new upstream version.  We can tell these apart
 246             # by looking at the tree of the supposed upstream.
 247             if ($differs & D_UPS) {
 248                 push @deb_cl, {
 249                     %r,
 250                     SpecialMethod => 'DgitImportUpstreamUpdate',
 251                     $xmsg->("convert dgit import: debian changes")
 252                 };
 253             }
 254             push @deb_cl, {
 255                 %r,
 256                 SpecialMethod => 'DgitImportDebianUpdate',
 257                 $xmsg->("convert dgit import: upstream changes")
 258             };
 259             my $differs = get_differs $previous_breakwater, $cl->{Tree};
 260             $basis = launder $pseudomerges[0]{Overwritten}, 1;
 261             last;
 262         } else {
 263             die "Reached difficult commit $cur: ".Dumper($cl);
 264         }
 265     }
 266     # Now we build it back up again
 267
 268     workarea_fresh();
 269     in_workarea sub { xxx attributes xxx };
 270
 271     my $build = $basis;
 272
 273     my $rm_tree_cached = sub {
 274         my ($subdir) = @_;
 275         runcmd @git, qw(rm --quiet -rf --cached), $subdir;
 276     };
 277     my $read_tree_debian = sub {
 278         my ($treeish) = @_;
 279         $rm_tree_cached->(qw(debian));
 280         runcmd @git, qw(read-tree --prefix=debian/), "$treeish:debian";
 281     };
 282     my $read_tree_upstream = sub {
 283         my ($treeish) = @_;
 284         runcmd @git, qw(read-tree), $treeish;
 285         $read_tree_debian->($build);
 286     };
 287
 288     my $committer_authline = calculate_committer_authline();
 289
 290     in_workarea sub {
 291         my $current_method;
 292         foreach my $cl (qw(Debian), @deb_cl, qw(Upstream), @ups_cl) {
 293             if (!ref $cl) {
 294                 $current_method = $cl;
 295                 next;
 296             }
 297             $method = $cl->{SpecialMethod} // $current_method;
 298             my @parents = ($build);
 299             my $cltree = $cl->{CommitId}
 300             if ($method eq 'Debian') {
 301                 $read_tree_debian->($cltree);
 302             } elsif ($method eq 'Upstream') {
 303                 $read_tree_upstream->($cltree);
 304             } elsif ($method eq 'DgitImportDebianUpdate') {
 305                 $read_tree_debian->($cltree);
 306                 $rm_tree_cached(qw(debian/patches));
 307             } elsif ($method eq 'DgitImportUpstreamUpdate') {
 308                 $read_tree_upstream->($cltree);
 309                 push @parents, map { $_->{CommitId} } @{ $cl->{OrigParents} };
 310             } else {
 311                 confess "$method ?";
 312             }
 313             my $newtree = cmdoutput @git, qw(write-tree);
 314             my $ch = $cl->{Msg};
 315             $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?";
 316             $ch =~ s{^committer .*$}{$committer_authline}m or confess "$ch ?";
 317             my $newcommit = cmdoutput @git, qw(hash-object -t commit),
 318                 $ch."\n".$cl->{Msg};
 319
 320
 321             #my $cdata = <<END;
 322 tree $newtree
 323 author $
 324     };
 325
 326                 $r->{FixupUpstreamMerge} = $
 327
 328                 push @deb_cl, {
 329                     $cl,
 330                     Type => NonGitNewUpstreamDgitImport,
 331                     PreviousBreakwaterMerge =>
 332
 333
 334             push @phases, [ @deb_cl, @ups_cl ];
 335
 336             if (@pseudomerges != 1) {
 337 }
 338
 339
 340 chdir $GIT_DIR
 341
 342
 343 if ($ARGV[0] eq 'launder') {
 344     launder();
 345 }
 346
 347 use Data::Dumper;
 348 print Dumper(cfg('wombat.foo.bar'));
 349
 350
 351         ((git_cat_file "$t:debian/patches/series"
 352
 353
 354     my @
 355
 356
 357
 358             return $r;
 359             $r->{Type} = '
 360             $r->{Type} = '
 361             return
 362             # changes on debian/patches, discard it
 363
 364             $cur = $p[0];
 365             next;
 366         }
 367         if ($d & DPAT) {
 368
 369
 370     ($r->{Tree},) =
 371
 372
 373
 374
 375
 376
 377  when starting must record original start (for ff)
 378  and new rebase basis
 379