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 warn(<<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 _lei_diff_prepare ($$) {
  60         my ($lei, $cmd) = @_;
  61         my $opt = $lei->{opt};
  62         push @$cmd, '--'.($opt->{color} && !$opt->{'no-color'} ? '' : 'no-').
  63                         'color';
  64         for my $o (@PublicInbox::LEI::diff_opt) {
  65                 my $c = '';
  66                 # remove single char short option
  67                 $o =~ s/\|([a-z0-9])\b//i and $c = $1;
  68                 if ($o =~ s/=[is]@\z//) {
  69                         my $v = $opt->{$o} or next;
  70                         push @$cmd, map { $c ? "-$c$_" : "--$o=$_" } @$v;
  71                 } elsif ($o =~ s/=[is]\z//) {
  72                         my $v = $opt->{$o} // next;
  73                         push @$cmd, $c ? "-$c$v" : "--$o=$v";
  74                 } elsif ($o =~ s/:[is]\z//) {
  75                         my $v = $opt->{$o} // next;
  76                         push @$cmd, $c ? "-$c$v" :
  77                                         ($v eq '' ? "--$o" : "--$o=$v");
  78                 } elsif ($o =~ s/!\z//) {
  79                         my $v = $opt->{$o} // next;
  80                         push @$cmd, $v ? "--$o" : "--no-$o";
  81                 } elsif ($opt->{$o}) {
  82                         push @$cmd, $c ? "-$c" : "--$o";
  83                 }
  84         }
  85 }
  86
  87 sub diff_ctxq ($$) {
  88         my ($self, $ctxq) = @_;
  89         return unless $ctxq;
  90         my $blob = $self->{blob};
  91         my $ta = <<'EOM';
  92 reset refs/heads/A
  93 commit refs/heads/A
  94 author <a@s> 0 +0000
  95 committer <c@s> 0 +0000
  96 data 0
  97 EOM
  98         my $tb = $ta;
  99         $tb =~ tr!A!B!;
 100         my $lei = $self->{lei};
 101         while (my ($oid_a, $oid_b, $pa, $pb, $ma, $mb) = splice(@$ctxq, 0, 6)) {
 102                 my $xa = $blob->{$oid_a} //= solve_1($self, $oid_a,
 103                                                         { path_b => $pa });
 104                 my $xb = $blob->{$oid_b} //= solve_1($self, $oid_b, {
 105                                                 oid_a => $oid_a,
 106                                                 path_a => $pa,
 107                                                 path_b => $pb
 108                                         });
 109                 $ta .= "M $ma $xa ".git_quote($pa)."\n" if $xa;
 110                 $tb .= "M $mb $xb ".git_quote($pb)."\n" if $xb;
 111         }
 112         my $rw = $self->{gits}->[-1]; # has all known alternates
 113         if (!$rw->{-tmp}) {
 114                 my $d = "$self->{rdtmp}/for_tree.git";
 115                 -d $d or PublicInbox::Import::init_bare($d);
 116                 my $f = "$d/objects/info/alternates"; # always overwrite
 117                 open my $fh, '>', $f or die "open $f: $!";
 118                 for my $git (@{$self->{gits}}) {
 119                         print $fh $git->git_path('objects'),"\n";
 120                 }
 121                 close $fh or die "close $f: $!";
 122                 $rw = PublicInbox::Git->new($d);
 123         }
 124         pipe(my ($r, $w)) or die "pipe: $!";
 125         my $pid = spawn(['git', "--git-dir=$rw->{git_dir}",
 126                         qw(fast-import --quiet --done --date-format=raw)],
 127                         $lei->{env}, { 2 => $lei->{2}, 0 => $r });
 128         close $r or die "close r fast-import: $!";
 129         print $w $ta, "\n", $tb, "\ndone\n" or die "print fast-import: $!";
 130         close $w or die "close w fast-import: $!";
 131         waitpid($pid, 0);
 132         die "fast-import failed: \$?=$?" if $?;
 133
 134         my $cmd = [ 'diff' ];
 135         _lei_diff_prepare($lei, $cmd);
 136         $lei->qerr("# git @$cmd");
 137         push @$cmd, qw(A B);
 138         unshift @$cmd, 'git', "--git-dir=$rw->{git_dir}";
 139         $pid = spawn($cmd, $lei->{env}, { 2 => $lei->{2}, 1 => $lei->{1} });
 140         waitpid($pid, 0);
 141         $lei->child_error($?) if $?; # for git diff --exit-code
 142         undef;
 143 }
 144
 145 sub wait_requote ($$$) { # OnDestroy callback
 146         my ($lei, $pid, $old_1) = @_;
 147         $lei->{1} = $old_1; # closes stdin of `perl -pE 's/^/> /'`
 148         waitpid($pid, 0) == $pid or die "BUG(?) waitpid: \$!=$! \$?=$?";
 149         $lei->child_error($?) if $?;
 150 }
 151
 152 sub requote ($$) {
 153         my ($lei, $pfx) = @_;
 154         pipe(my($r, $w)) or die "pipe: $!";
 155         my $rdr = { 0 => $r, 1 => $lei->{1}, 2 => $lei->{2} };
 156         # $^X (perl) is overkill, but maybe there's a weird system w/o sed
 157         my $pid = spawn([$^X, '-pE', "s/^/$pfx/"], $lei->{env}, $rdr);
 158         my $old_1 = $lei->{1};
 159         $w->autoflush(1);
 160         binmode $w, ':utf8';
 161         $lei->{1} = $w;
 162         PublicInbox::OnDestroy->new(\&wait_requote, $lei, $pid, $old_1);
 163 }
 164
 165 sub extract_oids { # Eml each_part callback
 166         my ($ary, $self) = @_;
 167         my ($p, undef, $idx) = @$ary;
 168         $self->{lei}->out($p->header_obj->as_string, "\n");
 169         my ($s, undef) = msg_part_text($p, $p->content_type || 'text/plain');
 170         defined $s or return;
 171         my $rq;
 172         if ($self->{dqre} && $s =~ s/$self->{dqre}//g) { # '> ' prefix(es)
 173                 $rq = requote($self->{lei}, $1) if $self->{lei}->{opt}->{drq};
 174         }
 175         my @top = split($PublicInbox::ViewDiff::EXTRACT_DIFFS, $s);
 176         undef $s;
 177         my $blobs = $self->{blobs}; # blobs to resolve
 178         my $ctxq;
 179         while (defined(my $x = shift @top)) {
 180                 if (scalar(@top) >= 4 &&
 181                                 $top[1] =~ $PublicInbox::ViewDiff::IS_OID &&
 182                                 $top[0] =~ $PublicInbox::ViewDiff::IS_OID) {
 183                         my ($ma, $mb);
 184                         $x =~ /^old mode $MODE/sm and $ma = $1;
 185                         $x =~ /^new mode $MODE/sm and $mb = $1;
 186                         if (!defined($ma) && $x =~
 187                                 /^index [a-z0-9]+\.\.[a-z0-9]+ $MODE/sm) {
 188                                 $ma = $mb = $1;
 189                         }
 190                         $ma //= '100644';
 191                         $mb //= $ma;
 192                         my ($oid_a, $oid_b, $pa, $pb) = splice(@top, 0, 4);
 193                         $pa eq '/dev/null' or
 194                                 $pa = (split(m'/', git_unquote($pa), 2))[1];
 195                         $pb eq '/dev/null' or
 196                                 $pb = (split(m'/', git_unquote($pb), 2))[1];
 197                         $blobs->{$oid_a} //= undef;
 198                         $blobs->{$oid_b} //= undef;
 199                         push @$ctxq, $oid_a, $oid_b, $pa, $pb, $ma, $mb;
 200                 } elsif ($ctxq) {
 201                         my @out;
 202                         for (split(/^/sm, $x)) {
 203                                 if (/\A-- \r?\n/s) { # email sig starts
 204                                         push @out, $_;
 205                                         $ctxq = diff_ctxq($self, $ctxq);
 206                                 } elsif ($ctxq && (/\A[\+\- ]/ || /\A@@ / ||
 207                                         # allow totally blank lines w/o leading
 208                                         # SP, git-apply does:
 209                                                         /\A\r?\n/s)) {
 210                                         next;
 211                                 } else {
 212                                         push @out, $_;
 213                                 }
 214                         }
 215                         $self->{lei}->out(@out) if @out;
 216                 } else {
 217                         $ctxq = diff_ctxq($self, $ctxq);
 218                         $self->{lei}->out($x);
 219                 }
 220         }
 221         $ctxq = diff_ctxq($self, $ctxq);
 222 }
 223
 224 # ensure dequoted parts are available for rebuilding patches:
 225 sub dequote_add { # Eml each_part callback
 226         my ($ary, $self) = @_;
 227         my ($p, undef, $idx) = @$ary;
 228         my ($s, undef) = msg_part_text($p, $p->content_type || 'text/plain');
 229         defined $s or return;
 230         if ($s =~ s/$self->{dqre}//g) { # remove '> ' prefix(es)
 231                 substr($s, 0, 0, "part-dequoted: $idx\n\n");
 232                 utf8::encode($s);
 233                 $self->{tmp_sto}->add_eml(PublicInbox::Eml->new(\$s));
 234         }
 235 }
 236
 237 sub input_eml_cb { # callback for all emails
 238         my ($self, $eml) = @_;
 239         {
 240                 local $SIG{__WARN__} = sub {
 241                         return if "@_" =~ /^no email in From: .*? or Sender:/;
 242                         return if PublicInbox::Eml::warn_ignore(@_);
 243                         warn @_;
 244                 };
 245                 $self->{tmp_sto}->add_eml($eml);
 246                 $eml->each_part(\&dequote_add, $self) if $self->{dqre};
 247                 $self->{tmp_sto}->done;
 248         }
 249         $eml->each_part(\&extract_oids, $self, 1);
 250 }
 251
 252 sub lei_rediff {
 253         my ($lei, @inputs) = @_;
 254         ($lei->{opt}->{drq} && $lei->{opt}->{'dequote-only'}) and return
 255                 $lei->fail('--drq and --dequote-only are mutually exclusive');
 256         ($lei->{opt}->{drq} && !$lei->{opt}->{verbose}) and
 257                 $lei->{opt}->{quiet} //= 1;
 258         $lei->_lei_store(1)->write_prepare($lei);
 259         $lei->{opt}->{'in-format'} //= 'eml' if $lei->{opt}->{stdin};
 260         # maybe it's a non-email (code) blob from a coderepo
 261         my $git_dirs = $lei->{opt}->{'git-dir'} //= [];
 262         if ($lei->{opt}->{cwd} // 1) {
 263                 my $cgd = PublicInbox::LeiBlob::get_git_dir($lei, '.');
 264                 unshift(@$git_dirs, $cgd) if defined $cgd;
 265         }
 266         return $lei->fail('no --git-dir to try') unless @$git_dirs;
 267         my $lxs = $lei->lxs_prepare;
 268         if ($lxs->remotes) {
 269                 require PublicInbox::LeiRemote;
 270                 $lei->{curl} //= which('curl') or return
 271                         $lei->fail('curl needed for', $lxs->remotes);
 272         }
 273         $lei->ale->refresh_externals($lxs, $lei);
 274         my $self = bless {
 275                 -force_eml => 1, # for LeiInput->input_fh
 276                 lxs => $lxs,
 277         }, __PACKAGE__;
 278         $self->prepare_inputs($lei, \@inputs) or return;
 279         my $isatty = -t $lei->{1};
 280         $lei->{opt}->{color} //= $isatty;
 281         $lei->start_pager if $isatty;
 282         $lei->wq1_start($self);
 283 }
 284
 285 sub ipc_atfork_child {
 286         my ($self) = @_;
 287         PublicInbox::LeiInput::input_only_atfork_child(@_);
 288         my $lei = $self->{lei};
 289         $lei->{1}->autoflush(1);
 290         binmode $lei->{1}, ':utf8';
 291         $self->{blobs} = {}; # oidhex => filename
 292         $self->{rdtmp} = File::Temp->newdir('lei-rediff-XXXX', TMPDIR => 1);
 293         $self->{tmp_sto} = PublicInbox::LeiStore->new(
 294                         "$self->{rdtmp}/tmp.store",
 295                         { creat => { nproc => 1 }, indexlevel => 'medium' });
 296         $self->{tmp_sto}->{priv_eidx}->{parallel} = 0;
 297         $self->{rmt} = [ $self->{tmp_sto}->search, map {
 298                         PublicInbox::LeiRemote->new($lei, $_)
 299                 } $self->{lxs}->remotes ];
 300         $self->{gits} = [ map {
 301                         PublicInbox::Git->new($lei->rel2abs($_))
 302                 } @{$self->{lei}->{opt}->{'git-dir'}} ];
 303         $lei->{env}->{TMPDIR} = $self->{rdtmp}->dirname;
 304         if (my $nr = ($lei->{opt}->{drq} || $lei->{opt}->{'dequote-only'})) {
 305                 my $re = '\s*> ' x $nr;
 306                 $self->{dqre} = qr/^($re)/ms;
 307         }
 308         undef;
 309 }
 310
 311 no warnings 'once';
 312 *net_merge_all_done = \&PublicInbox::LeiInput::input_only_net_merge_all_done;
 313 1;