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 die unless "@ARGV" eq "--test" or "@ARGV" eq "--real";
  14
  15 my ($modeopt) = @ARGV;
  16 my $real = ($modeopt eq '--real');
  17
  18 my $gcfpid = open2 \*GCFO, \*GCFI, 'git cat-file --batch' or die $!;
  19
  20 our %count;
  21
  22 no warnings qw(recursion);
  23
  24 sub getobj ($$) {
  25     my ($obj, $type) = @_;
  26     print GCFI $obj, "\n" or die $!;
  27     my $x = <GCFO>;
  28     my ($gtype, $gsize) = $x =~ m/^\w+ (\w+) (\d+)\n/ or die "$obj ?";
  29     $gtype eq $type or die "$obj $gtype != $type ?";
  30     my $gdata;
  31     (read GCFO, $gdata, $gsize) == $gsize or die "$obj $!";
  32 #print STDERR ">$obj|$x|$gdata|$gsize<\n";
  33     $x = <GCFO>;
  34     $x eq "\n" or die "$obj ($_) $!";
  35     $count{inspected}++;
  36     return $gdata;
  37 }
  38
  39 sub hashobj ($$) {
  40     my ($data,$type) = @_;
  41     my $gwopid = open2 \*GWO, \*GWI,
  42         "git hash-object -w -t $type --stdin"
  43         or die $!;
  44     print GWI $data or die $!;
  45     close GWI or die $!;
  46     $_ = <GWO>;
  47     close GWO or die $!;
  48     waitpid $gwopid,0 == $gwopid or die $!;
  49     die $? if $?;
  50     m/^(\w+)\n/ or die "$_ ?";
  51     $count{"rewritten $type"}++;
  52     return $1;
  53 }
  54
  55 our %memo;
  56
  57 sub rewrite_commit ($);
  58 sub rewrite_commit ($) {
  59     my ($obj) = @_;
  60     my $m = \ $memo{$obj};
  61     return $$m if defined $$m;
  62     my $olddata = getobj $obj, 'commit';
  63     $olddata =~ m/(?<=\n)(?=\n)/ or die "$obj ?";
  64     my $msg = $';
  65     $_ = $`;
  66     s{^(parent )(\w+)$}{ $1 . rewrite_commit($2) }gme;
  67     $count{'fix overwrite'} += s{^commiter }{committer }gm;
  68     if (!m{^author }m && !m{^committer }m) {
  69         m{^parent (\w+)}m or die "$obj ?";
  70         my $parent = getobj $1, 'commit';
  71         $parent =~ m/^(?:.+\n)+(author .*\ncommitter .*\n)/;
  72         m/\n$/ or die "$obj ?";
  73         $_ .= $1;
  74         $count{'fix import'}++;
  75     }
  76     my $newdata = $_.$msg;
  77     my $newobj;
  78     if ($newdata eq $olddata) {
  79         $newobj = $obj;
  80         $count{unchanged}++;
  81     } else {
  82         $newobj = hashobj $newdata, 'commit';
  83     }
  84     $$m= $newobj;
  85     return $newobj;
  86 }
  87
  88 sub rewrite_tag ($) {
  89     my ($obj) = @_;
  90     $_ = getobj $obj, 'tag';
  91     m/^type (\w+)\n/m or die "$obj ?";
  92     if ($1 ne 'commit') {
  93         $count{"oddtags $1"}++;
  94         return $obj;
  95     }
  96     m/^object (\w+)\n/m or die "$obj ?";
  97     my $oldref = $1;
  98     my $newref = rewrite_commit $oldref;
  99     if ($oldref eq $newref) {
 100         return $obj;
 101     }
 102     s/^(object )\w+$/ $1.$newref /me or die "$obj ($_) ?";
 103     s/^-----BEGIN PGP SIGNATURE-----\n.*^-----END PGP SIGNATURE-----\n$//sm;
 104     return hashobj $_, 'tag';
 105 }
 106
 107 $!=0; $?=0;
 108 my $refs=`git for-each-ref`;
 109 die "$? $!" if $?;
 110
 111 chomp $refs;
 112
 113 our @updates;
 114
 115 foreach my $rline (split /\n/, $refs) {
 116     my ($obj, $type, $refname) =
 117         $rline =~ m/^(\w+)\s+(\w+)\s+(\S.*)/
 118         or die "$_ ?";
 119     my $rewrite;
 120     if ($type eq 'commit') {
 121         $rewrite = rewrite_commit($obj);
 122     } elsif ($type eq 'tag') {
 123         $rewrite = rewrite_tag($obj);
 124     } else {
 125         warn "ref $refname refers to $type\n";
 126         next;
 127     }
 128     next if $rewrite eq $obj;
 129     push @updates, [ $refname, $obj, $rewrite ];
 130 }
 131
 132 open U, "|git update-ref -m 'dgit bad commit fixup' --stdin" or die $!;
 133
 134 if ($real) {
 135     $!=0; $?=0;
 136     my $bare = `git rev-parse --is-bare-repository`;
 137     die "$? $!" if $?;
 138     if ($bare eq 'false') {
 139         print "detaching your HEAD\n" or die $!;
 140         system 'git checkout --detach' and die "$! $?";
 141     }
 142 }
 143
 144 for my $up (@updates) {
 145     my ($ref, $old, $new) = @$up;
 146     my $otherref = $ref;
 147     $otherref =~ s{^refs/}{};
 148     if ($real) {
 149         print U <<END or die $!;
 150 create refs/dgit-badcommit/$otherref $old
 151 update $ref $new $old
 152 END
 153     } else {
 154         print U <<END or die $!;
 155 update refs/dgit-badfixuptest/$otherref $new
 156 END
 157     }
 158 }
 159
 160 $?=0; $!=0;
 161 close U or die "$? $!";
 162 die $? if $?;
 163
 164 print Dumper(\%count);
 165
 166 if ($real) {
 167     print "old values saved in refs/dgit-badcommit/\n" or die $!;
 168 } else {
 169     print "testing output saved in refs/dgit-badfixuptest/\n" or die $!;
 170 }