]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/SolverGit.pm
treewide: "require" + "use" cleanup and docs
[public-inbox.git] / lib / PublicInbox / SolverGit.pm
index 9266fb087b8ca429d6e7b56a98b6a7aded339426..8629f0dafeb4216b41ac2c0951c866c8e76c2dcf 100644 (file)
@@ -10,7 +10,8 @@
 package PublicInbox::SolverGit;
 use strict;
 use warnings;
-use File::Temp 0.19 ();
+use 5.010_001;
+use File::Temp 0.19 (); # 0.19 for ->newdir
 use Fcntl qw(SEEK_SET);
 use PublicInbox::Git qw(git_unquote git_quote);
 use PublicInbox::MsgIter qw(msg_iter msg_part_text);
@@ -38,7 +39,7 @@ my $MAX_PATCH = 9999;
 #      oid_a => abbreviated pre-image oid,
 #      oid_b => abbreviated post-image oid,
 #      tmp => anonymous file handle with the diff,
-#      hdr_lines => arrayref of various header lines for mode information
+#      hdr_lines => string of various header lines for mode information
 #      mode_a => original mode of oid_a (string, not integer),
 #      ibx => PublicInbox::Inbox object containing the diff
 #      smsg => PublicInbox::SearchMsg object containing diff
@@ -47,19 +48,20 @@ my $MAX_PATCH = 9999;
 #      n => numeric path of the patch (relative to worktree)
 # }
 
-# don't bother if somebody sends us a patch with these path components,
-# it's junk at best, an attack attempt at worse:
-my %bad_component = map { $_ => 1 } ('', '.', '..');
-
 sub dbg ($$) {
        print { $_[0]->{out} } $_[1], "\n" or ERR($_[0], "print(dbg): $!");
 }
 
+sub done ($$) {
+       my ($self, $res) = @_;
+       my $ucb = delete($self->{user_cb}) or return;
+       $ucb->($res, $self->{uarg});
+}
+
 sub ERR ($$) {
        my ($self, $err) = @_;
        print { $self->{out} } $err, "\n";
-       my $ucb = delete($self->{user_cb});
-       eval { $ucb->($err) } if $ucb;
+       eval { done($self, $err) };
        die $err;
 }
 
