badcommit-fixup

   1 #!/usr/bin/perl -w
   2
   3 # usage:
   4 #   .../badcommit-fixup --test
   5 #   .../badcommit-fixup --real
   6
   7 use strict;
   8
   9 use POSIX;
  10 use IPC::Open2;
  11 use Data::Dumper;
  12
  13 my $real;
  14
  15 foreach my $a (@ARGV) {
  16     if ($a eq '--test') {
  17         $real = 0;
  18     } elsif ($a eq '--real') {
  19         $real = 1;
  20     } else {
  21         die "$a ?";
  22     }
  23 }
  24
  25 die unless defined $real;
  26
  27 my $gcfpid = open2 \*GCFO, \*GCFI, 'git cat-file --batch' or die $!;
  28
  29 our %count;
  30
  31 no warnings qw(recursion);
  32
  33 sub getobj ($$) {
  34     my ($obj, $type) = @_;
  35     print GCFI $obj, "\n" or die $!;
  36     my $x = <GCFO>;
  37     my ($gtype, $gsize) = $x =~ m/^\w+ (\w+) (\d+)\n/ or die "$obj ?";
  38     $gtype eq $type or die "$obj $gtype != $type ?";
  39     my $gdata;
  40     (read GCFO, $gdata, $gsize) == $gsize or die "$obj $!";
  41 #print STDERR ">$obj|$x|$gdata|$gsize<\n";
  42     $x = <GCFO>;
  43     $x eq "\n" or die "$obj ($_) $!";
  44     $count{inspected}++;
  45     return $gdata;
  46 }
  47
  48 sub hashobj ($$) {
  49     my ($data,$type) = @_;
  50     my $gwopid = open2 \*GWO, \*GWI,
  51         "git hash-object -w -t $type --stdin"
  52         or die $!;
  53     print GWI $data or die $!;
  54     close GWI or die $!;
  55     $_ = <GWO>;
  56     close GWO or die $!;
  57     waitpid $gwopid,0 == $gwopid or die $!;
  58     die $? if $?;
  59     m/^(\w+)\n/ or die "$_ ?";
  60     $count{"rewritten $type"}++;
  61     return $1;
  62 }
  63
  64 our %memo;
  65
  66 sub rewrite_commit ($);
  67 sub rewrite_commit ($) {
  68     my ($obj) = @_;
  69     my $m = \ $memo{$obj};
  70     return $$m if defined $$m;
  71     my $olddata = getobj $obj, 'commit';
  72     $olddata =~ m/(?<=\n)(?=\n)/ or die "$obj ?";
  73     my $msg = $';
  74     $_ = $`;
  75     s{^(parent )(\w+)$}{ $1 . rewrite_commit($2) }gme;
  76     $count{'fix overwrite'} += s{^commiter }{committer }gm;
  77     if (!m{^author }m && !m{^committer }m) {
  78         m{^parent (\w+)}m or die "$obj ?";
  79         my $parent = getobj $1, 'commit';
  80         $parent =~ m/^(?:.+\n)+(author .*\ncommitter .*\n)/;
  81         m/\n$/ or die "$obj ?";
  82         $_ .= $1;
  83         $count{'fix import'}++;
  84     }
  85     my $newdata = $_.$msg;
  86     my $newobj;
  87     if ($newdata eq $olddata) {
  88         $newobj = $obj;
  89         $count{unchanged}++;
  90     } else {
  91         $newobj = hashobj $newdata, 'commit';
  92     }
  93     $$m= $newobj;
  94     return $newobj;
  95 }
  96
  97 sub rewrite_tag ($) {
  98     my ($obj) = @_;
  99     $_ = getobj $obj, 'tag';
 100     m/^type (\w+)\n/m or die "$obj ?";
 101     if ($1 ne 'commit') {
 102         $count{"oddtags $1"}++;
 103         return $obj;
 104     }
 105     m/^object (\w+)\n/m or die "$obj ?";
 106     my $oldref = $1;
 107     my $newref = rewrite_commit $oldref;
 108     if ($oldref eq $newref) {
 109         return $obj;
 110     }
 111     s/^(object )\w+$/ $1.$newref /me or die "$obj ($_) ?";
 112     s/^-----BEGIN PGP SIGNATURE-----\n.*^-----END PGP SIGNATURE-----\n$//sm;
 113     return hashobj $_, 'tag';
 114 }
 115
 116 $!=0; $?=0;
 117 my $refs=`git for-each-ref`;
 118 die "$? $!" if $?;
 119
 120 chomp $refs;
 121
 122 our @updates;
 123
 124 foreach my $rline (split /\n/, $refs) {
 125     my ($obj, $type, $refname) =
 126         $rline =~ m/^(\w+)\s+(\w+)\s+(\S.*)/
 127         or die "$_ ?";
 128     my $rewrite;
 129     if ($type eq 'commit') {
 130         $rewrite = rewrite_commit($obj);
 131     } elsif ($type eq 'tag') {
 132         $rewrite = rewrite_tag($obj);
 133     } else {
 134         warn "ref $refname refers to $type\n";
 135         next;
 136     }
 137     next if $rewrite eq $obj;
 138     push @updates, [ $refname, $obj, $rewrite ];
 139 }
 140
 141 $!=0; $?=0;
 142 my $bare = `git rev-parse --is-bare-repository`;
 143 die "$? $!" if $?;
 144
 145 our $worktree;
 146
 147 sub runcmd {
 148     system @_ and die "$! $?";
 149 }
 150
 151 for my $up (@updates) {
 152     my ($ref, $veryold, $old) = @$up;
 153     next unless $ref =~ m{^refs/dgit/^[/]+$};
 154
 155     die "$bare ?" unless $bare eq 'true';
 156
 157     my $td = 'dgit-broken-fixup.tmp';
 158     runcmd qw(rm -rf), $td;
 159     mkdir $td, 0700 or die "$td $!";
 160     chdir $td or die $!;
 161     runcmd qw(git init -q);
 162     runcmd qw(git config gc.auto 0);
 163     rmdir ".git/objects";
 164     symlink "../objects", ".git/objects" or die $!;
 165     runcmd qw(git checkout -q), $old;
 166
 167     open C, "debian/changelog" or die $!;
 168     undef $/;
 169     my $clog = <C>;
 170     C->error and die $!;
 171     close C or die $!;
 172     defined $clog or die $!;
 173
 174     $!=0; $?=0;
 175     my $v = `dpkg-parsechangelog`;
 176     die "$ref $veryold $old $? $!" if $?;
 177     $v =~ m/^Source: (\S+)$/m or die "$ref $veryold $old ?";
 178     my $pkg = $1;
 179     $v =~ m/^Version: (\S+)$/m or die "$ref $veryold $old ?";
 180     my $vsn = $1;
 181     $vsn .= "+~dgitfix";
 182
 183     open C, ">", "debian/changelog" or die $!;
 184     print C <<END;
 185 $pkg ($vsn) UNRELEASED; urgency=low
 186
 187  * Additional commit, with slightly incremented version number,
 188    to override bad commits generated by dgit due to #849041.
 189  * No changes to the package.
 190  * Not uploaded anywhere.
 191
 192  -- Ian Jackson <ijackson\@chiark.greenend.org.uk>  Thu, 05 Jan 2017 17:58:21 +0000
 193
 194 END
 195     print C $clog or die $!;
 196     close C or die $!;
 197
 198     runcmd qw(git commit -q),
 199         '--author=Ian Jackson <ijackson@chiark.greenend.org.uk>',
 200         qw(-m), 'Dummy changelog entry to work around #849041 fallout',
 201         qw(debian/changelog);
 202
 203     $!=0; $?=0;
 204     my $new = `git rev-parse HEAD`;
 205     die "$? $!" if $?;
 206
 207     chdir '..' or die $!;
 208     runcmd qw(rm -rf), $td;
 209
 210     $count{dummyadded}++;
 211
 212     $up->[2] = $new;
 213 }
 214
 215 open U, "|git update-ref -m 'dgit bad commit fixup' --stdin" or die $!;
 216
 217 if ($real) {
 218     if ($bare eq 'false') {
 219         print "detaching your HEAD\n" or die $!;
 220         runcmd 'git checkout --detach';
 221     }
 222 }
 223
 224 for my $up (@updates) {
 225     my ($ref, $old, $new) = @$up;
 226     my $otherref = $ref;
 227     $otherref =~ s{^refs/}{};
 228     if ($real) {
 229         print U <<END or die $!;
 230 create refs/dgit-badcommit/$otherref $old
 231 update $ref $new $old
 232 END
 233     } else {
 234         print U <<END or die $!;
 235 update refs/dgit-badfixuptest/$otherref $new
 236 END
 237     }
 238 }
 239
 240 $?=0; $!=0;
 241 close U or die "$? $!";
 242 die $? if $?;
 243
 244 print Dumper(\%count);
 245
 246 if ($real) {
 247     print "old values saved in refs/dgit-badcommit/\n" or die $!;
 248 } else {
 249     print "testing output saved in refs/dgit-badfixuptest/\n" or die $!;
 250 }