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