]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/LeiRediff.pm
ea9b2a643f9a0bb1334bdedca0c899e6840a3f35
[public-inbox.git] / lib / PublicInbox / LeiRediff.pm
1 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # The "lei rediff" sub-command, regenerates diffs with new options
5 package PublicInbox::LeiRediff;
6 use strict;
7 use v5.10.1;
8 use parent qw(PublicInbox::IPC PublicInbox::LeiInput);
9 use File::Temp 0.19 (); # 0.19 for ->newdir
10 use PublicInbox::Spawn qw(spawn which);
11 use PublicInbox::MsgIter qw(msg_part_text);
12 use PublicInbox::ViewDiff;
13 use PublicInbox::LeiBlob;
14 use PublicInbox::Git qw(git_quote git_unquote);
15 use PublicInbox::Import;
16 use PublicInbox::LEI;
17 use PublicInbox::SolverGit;
18
19 my $MODE = '(100644|120000|100755|160000)';
20
21 sub rediff_user_cb { # called by solver when done
22         my ($res, $self) = @_;
23         my $lei = $self->{lei};
24         my $log_buf = delete $lei->{log_buf};
25         $$log_buf =~ s/^/# /sgm;
26         ref($res) eq 'ARRAY' or return $lei->child_error(0, $$log_buf);
27         $lei->qerr($$log_buf);
28         my ($git, $oid, $type, $size, $di) = @$res;
29         my $oid_want = delete $self->{cur_oid_want};
30
31         # don't try to support all the git-show(1) options for non-blob,
32         # this is just a convenience:
33         $type ne 'blob' and return $lei->err(<<EOF);
34 # $oid is a $type of $size bytes in:
35 # $git->{git_dir} (wanted: $oid_want)
36 EOF
37         $self->{blob}->{$oid_want} = $oid;
38         push @{$self->{gits}}, $git if $git->{-tmp};
39 }
40
41 # returns a full blob for oid_want
42 sub solve_1 ($$$) {
43         my ($self, $oid_want, $hints) = @_;
44         return if $oid_want =~ /\A0+\z/;
45         $self->{cur_oid_want} = $oid_want;
46         my $solver = bless {
47                 gits => $self->{gits},
48                 user_cb => \&rediff_user_cb,
49                 uarg => $self,
50                 inboxes => [ $self->{lxs}->locals, @{$self->{rmt}} ],
51         }, 'PublicInbox::SolverGit';
52         open my $log, '+>', \(my $log_buf = '') or die "PerlIO::scalar: $!";
53         $self->{lei}->{log_buf} = \$log_buf;
54         local $PublicInbox::DS::in_loop = 0; # waitpid synchronously
55         $solver->solve($self->{lei}->{env}, $log, $oid_want, $hints);
56         $self->{blob}->{$oid_want}; # full OID
57 }
58
59 sub diff_ctxq ($$) {
60         my ($self, $ctxq) = @_;
61         return unless $ctxq;
62         my $blob = $self->{blob};
63         my $ta = <<'EOM';
64 reset refs/heads/A
65 commit refs/heads/A
66 author <a@s> 0 +0000
67 committer <c@s> 0 +0000
68 data 0
69 EOM
70         my $tb = $ta;
71         $tb =~ tr!A!B!;
72         my $lei = $self->{lei};
73         while (my ($oid_a, $oid_b, $pa, $pb, $ma, $mb) = splice(@$ctxq, 0, 6)) {
74                 my $xa = $blob->{$oid_a} //= solve_1($self, $oid_a,
75                                                         { path_b => $pa });
76                 my $xb = $blob->{$oid_b} //= solve_1($self, $oid_b, {
77                                                 oid_a => $oid_a,
78                                                 path_a => $pa,
79                                                 path_b => $pb
80                                         });
81                 $ta .= "M $ma $xa ".git_quote($pa)."\n" if $xa;
82                 $tb .= "M $mb $xb ".git_quote($pb)."\n" if $xb;
83         }
84         my $rw = $self->{gits}->[-1]; # has all known alternates
85         if (!$rw->{-tmp}) {
86                 my $d = "$self->{rdtmp}/for_tree.git";
87                 -d $d or PublicInbox::Import::init_bare($d);
88                 my $f = "$d/objects/info/alternates"; # always overwrite
89                 open my $fh, '>', $f or die "open $f: $!";
90                 for my $git (@{$self->{gits}}) {
91                         print $fh $git->git_path('objects'),"\n";
92                 }
93                 close $fh or die "close $f: $!";
94                 $rw = PublicInbox::Git->new($d);
95         }
96         pipe(my ($r, $w)) or die "pipe: $!";
97         my $pid = spawn(['git', "--git-dir=$rw->{git_dir}",
98                         qw(fast-import --quiet --done --date-format=raw)],
99                         $lei->{env}, { 2 => $lei->{2}, 0 => $r });
100         close $r or die "close r fast-import: $!";
101         print $w $ta, "\n", $tb, "\ndone\n" or die "print fast-import: $!";
102         close $w or die "close w fast-import: $!";
103         waitpid($pid, 0);
104         die "fast-import failed: \$?=$?" if $?;
105
106         my @cmd = qw(diff);
107         my $opt = $lei->{opt};
108         push @cmd, '--'.($opt->{color} && !$opt->{'no-color'} ? '' : 'no-').
109                         'color';
110         for my $o (@PublicInbox::LEI::diff_opt) {
111                 my $c = '';
112                 # remove single char short option
113                 $o =~ s/\|([a-z0-9])\b//i and $c = $1;
114                 if ($o =~ s/=[is]@\z//) {
115                         my $v = $opt->{$o} or next;
116                         push @cmd, map { $c ? "-$c$_" : "--$o=$_" } @$v;
117                 } elsif ($o =~ s/=[is]\z//) {
118                         my $v = $opt->{$o} // next;
119                         push @cmd, $c ? "-$c$v" : "--$o=$v";
120                 } elsif ($o =~ s/:[is]\z//) {
121                         my $v = $opt->{$o} // next;
122                         push @cmd, $c ? "-$c$v" :
123                                         ($v eq '' ? "--$o" : "--$o=$v");
124                 } elsif ($o =~ s/!\z//) {
125                         my $v = $opt->{$o} // next;
126                         push @cmd, $v ? "--$o" : "--no-$o";
127                 } elsif ($opt->{$o}) {
128                         push @cmd, $c ? "-$c" : "--$o";
129                 }
130         }
131         $lei->qerr("# git @cmd");
132         push @cmd, qw(A B);
133         unshift @cmd, 'git', "--git-dir=$rw->{git_dir}";
134         $pid = spawn(\@cmd, $lei->{env}, { 2 => $lei->{2}, 1 => $lei->{1} });
135         waitpid($pid, 0);
136         $lei->child_error($?) if $?; # for git diff --exit-code
137 }
138
139 sub extract_oids { # Eml each_part callback
140         my ($ary, $self) = @_;
141         my ($p, undef, $idx) = @$ary;
142         $self->{lei}->out($p->header_obj->as_string, "\n");
143         my ($s, undef) = msg_part_text($p, $p->content_type || 'text/plain');
144         defined $s or return;
145         my @top = split($PublicInbox::ViewDiff::EXTRACT_DIFFS, $s);
146         undef $s;
147         my $blobs = $self->{blobs}; # blobs to resolve
148         my $ctxq;
149         while (defined(my $x = shift @top)) {
150                 if (scalar(@top) >= 4 &&
151                                 $top[1] =~ $PublicInbox::ViewDiff::IS_OID &&
152                                 $top[0] =~ $PublicInbox::ViewDiff::IS_OID) {
153                         my ($ma, $mb);
154                         $x =~ /^old mode $MODE/sm and $ma = $1;
155                         $x =~ /^new mode $MODE/sm and $mb = $1;
156                         if (!defined($ma) && $x =~
157                                 /^index [a-z0-9]+\.\.[a-z0-9]+ $MODE/sm) {
158                                 $ma = $mb = $1;
159                         }
160                         $ma //= '100644';
161                         $mb //= $ma;
162                         my ($oid_a, $oid_b, $pa, $pb) = splice(@top, 0, 4);
163                         $pa eq '/dev/null' or
164                                 $pa = (split(m'/', git_unquote($pa), 2))[1];
165                         $pb eq '/dev/null' or
166                                 $pb = (split(m'/', git_unquote($pb), 2))[1];
167                         $blobs->{$oid_a} //= undef;
168                         $blobs->{$oid_b} //= undef;
169                         push @$ctxq, $oid_a, $oid_b, $pa, $pb, $ma, $mb;
170                 } elsif ($ctxq) {
171                         my @out;
172                         for (split(/^/sm, $x)) {
173                                 if (/\A-- \r?\n/s) { # email sig starts
174                                         push @out, $_;
175                                         $ctxq = diff_ctxq($self, $ctxq);
176                                 } elsif ($ctxq && (/\A[\+\- ]/ || /\A@@ / ||
177                                         # allow totally blank lines w/o leading
178                                         # SP, git-apply does:
179                                                         /\A\r?\n/s)) {
180                                         next;
181                                 } else {
182                                         push @out, $_;
183                                 }
184                         }
185                         $self->{lei}->out(@out) if @out;
186                 } else {
187                         $ctxq = diff_ctxq($self, $ctxq);
188                         $self->{lei}->out($x);
189                 }
190         }
191         $ctxq = diff_ctxq($self, $ctxq);
192 }
193
194 sub input_eml_cb { # callback for all emails
195         my ($self, $eml) = @_;
196         $self->{tmp_sto}->add_eml($eml);
197         $self->{tmp_sto}->done;
198         $eml->each_part(\&extract_oids, $self, 1);
199 }
200
201 sub lei_rediff {
202         my ($lei, @inputs) = @_;
203         $lei->_lei_store(1)->write_prepare($lei);
204         $lei->{opt}->{'in-format'} //= 'eml';
205         # maybe it's a non-email (code) blob from a coderepo
206         my $git_dirs = $lei->{opt}->{'git-dir'} //= [];
207         if ($lei->{opt}->{cwd} // 1) {
208                 my $cgd = PublicInbox::LeiBlob::get_git_dir($lei, '.');
209                 unshift(@$git_dirs, $cgd) if defined $cgd;
210         }
211         return $lei->fail('no --git-dir to try') unless @$git_dirs;
212         my $lxs = $lei->lxs_prepare;
213         if ($lxs->remotes) {
214                 require PublicInbox::LeiRemote;
215                 $lei->{curl} //= which('curl') or return
216                         $lei->fail('curl needed for', $lxs->remotes);
217         }
218         $lei->ale->refresh_externals($lxs, $lei);
219         my $self = bless {
220                 -force_eml => 1, # for LeiInput->input_fh
221                 lxs => $lxs,
222         }, __PACKAGE__;
223         $self->prepare_inputs($lei, \@inputs) or return;
224         my $isatty = -t $lei->{1};
225         $lei->{opt}->{color} //= $isatty;
226         $lei->start_pager if $isatty;
227         my ($op_c, $ops) = $lei->workers_start($self, 1);
228         $lei->{wq1} = $self;
229         net_merge_all_done($self) unless $lei->{auth};
230         $lei->wait_wq_events($op_c, $ops);
231 }
232
233 sub ipc_atfork_child {
234         my ($self) = @_;
235         PublicInbox::LeiInput::input_only_atfork_child(@_);
236         my $lei = $self->{lei};
237         $lei->{1}->autoflush(1);
238         binmode $lei->{1}, ':utf8';
239         $self->{blobs} = {}; # oidhex => filename
240         $self->{rdtmp} = File::Temp->newdir('lei-rediff-XXXX', TMPDIR => 1);
241         $self->{tmp_sto} = PublicInbox::LeiStore->new(
242                         "$self->{rdtmp}/tmp.store",
243                         { creat => { nproc => 1 }, indexlevel => 'medium' });
244         $self->{tmp_sto}->{priv_eidx}->{parallel} = 0;
245         $self->{rmt} = [ $self->{tmp_sto}->search, map {
246                         PublicInbox::LeiRemote->new($lei, $_)
247                 } $self->{lxs}->remotes ];
248         $self->{gits} = [ map {
249                         PublicInbox::Git->new($lei->rel2abs($_))
250                 } @{$self->{lei}->{opt}->{'git-dir'}} ];
251         $lei->{env}->{'psgi.errors'} = $lei->{2}; # ugh...
252         $lei->{env}->{TMPDIR} = $self->{rdtmp}->dirname;
253         undef;
254 }
255
256 no warnings 'once';
257 *net_merge_all_done = \&PublicInbox::LeiInput::input_only_net_merge_all_done;
258 1;