diff options
Diffstat (limited to 'lib/PublicInbox/SolverGit.pm')
| -rw-r--r-- | lib/PublicInbox/SolverGit.pm | 98 |
1 files changed, 50 insertions, 48 deletions
diff --git a/lib/PublicInbox/SolverGit.pm b/lib/PublicInbox/SolverGit.pm index 80bb0a17..b5f6b96e 100644 --- a/lib/PublicInbox/SolverGit.pm +++ b/lib/PublicInbox/SolverGit.pm @@ -11,13 +11,16 @@ package PublicInbox::SolverGit; use strict; use v5.10.1; use File::Temp 0.19 (); # 0.19 for ->newdir +use autodie qw(mkdir); use Fcntl qw(SEEK_SET); -use PublicInbox::Git qw(git_unquote git_quote); +use PublicInbox::Git qw(git_unquote git_quote git_exe); +use PublicInbox::IO qw(write_file); use PublicInbox::MsgIter qw(msg_part_text); use PublicInbox::Qspawn; use PublicInbox::Tmpfile; use PublicInbox::GitAsyncCat; use PublicInbox::Eml; +use PublicInbox::Compat qw(uniqstr); use URI::Escape qw(uri_escape_utf8); # POSIX requires _POSIX_ARG_MAX >= 4096, and xargs is required to @@ -79,10 +82,13 @@ sub solve_existing ($$) { my $try = $want->{try_gits} //= [ @{$self->{gits}} ]; # array copy my $git = shift @$try or die 'BUG {try_gits} empty'; my $oid_b = $want->{oid_b}; + + # can't use async_check due to last_check_err :< my ($oid_full, $type, $size) = $git->check($oid_b); + $git->schedule_cleanup if $self->{psgi_env}->{'pi-httpd.async'}; if ($oid_b eq ($oid_full // '') || (defined($type) && -- (!$self->{have_hints} || $type eq 'blob'))) { + (!$self->{have_hints} || $type eq 'blob'))) { delete $want->{try_gits}; return [ $git, $oid_full, $type, int($size) ]; # done, success } @@ -130,6 +136,12 @@ sub extract_diff ($$) { if ($cte =~ /\bquoted-printable\b/i && $part->crlf eq "\n") { $s =~ s/\r\n/\n/sg; } + + # Quiet "Complex regular subexpression recursion limit" warning. + # Not much we can do about it, but it's no longer relevant to + # Perl 5.3x (the warning was removed in 5.37.1, and actual + # recursino sometime before then). + no warnings 'regexp'; $s =~ m!( # $1 start header lines we save for debugging: # everything before ^index is optional, but we don't @@ -198,9 +210,7 @@ sub extract_diff ($$) { my $path = ++$self->{tot}; $di->{n} = $path; 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): $!"; + write_file '>:utf8', $f, $di->{hdr_lines}, $patch; # for debugging/diagnostics: $di->{ibx} = $want->{cur_ibx}; @@ -252,6 +262,12 @@ sub update_index_result ($$) { next_step($self); # onto do_git_apply } +sub qsp_qx ($$$) { + my ($self, $qsp, $cb) = @_; + $qsp->{qsp_err} = \($self->{-qsp_err} = ''); + $qsp->psgi_qx($self->{psgi_env}, $self->{limiter}, $cb, $self); +} + sub prepare_index ($) { my ($self) = @_; my $patches = $self->{patches}; @@ -277,12 +293,11 @@ sub prepare_index ($) { dbg($self, 'preparing index'); my $rdr = { 0 => $in }; - my $cmd = [ qw(git update-index -z --index-info) ]; + my $cmd = [ git_exe, qw(update-index -z --index-info) ]; my $qsp = PublicInbox::Qspawn->new($cmd, $self->{git_env}, $rdr); $path_a = git_quote($path_a); - $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); + qsp_qx $self, $qsp, \&update_index_result; } # pure Perl "git init" @@ -290,36 +305,24 @@ sub do_git_init ($) { my ($self) = @_; 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: $!"; + mkdir("$git_dir/$_") for ('', qw(objects refs objects/info refs/heads)); my $first = $self->{gits}->[0]; my $fmt = $first->object_format; - my $v = defined($$fmt) ? 1 : 0; - print $fh <<EOF or die "print git/config $!"; + my ($v, @ext) = defined($$fmt) ? (1, <<EOM) : (0); +[extensions] + objectformat = $$fmt +EOM + write_file '>', "$git_dir/config", <<EOF, @ext; [core] repositoryFormatVersion = $v filemode = true bare = 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: $!"; - print $fh "ref: refs/heads/master\n" or die "print git/HEAD: $!"; - close $fh or die "close git/HEAD: $!"; - - my $f = 'objects/info/alternates'; - open $fh, '>', "$git_dir/$f" or die "open: $f: $!"; - foreach my $git (@{$self->{gits}}) { - print $fh $git->git_path('objects'),"\n" or die "print $f: $!"; - } - close $fh or die "close: $f: $!"; + write_file '>', "$git_dir/HEAD", "ref: refs/heads/master\n"; + write_file '>', "$git_dir/objects/info/alternates", map { + $_->git_path('objects')."\n" + } @{$self->{gits}}; my $tmp_git = $self->{tmp_git} = PublicInbox::Git->new($git_dir); $tmp_git->{-tmp} = $self->{tmp}; $self->{git_env} = { @@ -385,12 +388,9 @@ sub event_step ($) { } sub next_step ($) { - my ($self) = @_; # if outside of public-inbox-httpd, caller is expected to be # looping event_step, anyways - my $async = $self->{psgi_env}->{'pi-httpd.async'} or return; - # PublicInbox::HTTPD::Async->new - $async->(undef, undef, $self); + PublicInbox::DS::requeue($_[0]) if $_[0]->{psgi_env}->{'pi-httpd.async'} } sub mark_found ($$$) { @@ -452,7 +452,7 @@ sub skip_identical ($$$) { } } -sub apply_result ($$) { +sub apply_result ($$) { # qx_cb my ($bref, $self) = @_; my ($qsp_err, $di) = delete @$self{qw(-qsp_err -cur_di)}; dbg($self, $$bref); @@ -465,17 +465,18 @@ sub apply_result ($$) { dbg($self, 'trying '.di_url($self, $nxt)); return do_git_apply($self); } else { - ERR($self, $msg); + $msg .= " (no patches left to try for $di->{oid_b})\n"; + dbg($self, $msg); + return done($self, undef); } } else { skip_identical($self, $patches, $di->{oid_b}); } - my @cmd = qw(git ls-files -s -z); + my @cmd = (git_exe, qw(ls-files -s -z)); my $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env}); $self->{-cur_di} = $di; - $qsp->{qsp_err} = \($self->{-qsp_err} = ''); - $qsp->psgi_qx($self->{psgi_env}, undef, \&ls_files_result, $self); + qsp_qx $self, $qsp, \&ls_files_result; } sub do_git_apply ($) { @@ -483,7 +484,7 @@ sub do_git_apply ($) { my $patches = $self->{patches}; # we need --ignore-whitespace because some patches are CRLF - my @cmd = (qw(git apply --cached --ignore-whitespace + my @cmd = (git_exe, qw(apply --cached --ignore-whitespace --unidiff-zero --whitespace=warn --verbose)); my $len = length(join(' ', @cmd)); my $di; # keep track of the last one for "git ls-files" @@ -504,8 +505,7 @@ sub do_git_apply ($) { my $opt = { 2 => 1, -C => _tmp($self)->dirname, quiet => 1 }; my $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env}, $opt); $self->{-cur_di} = $di; - $qsp->{qsp_err} = \($self->{-qsp_err} = ''); - $qsp->psgi_qx($self->{psgi_env}, undef, \&apply_result, $self); + qsp_qx $self, $qsp, \&apply_result; } sub di_url ($$) { @@ -554,8 +554,7 @@ sub extract_diffs_done { 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; + my @u = uniqstr(map { di_url($self, $_) } @$diffs); dbg($self, "found $want->{oid_b} in " . join(" ||\n\t", @u)); ++$self->{nr_p}; @@ -653,9 +652,13 @@ sub resolve_patch ($$) { # so user_cb never references the SolverGit object sub new { my ($class, $ibx, $user_cb, $uarg) = @_; + my $gits = $ibx ? $ibx->{-repo_objs} : undef; + + # FIXME: cindex --join= is super-aggressive and may hit too many + $gits = [ @$gits[0..2] ] if $gits && @$gits > 3; bless { # $ibx is undef if coderepo only (see WwwCoderepo) - gits => $ibx ? $ibx->{-repo_objs} : undef, + gits => $gits, user_cb => $user_cb, uarg => $uarg, # -cur_di, -qsp_err, -msg => temp fields for Qspawn callbacks @@ -688,9 +691,8 @@ sub solve ($$$$$) { $self->{found} = {}; # { abbr => [ ::Git, oid, type, size, $di ] } dbg($self, "solving $oid_want ..."); - if (my $async = $env->{'pi-httpd.async'}) { - # PublicInbox::HTTPD::Async->new - $async->(undef, undef, $self); + if ($env->{'pi-httpd.async'}) { + PublicInbox::DS::requeue($self); } else { event_step($self) while $self->{user_cb}; } |