@@ -95,14 +97,11 @@ sub solve_existing ($$) {
 
 sub extract_diff ($$) {
        my ($p, $arg) = @_;
-       my ($self, $diffs, $re, $ibx, $smsg) = @$arg;
+       my ($self, $diffs, $pre, $post, $ibx, $smsg) = @$arg;
        my ($part) = @$p; # ignore $depth and @idx;
-       my $hdr_lines; # diff --git a/... b/...
-       my $tmp;
        my $ct = $part->content_type || 'text/plain';
        my ($s, undef) = msg_part_text($part, $ct);
        defined $s or return;
-       my $di = {};
 
        # Email::MIME::Encodings forces QP to be CRLF upon decoding,
        # change it back to LF:
@@ -111,66 +110,87 @@ sub extract_diff ($$) {
                $s =~ s/\r\n/\n/sg;
        }
 
-       foreach my $l (split(/^/m, $s)) {
-               if ($l =~ $re) {
-                       $di->{oid_a} = $1;
-                       $di->{oid_b} = $2;
-                       if (defined($3)) {
-                               my $mode_a = $3;
-                               if ($mode_a =~ /\A(?:100644|120000|100755)\z/) {
-                                       $di->{mode_a} = $mode_a;
-                               }
-                       }
-
-
-                       # start writing the diff out to a tempfile
-                       my $path = ++$self->{tot};
-                       $di->{n} = $path;
-                       open($tmp, '>', $self->{tmp}->dirname . "/$path") or
-                                                       die "open(tmp): $!";
-
-                       push @$hdr_lines, $l;
-                       $di->{hdr_lines} = $hdr_lines;
-                       utf8::encode($_) for @$hdr_lines;
-                       print $tmp @$hdr_lines or die "print(tmp): $!";
-
-                       # for debugging/diagnostics:
-                       $di->{ibx} = $ibx;
-                       $di->{smsg} = $smsg;
-               } elsif ($l =~ m!\Adiff --git ("?[^/]+/.+) ("?[^/]+/.+)$!) {
-                       last if $tmp; # got our blob, done!
-
-                       my ($path_a, $path_b) = ($1, $2);
-
-                       # diff header lines won't have \r because git
-                       # will quote them, but Email::MIME gives CRLF
-                       # for quoted-printable:
-                       $path_b =~ tr/\r//d;
-
-                       # don't care for leading 'a/' and 'b/'
-                       my (undef, @a) = split(m{/}, git_unquote($path_a));
-                       my (undef, @b) = split(m{/}, git_unquote($path_b));
-
-                       # get rid of path-traversal attempts and junk patches:
-                       foreach (@a, @b) {
-                               return if $bad_component{$_};
-                       }
-
-                       $di->{path_a} = join('/', @a);
-                       $di->{path_b} = join('/', @b);
-                       $hdr_lines = [ $l ];
-               } elsif ($tmp) {
-                       utf8::encode($l);
-                       print $tmp $l or die "print(tmp): $!";
-               } elsif ($hdr_lines) {
-                       push @$hdr_lines, $l;
-                       if ($l =~ /\Anew file mode (100644|120000|100755)$/) {
-                               $di->{mode_a} = $1;
-                       }
-               }
-       }
-       return undef unless $tmp;
+       state $LF = qr!\r?\n!;
+       state $ANY = qr![^\r\n]+!;
+       state $MODE = '100644|120000|100755';
+       state $FN = qr!(?:("?[^/\n]+/[^\r\n]+)|/dev/null)!;
+
+       $s =~ m!( # $1 start header lines we save for debugging:
+
+               # everything before ^index is optional, but we don't
+               # want to match ^(old|copy|rename|deleted|...) unless
+               # we match /^diff --git/ first:
+               (?: # begin optional stuff:
+
+               # try to get the pre-and-post filenames as $2 and $3
+               (?:^diff\x20--git\x20$FN\x20$FN$LF)
+
+               (?:^(?: # pass all this to git-apply:
+                       # old mode $4
+                       (?:old\x20mode\x20($MODE))
+                       |
+                       # new mode (possibly new file) ($5)
+                       (?:new\x20(?:file\x20)?mode\x20($MODE))
+                       |
+                       (?:(?:copy|rename|deleted|
+                               dissimilarity|similarity)$ANY)
+               )$LF)*
+
+               )? # end of optional stuff, everything below is required
+
+               # match the pre and post-image OIDs as $6 $7
+               ^index\x20(${pre}[a-f0-9]*)\.\.(${post}[a-f0-9]*)
+                       # mode if unchanged $8
+                       (?:\x20(100644|120000|100755))?$LF
+       ) # end of header lines ($1)
+       ( # $9 is the patch body
+               # "--- a/foo.c" sets pre-filename ($10) in case
+               # $2 is missing
+               (?:^---\x20$FN$LF)
+
+               # "+++ b/foo.c" sets post-filename ($11) in case
+               # $3 is missing
+               (?:^\+{3}\x20$FN$LF)
+
+               # the meat of the diff, including "^\\No newline ..."
+               # We also allow for totally blank lines w/o leading spaces,
+               # because git-apply(1) handles that case, too
+               (?:^(?:[\@\+\x20\-\\][^\n]*|)$LF)+
+       )!smx or return;
+
+       my $di = {
+               hdr_lines => $1,
+               oid_a => $6,
+               oid_b => $7,
+               mode_a => $5 // $8 // $4, # new (file) // unchanged // old
+       };
+       my $path_a = $2 // $10;
+       my $path_b = $3 // $11;
+       my $patch = $9;
+
+       # don't care for leading 'a/' and 'b/'
+       my (undef, @a) = split(m{/}, git_unquote($path_a));
+       my (undef, @b) = split(m{/}, git_unquote($path_b));
+
+       # get rid of path-traversal attempts and junk patches:
+       # it's junk at best, an attack attempt at worse:
+       state $bad_component = { map { $_ => 1 } ('', '.', '..') };
+       foreach (@a, @b) { return if $bad_component->{$_} }
+
+       $di->{path_a} = join('/', @a);
+       $di->{path_b} = join('/', @b);
+
+       my $path = ++$self->{tot};
+       $di->{n} = $path;
+       open(my $tmp, '>:utf8', $self->{tmp}->dirname . "/$path") or
+               die "open(tmp): $!";
+       print $tmp $di->{hdr_lines}, $patch or die "print(tmp): $!";
        close $tmp or die "close(tmp): $!";
+
+       # for debugging/diagnostics:
+       $di->{ibx} = $ibx;
+       $di->{smsg} = $smsg;
+
        push @$diffs, $di;
 }
 
@@ -209,13 +229,13 @@ sub find_extract_diffs ($$$) {
        }
 
        my $msgs = $srch->query($q, { relevance => 1 });
-       my $re = qr/\Aindex ($pre[a-f0-9]*)\.\.($post[a-f0-9]*)(?: ([0-9]+))?/;
+
        my $diffs = [];
        foreach my $smsg (@$msgs) {
                $ibx->smsg_mime($smsg) or next;
                my $mime = delete $smsg->{mime};
                msg_iter($mime, \&extract_diff,
-                               [$self, $diffs, $re, $ibx, $smsg]);
+                               [$self, $diffs, $pre, $post, $ibx, $smsg]);
        }
        @$diffs ? $diffs : undef;
 }
@@ -246,7 +266,7 @@ sub prepare_index ($) {
 
        my $oid_full = $existing->[1];
        my $path_a = $di->{path_a} or die "BUG: path_a missing for $oid_full";
-       my $mode_a = $di->{mode_a} || extract_old_mode($di);
+       my $mode_a = $di->{mode_a} // '100644';
 
        my $in = tmpfile("update-index.$oid_full") or die "tmpfile: $!";
        print $in "$mode_a $oid_full\t$path_a\0" or die "print: $!";
@@ -254,7 +274,7 @@ sub prepare_index ($) {
        sysseek($in, 0, 0) or die "seek: $!";
 
        dbg($self, 'preparing index');
-       my $rdr = { 0 => fileno($in), -hold => $in };
+       my $rdr = { 0 => $in };
        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);
@@ -302,33 +322,23 @@ EOF
        prepare_index($self);
 }
 
-sub extract_old_mode ($) {
-       my ($di) = @_;
-       if (join('', @{$di->{hdr_lines}}) =~
-                       /^old mode (100644|100755|120000)\b/) {
-               return $1;
-       }
-       '100644';
-}
-
-sub do_finish ($$) {
-       my ($self, $user_cb) = @_;
-       my $found = $self->{found};
-       my $oid_want = $self->{oid_want};
+sub do_finish ($) {
+       my ($self) = @_;
+       my ($found, $oid_want) = @$self{qw(found oid_want)};
        if (my $exists = $found->{$oid_want}) {
-               return $user_cb->($exists);
+               return done($self, $exists);
        }
 
        # let git disambiguate if oid_want was too short,
        # but long enough to be unambiguous:
        my $tmp_git = $self->{tmp_git};
        if (my @res = $tmp_git->check($oid_want)) {
-               return $user_cb->($found->{$res[0]});
+               return done($self, $found->{$res[0]});
        }
        if (my $err = $tmp_git->last_check_err) {
                dbg($self, $err);
        }
-       $user_cb->(undef);
+       done($self, undef);
 }
 
 sub event_step ($) {
@@ -352,8 +362,8 @@ sub event_step ($) {
                # our result: (which may be undef)
                # Other steps may call user_cb to terminate prematurely
                # on error
-               } elsif (my $user_cb = delete($self->{user_cb})) {
-                       do_finish($self, $user_cb);
+               } elsif (exists $self->{user_cb}) {
+                       do_finish($self);
                } else {
                        die 'about to call user_cb twice'; # Oops :x
                }
@@ -362,8 +372,7 @@ sub event_step ($) {
        if ($err) {
                $err =~ s/^\s*Exception:\s*//; # bad word to show users :P
                dbg($self, "E: $err");
-               my $ucb = delete($self->{user_cb});
-               eval { $ucb->($err) } if $ucb;
+               eval { done($self, $err) };
        }
 }
 
@@ -449,6 +458,7 @@ sub apply_result ($$) {
                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 {
                        ERR($self, $msg);
                }
@@ -469,7 +479,7 @@ sub do_git_apply ($) {
        my $patches = $self->{patches};
 
        # we need --ignore-whitespace because some patches are CRLF
-       my @cmd = (qw(git -C), $dn, qw(apply --cached --ignore-whitespace
+       my @cmd = (qw(git apply --cached --ignore-whitespace
                        --unidiff-zero --whitespace=warn --verbose));
        my $len = length(join(' ', @cmd));
        my $total = $self->{tot};
@@ -480,7 +490,7 @@ sub do_git_apply ($) {
                my $i = ++$self->{nr};
                $di = shift @$patches;
                dbg($self, "\napplying [$i/$total] " . di_url($self, $di) .
-                       "\n" . join('', @{$di->{hdr_lines}}));
+                       "\n" . $di->{hdr_lines});
                my $path = $di->{n};
                $len += length($path) + 1;
                push @cmd, $path;
@@ -488,8 +498,8 @@ sub do_git_apply ($) {
        } while (@$patches && $len < $ARG_SIZE_MAX &&
                 !oids_same_ish($patches->[0]->{oid_b}, $prv_oid_b));
 
-       my $rdr = { 2 => 1 };
-       my $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env}, $rdr);
+       my $opt = { 2 => 1, -C => $dn, quiet => 1 };
+       my $qsp = PublicInbox::Qspawn->new(\@cmd, $self->{git_env}, $opt);
        $self->{-cur_di} = $di;
        $self->{-qsp} = $qsp;
        $qsp->psgi_qx($self->{psgi_env}, undef, \&apply_result, $self);
@@ -524,7 +534,7 @@ sub resolve_patch ($$) {
                        join("\n", $found_git->pub_urls($self->{psgi_env})));
 
                if ($cur_want eq $self->{oid_want} || $type ne 'blob') {
-                       eval { delete($self->{user_cb})->($existing) };
+                       eval { done($self, $existing) };
                        die "E: $@" if $@;
                        return;
                }
@@ -562,18 +572,19 @@ sub resolve_patch ($$) {
        }
 
        dbg($self, "could not find $cur_want");
-       eval { delete($self->{user_cb})->(undef) }; # not found! :<
+       eval { done($self, undef) };
        die "E: $@" if $@;
 }
 
 # this API is designed to avoid creating self-referential structures;
 # so user_cb never references the SolverGit object
 sub new {
-       my ($class, $ibx, $user_cb) = @_;
+       my ($class, $ibx, $user_cb, $uarg) = @_;
 
        bless {
                gits => $ibx->{-repo_objs},
                user_cb => $user_cb,
+               uarg => $uarg,
                # -cur_di, -qsp, -msg => temporary fields for Qspawn callbacks
 
                # TODO: config option for searching related inboxes
@@ -591,7 +602,7 @@ sub solve ($$$$$) {
 
        # should we even get here? Probably not, but somebody
        # could be manually typing URLs:
-       return (delete $self->{user_cb})->(undef) if $oid_want =~ /\A0+\z/;
+       return done($self, undef) if $oid_want =~ /\A0+\z/;
 
        $self->{oid_want} = $oid_want;
        $self->{out} = $out;