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;
  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 sub commit_pr_info ($) {
  57     my ($r) = @_;
  58     return Data::Dumper->dump([$r], [qw(commit)]);
  59 }
  60
  61 sub classify ($) {
  62     my ($objid) = @_;
  63
  64     my ($h,$m) = get_commit $objid;
  65
  66     my ($t) = $h =~ m/^tree (\w+)$/m or die $cur;
  67     my (@ph) = $h =~ m/^parent (\w+)$/m;
  68     my @p;
  69
  70     my $r = {
  71         CommitId => $objid,
  72         Hdr => $hdr,
  73         Msg => $m,
  74         Tree => $t,
  75         Parents => \@p,
  76     };
  77
  78     foreach my $ph (@ph) {
  79         push @p, {
  80             Ix => $#p,
  81             CommitId => $ph,
  82             Differs => (get_differs $t, $ph),
  83         };
  84     }
  85
  86     my $classify = sub {
  87         my ($type, @rest) = @_;
  88         $r = { %r, Type => $type, @rest };
  89         return $r;
  90     };
  91     my $unknown = sub {
  92         my ($why) = @_;
  93         $r = { %r, Type => Unknown };
  94         return $r;
  95     }
  96
  97     if (@p == 1) {
  98         my $d = $r->{Parents}[0]{Differs};
  99         if ($d == D_DPAT_ADD) {
 100             return $classify->(qw(AddPatches));
 101         } elsif ($d & (D_DPAT_ADD|D_DPAT_OTH)) {
 102             return $unknown->("edits debian/patches");
 103         } elsif ($d == D_DEB) {
 104             return $classify->(qw(Packaging));
 105         } elsif ($d == D_UPS) {
 106             return $classify->(qw(Upstream));
 107         } elsif ($d == D_DEB|D_UPS) {
 108             return $classify->(qw(Mixed));
 109         } elsif ($d == 0) {
 110             return $unknown->("no changes");
 111         } else {
 112             confess "internal error $objid ?";
 113         }
 114     }
 115     if (!@p) {
 116         return $unknown->("origin commit");
 117     }
 118
 119     my @identical = grep { !$_->{Differs} } @p;
 120     if (@p == 2 && @identical == 1) {
 121         my @overwritten = grep { $_->{Differs} } @p;
 122         confess "internal error $objid ?" unless @overwritten==1;
 123         return $classify->(qw(Pseudomerge),
 124                            Overwritten => $overwritten[0],
 125                            Contributor => $identical[0]);
 126     }
 127     if (@p == 2 && @identical == 2) {
 128         my @bytime = nsort_by {
 129             my ($ph,$pm) = get_commit $_->{CommitId};
 130             $ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
 131             $1;
 132         } @p;
 133         return $classify->(qw(Pseudomerge),
 134                            SubType => qw(Ambiguous),
 135                            Overwritten => $bytime[0],
 136                            Contributor => $bytime[1]);
 137     }!
 138     foreach my $p (@p) {
 139         my ($p_h, $p_m) = get_commit $p;
 140         $p->{IsOrigin} = $p_h !~ m/^parent \w+$/m;
 141         $p->{IsDgitImport} = $p_m =~ m/^\[dgit import .*\]$/m;
 142         $p->{IsDgitImportOrig} = $p_m =~ m/^\[dgit import orig .*\]$/m;
 143     }
 144     my $m2 = $m;
 145     if (!grep { !($_->{IsOrigin} && $_->{isDgitImport}) } @p and
 146         $m2 =~ s{^\[(dgit import unpatched .*)\]$}{[was: $1]}m) {
 147
 148  xxx check exactly one IsDgitImport that is tarball
 149         $r->{NewMsg} = $m2;
 150         return $classify->(qw(DgitImportUnpatched));
 151     }
 152
 153     my ($stype, $series) = git_cat_file "$t:debian/patches/series";
 154     my $haspatches = $stype ne 'missing' && $series =~ m/^\s*[^#\n\t ]/m;
 155
 156     # how to decide about l/r ordering of breakwater merges
 157     # git --topo-order prefers to expand 2nd parent first
 158     # easy rune to look for debian/ history so that should
 159     # be 1st parent.
 160     if (@p == 2 &&
 161         !$haspatches &&
 162         !$p[0]{IsOrigin} && # breakwater merge never starts with an origin
 163         !($p[0]{Differs} & ~D_DEB) &&
 164         !($p[1]{Differs} & ~D_UPS)) {
 165         return $classify->(qw(BreakwaterUpstreamMerge),
 166                            Upstream => $p[1]);
 167     }
 168
 169     return $unknown->("complex merge");
 170 }
 171
 172 sub launder ($) {
 173     my ($cur) = @_;
 174     # go through commits backwards
 175     # we generate two lists of commits to apply
 176     my (@phases, @deb_cl, @ups_cl);
 177     my %found;
 178     my @psuedomerges;
 179     for (;;) {
 180         my $cl = classify $cur;
 181         my $ty = $cl->{Type};
 182         my $st = $cl->{SubType};
 183         $found{$ty. ( defined($st) ? "-$st" : '' )}++;
 184         my $p0 = $cl->{Parents}[0]{CommitId};
 185         if ($ty eq 'AddPatches') {
 186             $cur = $p0;
 187             next;
 188         } elsif ($ty eq 'Packaging') {
 189             push @deb_cl, $cur;
 190             $cur = $p0;
 191             next;
 192         } elsif ($ty eq 'Upstream') {
 193             push @ups_cl, $cur;
 194             $cur = $p0;
 195             next;
 196         } elsif ($ty eq 'Mixed') {
 197             my $queue = sub {
 198                 my ($q, $wh) = @_;
 199                 my $ms = $cl->{Msg};
 200                 chomp $ms;
 201                 $ms .= "\n[git-debrebase split mixed commit: $wh part]\n";
 202                 my $cls = { $cl, Msg => $ms };
 203                 push @$q, $cls;
 204             };
 205             $queue->(\@deb_cl, "debian");
 206             $queue->(\@ups_cl, "upstream");
 207             next;
 208         } elsif ($ty eq 'Pseudomerge') {
 209             push @pseudomerges, $cl;
 210             $cur = $ty->{Contributor};
 211             next;
 212         } elsif ($ty eq 'DgitImportUnpatched' &&
 213                  @pseudomerges == 1) {
 214             # This import has a tree which is just like a breakwater
 215             # tree, but it has the wrong history.  Its ought to have
 216             # the previous breakwater (which dgit ought to have
 217             # generated a pseudomerge to overwrite) as an ancestor.
 218             # That will make the history of the debian/ files correct.
 219             # As for the upstream version: either it's the same upstream
 220             # as the previous breakwater, in which case that history is
 221             # precisely right.  Otherwise, it was a non-gitish upload
 222             # of a new upstream version.  We can tell these apart
 223             # by looking at the tree of the supposed upstream.
 224             my $previous_breakwater = launder $pseudomerges[0]{Overwritten};
 225             my $differs = get_differs $previous_breakwater, $cl->{Tree};
 226             if ($differs & D_UPS) {
 227                 $r->{FixupUpstreamMerge} = $
 228
 229                 push @deb_cl, {
 230                     $cl,
 231                     Type => NonGitNewUpstreamDgitImport,
 232                     PreviousBreakwaterMerge =>
 233
 234
 235             push @phases, [ @deb_cl, @ups_cl ];
 236
 237             if (@pseudomerges != 1) {
 238 }
 239
 240 if ($ARGV[0] eq 'launder') {
 241     launder();
 242 }
 243
 244 use Data::Dumper;
 245 print Dumper(cfg('wombat.foo.bar'));
 246
 247
 248         ((git_cat_file "$t:debian/patches/series"
 249
 250
 251     my @
 252
 253
 254
 255             return $r;
 256             $r->{Type} = '
 257             $r->{Type} = '
 258             return
 259             # changes on debian/patches, discard it
 260
 261             $cur = $p[0];
 262             next;
 263         }
 264         if ($d & DPAT) {
 265
 266
 267     ($r->{Tree},) =
 268
 269
 270
 271
 272
 273
 274  when starting must record original start (for ff)
 275  and new rebase basis
 276