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