-# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
# "Solve" blobs which don't exist in git code repositories by
use PublicInbox::MsgIter qw(msg_part_text);
use PublicInbox::Qspawn;
use PublicInbox::Tmpfile;
+use PublicInbox::GitAsyncCat;
+use PublicInbox::Eml;
use URI::Escape qw(uri_escape_utf8);
# POSIX requires _POSIX_ARG_MAX >= 4096, and xargs is required to
my $oid_b = $want->{oid_b};
my ($oid_full, $type, $size) = $git->check($oid_b);
- # other than {oid_b, try_gits, try_ibxs}
- my $have_hints = scalar keys %$want > 3;
- if (defined($type) && (!$have_hints || $type eq 'blob')) {
+ if ($oid_b eq ($oid_full // '') || (defined($type) &&
+ (!$self->{have_hints} || $type eq 'blob'))) {
delete $want->{try_gits};
return [ $git, $oid_full, $type, int($size) ]; # done, success
}
scalar(@$try);
}
+sub _tmp {
+ $_[0]->{tmp} //=
+ File::Temp->newdir("solver.$_[0]->{oid_want}-XXXX", TMPDIR => 1);
+}
+
sub extract_diff ($$) {
my ($p, $arg) = @_;
- my ($self, $diffs, $pre, $post, $ibx, $smsg) = @$arg;
+ my ($self, $want, $smsg) = @$arg;
my ($part) = @$p; # ignore $depth and @idx;
my $ct = $part->content_type || 'text/plain';
- my ($s, undef) = msg_part_text($part, $ct);
- defined $s or return;
+ my $post = $want->{oid_b};
+ my $pre = $want->{oid_a};
+ if (!defined($pre) || $pre !~ /\A[a-f0-9]+\z/) {
+ $pre = '[a-f0-9]{7}'; # for RE below
+ }
# Email::MIME::Encodings forces QP to be CRLF upon decoding,
# change it back to LF:
my $cte = $part->header('Content-Transfer-Encoding') || '';
+ my ($s, undef) = msg_part_text($part, $ct);
+ defined $s or return;
+ delete $part->{bdy};
if ($cte =~ /\bquoted-printable\b/i && $part->crlf eq "\n") {
$s =~ s/\r\n/\n/sg;
}
-
-
$s =~ m!( # $1 start header lines we save for debugging:
# everything before ^index is optional, but we don't
# because git-apply(1) handles that case, too
(?:^(?:[\@\+\x20\-\\][^\n]*|)$LF)+
)!smx or return;
+ undef $s; # free memory
my $di = {
hdr_lines => $1,
my $path = ++$self->{tot};
$di->{n} = $path;
- open(my $tmp, '>:utf8', $self->{tmp}->dirname . "/$path") or
- die "open(tmp): $!";
+ my $f = _tmp($self)->dirname."/$path";
+ open(my $tmp, '>:utf8', $f) or die "open($f): $!";
print $tmp $di->{hdr_lines}, $patch or die "print(tmp): $!";
close $tmp or die "close(tmp): $!";
# for debugging/diagnostics:
- $di->{ibx} = $ibx;
+ $di->{ibx} = $want->{cur_ibx};
$di->{smsg} = $smsg;
- push @$diffs, $di;
+ push @{$self->{tmp_diffs}}, $di;
}
sub path_searchable ($) { defined($_[0]) && $_[0] =~ m!\A[\w/\. \-]+\z! }
join('', map { qq( dfn:"$_") } split(/\.\./, $_[0]));
}
-sub find_extract_diffs ($$$) {
+sub find_smsgs ($$$) {
my ($self, $ibx, $want) = @_;
- my $srch = $ibx->search or return;
+ my $srch = $ibx->isrch or return;
my $post = $want->{oid_b} or die 'BUG: no {oid_b}';
$post =~ /\A[a-f0-9]+\z/ or die "BUG: oid_b not hex: $post";
my $pre = $want->{oid_a};
if (defined $pre && $pre =~ /\A[a-f0-9]+\z/) {
$q .= " dfpre:$pre";
- } else {
- $pre = '[a-f0-9]{7}'; # for $re below
}
my $path_b = $want->{path_b};
$q .= filename_query($path_a);
}
}
-
my $mset = $srch->mset($q, { relevance => 1 });
- my $diffs = [];
- for my $smsg (@{$srch->mset_to_smsg($ibx, $mset)}) {
- my $eml = $ibx->smsg_eml($smsg) or next;
- $eml->each_part(\&extract_diff,
- [$self, $diffs, $pre, $post, $ibx, $smsg], 1);
- }
- @$diffs ? $diffs : undef;
+ $mset->size ? $srch->mset_to_smsg($ibx, $mset) : undef;
}
sub update_index_result ($$) {
my ($bref, $self) = @_;
- my ($qsp, $msg) = delete @$self{qw(-qsp -msg)};
- if (my $err = $qsp->{err}) {
- ERR($self, "git update-index error: $err");
- }
+ my ($qsp_err, $msg) = delete @$self{qw(-qsp_err -msg)};
+ ERR($self, "git update-index error:$qsp_err") if $qsp_err;
dbg($self, $msg);
next_step($self); # onto do_git_apply
}
# no index creation for added files
$oid_a =~ /\A0+\z/ and return next_step($self);
- die "BUG: $oid_a not not found" unless $existing;
+ die "BUG: $oid_a not found" unless $existing;
my $oid_full = $existing->[1];
my $path_a = $di->{path_a} or die "BUG: path_a missing for $oid_full";
my $cmd = [ qw(git update-index -z --index-info) ];
my $qsp = PublicInbox::Qspawn->new($cmd, $self->{git_env}, $rdr);
$path_a = git_quote($path_a);
- $self->{-qsp} = $qsp;
+ $qsp->{qsp_err} = \($self->{-qsp_err} = '');
$self->{-msg} = "index prepared:\n$mode_a $oid_full\t$path_a";
$qsp->psgi_qx($self->{psgi_env}, undef, \&update_index_result, $self);
}
# pure Perl "git init"
sub do_git_init ($) {
my ($self) = @_;
- my $dir = $self->{tmp}->dirname;
- my $git_dir = "$dir/git";
+ my $git_dir = _tmp($self)->dirname.'/git';
foreach ('', qw(objects refs objects/info refs/heads)) {
mkdir("$git_dir/$_") or die "mkdir $_: $!";
}
open my $fh, '>', "$git_dir/config" or die "open git/config: $!";
- print $fh <<'EOF' or die "print git/config $!";
+ my $first = $self->{gits}->[0];
+ my $fmt = $first->object_format;
+ my $v = defined($$fmt) ? 1 : 0;
+ print $fh <<EOF or die "print git/config $!";
[core]
- repositoryFormatVersion = 0
+ repositoryFormatVersion = $v
filemode = true
bare = false
- fsyncObjectfiles = false
logAllRefUpdates = false
EOF
+ print $fh <<EOM if defined($$fmt);
+[extensions]
+ objectformat = $$fmt
+EOM
close $fh or die "close git/config: $!";
open $fh, '>', "$git_dir/HEAD" or die "open git/HEAD: $!";
$self->{git_env} = {
GIT_DIR => $git_dir,
GIT_INDEX_FILE => "$git_dir/index",
+ GIT_TEST_FSYNC => 0, # undocumented git env
};
prepare_index($self);
}
sub parse_ls_files ($$) {
my ($self, $bref) = @_;
- my ($qsp, $di) = delete @$self{qw(-qsp -cur_di)};
- if (my $err = $qsp->{err}) {
- die "git ls-files error: $err";
- }
+ my ($qsp_err, $di) = delete @$self{qw(-qsp_err -cur_di)};
+ die "git ls-files -s -z error:$qsp_err" if $qsp_err;
- my ($line, @extra) = split(/\0/, $$bref);
+ my @ls = split(/\0/, $$bref);
+ my ($line, @extra) = grep(/\t\Q$di->{path_b}\E\z/, @ls);
scalar(@extra) and die "BUG: extra files in index: <",
- join('> <', @extra), ">";
-
+ join('> <', $line, @extra), ">";
+ $line // die "no \Q$di->{path_b}\E in <",join('> <', @ls), '>';
my ($info, $file) = split(/\t/, $line, 2);
my ($mode_b, $oid_b_full, $stage) = split(/ /, $info);
- if ($file ne $di->{path_b}) {
- die
+ $file eq $di->{path_b} or die
"BUG: index mismatch: file=$file != path_b=$di->{path_b}";
- }
my $tmp_git = $self->{tmp_git} or die 'no git working tree';
my (undef, undef, $size) = $tmp_git->check($oid_b_full);
sub apply_result ($$) {
my ($bref, $self) = @_;
- my ($qsp, $di) = delete @$self{qw(-qsp -cur_di)};
+ my ($qsp_err, $di) = delete @$self{qw(-qsp_err -cur_di)};
dbg($self, $$bref);
my $patches = $self->{patches};
- if (my $err = $qsp->{err}) {
- my $msg = "git apply error: $err";
+ if ($qsp_err) {
+ my $msg = "git apply error:$qsp_err";
my $nxt = $patches->[0];
if ($nxt && oids_same_ish($nxt->{oid_b}, $di->{oid_b})) {
dbg($self, $msg);
dbg($self, 'trying '.di_url($self, $nxt));
return do_git_apply($self);
} else {
+ $msg .= " (no patches left to try for $di->{oid_b})\n";
ERR($self, $msg);
}
} else {
}
my @cmd = qw(git ls-files -s -z);
- $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env});
+ my $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env});
$self->{-cur_di} = $di;
- $self->{-qsp} = $qsp;
+ $qsp->{qsp_err} = \($self->{-qsp_err} = '');
$qsp->psgi_qx($self->{psgi_env}, undef, \&ls_files_result, $self);
}
sub do_git_apply ($) {
my ($self) = @_;
- my $dn = $self->{tmp}->dirname;
my $patches = $self->{patches};
# we need --ignore-whitespace because some patches are CRLF
my @cmd = (qw(git apply --cached --ignore-whitespace
--unidiff-zero --whitespace=warn --verbose));
my $len = length(join(' ', @cmd));
- my $total = $self->{tot};
my $di; # keep track of the last one for "git ls-files"
my $prv_oid_b;
do {
my $i = ++$self->{nr};
$di = shift @$patches;
- dbg($self, "\napplying [$i/$total] " . di_url($self, $di) .
- "\n" . $di->{hdr_lines});
+ dbg($self, "\napplying [$i/$self->{nr_p}] " .
+ di_url($self, $di) . "\n" . $di->{hdr_lines});
my $path = $di->{n};
$len += length($path) + 1;
push @cmd, $path;
} while (@$patches && $len < $ARG_SIZE_MAX &&
!oids_same_ish($patches->[0]->{oid_b}, $prv_oid_b));
- my $opt = { 2 => 1, -C => $dn, quiet => 1 };
+ my $opt = { 2 => 1, -C => _tmp($self)->dirname, quiet => 1 };
my $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env}, $opt);
$self->{-cur_di} = $di;
- $self->{-qsp} = $qsp;
+ $qsp->{qsp_err} = \($self->{-qsp_err} = '');
$qsp->psgi_qx($self->{psgi_env}, undef, \&apply_result, $self);
}
defined($url) ? "$url$mid/" : "<$mid>";
}
+sub retry_current {
+ my ($self, $want) = @_;
+ push @{$self->{todo}}, $want;
+ next_step($self); # retry solve_existing
+}
+
+sub try_harder ($$) {
+ my ($self, $want) = @_;
+
+ # do we have more inboxes to try?
+ return retry_current($self, $want) if scalar @{$want->{try_ibxs}};
+
+ my $cur_want = $want->{oid_b};
+ if (length($cur_want) > $OID_MIN) { # maybe a shorter OID will work
+ delete $want->{try_ibxs}; # drop empty arrayref
+ chop($cur_want);
+ dbg($self, "retrying $want->{oid_b} as $cur_want");
+ $want->{oid_b} = $cur_want;
+ return retry_current($self, $want); # retry with shorter abbrev
+ }
+
+ dbg($self, "could not find $cur_want");
+ eval { done($self, undef) };
+ die "E: $@" if $@;
+}
+
+sub extract_diffs_done {
+ my ($self, $want) = @_;
+
+ delete $want->{try_smsgs};
+ delete $want->{cur_ibx};
+
+ my $diffs = delete $self->{tmp_diffs};
+ if (scalar @$diffs) {
+ unshift @{$self->{patches}}, @$diffs;
+ my %seen; # List::Util::uniq requires Perl 5.26+ :<
+ my @u = grep { !$seen{$_}++ } map { di_url($self, $_) } @$diffs;
+ dbg($self, "found $want->{oid_b} in " . join(" ||\n\t", @u));
+ ++$self->{nr_p};
+
+ # good, we can find a path to the oid we $want, now
+ # lets see if we need to apply more patches:
+ my $di = $diffs->[0];
+ my $src = $di->{oid_a};
+
+ unless ($src =~ /\A0+\z/) {
+ # we have to solve it using another oid, fine:
+ my $job = { oid_b => $src, path_b => $di->{path_a} };
+ push @{$self->{todo}}, $job;
+ }
+ return next_step($self); # onto the next todo item
+ }
+ try_harder($self, $want);
+}
+
+sub extract_diff_async {
+ my ($bref, $oid, $type, $size, $x) = @_;
+ my ($self, $want, $smsg) = @$x;
+ if (defined($oid)) {
+ $smsg->{blob} eq $oid or
+ ERR($self, "BUG: $smsg->{blob} != $oid");
+ PublicInbox::Eml->new($bref)->each_part(\&extract_diff, $x, 1);
+ }
+
+ scalar(@{$want->{try_smsgs}}) ? retry_current($self, $want)
+ : extract_diffs_done($self, $want);
+}
+
sub resolve_patch ($$) {
my ($self, $want) = @_;
+ my $cur_want = $want->{oid_b};
if (scalar(@{$self->{patches}}) > $MAX_PATCH) {
die "Aborting, too many steps to $self->{oid_want}";
}
+ if (my $msgs = $want->{try_smsgs}) {
+ my $smsg = shift @$msgs;
+ if ($self->{psgi_env}->{'pi-httpd.async'}) {
+ return ibx_async_cat($want->{cur_ibx}, $smsg->{blob},
+ \&extract_diff_async,
+ [$self, $want, $smsg]);
+ } else {
+ if (my $eml = $want->{cur_ibx}->smsg_eml($smsg)) {
+ $eml->each_part(\&extract_diff,
+ [ $self, $want, $smsg ], 1);
+ }
+ }
+
+ return scalar(@$msgs) ? retry_current($self, $want)
+ : extract_diffs_done($self, $want);
+ }
+
# see if we can find the blob in an existing git repo:
- my $cur_want = $want->{oid_b};
if (!$want->{try_ibxs} && $self->{seen_oid}->{$cur_want}++) {
die "Loop detected solving $cur_want\n";
}
mark_found($self, $cur_want, $existing);
return next_step($self); # onto patch application
} elsif ($existing > 0) {
- push @{$self->{todo}}, $want;
- return next_step($self); # retry solve_existing
+ return retry_current($self, $want);
} else { # $existing == 0: we may retry if inbox scan (below) fails
delete $want->{try_gits};
}
# scan through inboxes to look for emails which results in
# the oid we want:
- my $ibx = shift(@{$want->{try_ibxs}}) or die 'BUG: {try_ibxs} empty';
- if (my $diffs = find_extract_diffs($self, $ibx, $want)) {
- unshift @{$self->{patches}}, @$diffs;
- dbg($self, "found $cur_want in ".
- join(" ||\n\t", map { di_url($self, $_) } @$diffs));
-
- # good, we can find a path to the oid we $want, now
- # lets see if we need to apply more patches:
- my $di = $diffs->[0];
- my $src = $di->{oid_a};
-
- unless ($src =~ /\A0+\z/) {
- # we have to solve it using another oid, fine:
- my $job = { oid_b => $src, path_b => $di->{path_a} };
- push @{$self->{todo}}, $job;
- }
- return next_step($self); # onto the next todo item
- }
-
- if (scalar @{$want->{try_ibxs}}) { # do we have more inboxes to try?
- push @{$self->{todo}}, $want;
- return next_step($self);
+ my $ibx = shift(@{$want->{try_ibxs}}) or return done($self, undef);
+ if (my $msgs = find_smsgs($self, $ibx, $want)) {
+ $want->{try_smsgs} = $msgs;
+ $want->{cur_ibx} = $ibx;
+ $self->{tmp_diffs} = [];
+ return retry_current($self, $want);
}
-
- if (length($cur_want) > $OID_MIN) { # maybe a shorter OID will work
- delete $want->{try_ibxs}; # drop empty arrayref
- chop($cur_want);
- dbg($self, "retrying $want->{oid_b} as $cur_want");
- $want->{oid_b} = $cur_want;
- push @{$self->{todo}}, $want;
- return next_step($self); # retry with shorter abbrev
- }
-
- dbg($self, "could not find $cur_want");
- eval { done($self, undef) };
- die "E: $@" if $@;
+ try_harder($self, $want);
}
# this API is designed to avoid creating self-referential structures;
sub new {
my ($class, $ibx, $user_cb, $uarg) = @_;
- bless {
- gits => $ibx->{-repo_objs},
+ bless { # $ibx is undef if coderepo only (see WwwCoderepo)
+ gits => $ibx ? $ibx->{-repo_objs} : undef,
user_cb => $user_cb,
uarg => $uarg,
- # -cur_di, -qsp, -msg => temporary fields for Qspawn callbacks
+ # -cur_di, -qsp_err, -msg => temp fields for Qspawn callbacks
# TODO: config option for searching related inboxes
- inboxes => [ $ibx ],
+ inboxes => $ibx ? [ $ibx ] : [],
}, $class;
}
$self->{oid_want} = $oid_want;
$self->{out} = $out;
$self->{seen_oid} = {};
- $self->{tot} = 0;
+ $self->{tot} = $self->{nr_p} = 0;
$self->{psgi_env} = $env;
+ $self->{have_hints} = 1 if scalar keys %$hints;
$self->{todo} = [ { %$hints, oid_b => $oid_want } ];
$self->{patches} = []; # [ $di, $di, ... ]
$self->{found} = {}; # { abbr => [ ::Git, oid, type, size, $di ] }
- $self->{tmp} = File::Temp->newdir("solver.$oid_want-XXXXXXXX", TMPDIR => 1);
dbg($self, "solving $oid_want ...");
if (my $async = $env->{'pi-httpd.async'}) {