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 open U, "|git update-ref -m 'dgit bad commit fixup' --stdin" or die $!;
 142
 143 if ($real) {
 144     $!=0; $?=0;
 145     my $bare = `git rev-parse --is-bare-repository`;
 146     die "$? $!" if $?;
 147     if ($bare eq 'false') {
 148         print "detaching your HEAD\n" or die $!;
 149         system 'git checkout --detach' and die "$! $?";
 150     }
 151 }
 152
 153 for my $up (@updates) {
 154     my ($ref, $old, $new) = @$up;
 155     my $otherref = $ref;
 156     $otherref =~ s{^refs/}{};
 157     if ($real) {
 158         print U <<END or die $!;
 159 create refs/dgit-badcommit/$otherref $old
 160 update $ref $new $old
 161 END
 162     } else {
 163         print U <<END or die $!;
 164 update refs/dgit-badfixuptest/$otherref $new
 165 END
 166     }
 167 }
 168
 169 $?=0; $!=0;
 170 close U or die "$? $!";
 171 die $? if $?;
 172
 173 print Dumper(\%count);
 174
 175 if ($real) {
 176     print "old values saved in refs/dgit-badcommit/\n" or die $!;
 177 } else {
 178     print "testing output saved in refs/dgit-badfixuptest/\n" or die $!;
 179 }