lib/PublicInbox/GitCatFile.pm

   1 # Copyright (C) 2014-2015 all contributors <meta@public-inbox.org>
   2 # License: GPLv2 or later (https://www.gnu.org/licenses/gpl-2.0.txt)
   3 # This is based on code in Git.pm which is GPLv2, but modified to avoid
   4 # dependence on environment variables for compatibility with mod_perl.
   5 # There are also API changes to simplify our usage and data set.
   6 package PublicInbox::GitCatFile;
   7 use strict;
   8 use warnings;
   9 use POSIX qw(dup2);
  10 require IO::Handle;
  11 use fields qw(git_dir pid in out);
  12
  13 sub new {
  14         my ($class, $git_dir) = @_;
  15         my $self = fields::new($class);
  16         $self->{git_dir} = $git_dir;
  17         $self;
  18 }
  19
  20 sub _cat_file_begin {
  21         my ($self) = @_;
  22         return if $self->{pid};
  23         my ($in_r, $in_w, $out_r, $out_w);
  24
  25         pipe($in_r, $in_w) or die "pipe failed: $!\n";
  26         pipe($out_r, $out_w) or die "pipe failed: $!\n";
  27
  28         my @cmd = ('git', "--git-dir=$self->{git_dir}", qw(cat-file --batch));
  29         my $pid = fork;
  30         defined $pid or die "fork failed: $!\n";
  31         if ($pid == 0) {
  32                 dup2(fileno($out_r), 0) or die "redirect stdin failed: $!\n";
  33                 dup2(fileno($in_w), 1) or die "redirect stdout failed: $!\n";
  34                 exec(@cmd) or die 'exec `' . join(' '). "' failed: $!\n";
  35         }
  36         close $out_r or die "close failed: $!\n";
  37         close $in_w or die "close failed: $!\n";
  38         $out_w->autoflush(1);
  39
  40         $self->{in} = $in_r;
  41         $self->{out} = $out_w;
  42         $self->{pid} = $pid;
  43 }
  44
  45 sub cat_file {
  46         my ($self, $object, $sizeref) = @_;
  47
  48         $self->_cat_file_begin;
  49         print { $self->{out} } $object, "\n" or die "pipe write error: $!\n";
  50
  51         my $in = $self->{in};
  52         my $head = <$in>;
  53         $head =~ / missing$/ and return undef;
  54         $head =~ /^[0-9a-f]{40} \S+ (\d+)$/ or
  55                 die "Unexpected result from git cat-file: $head\n";
  56
  57         my $size = $1;
  58         $$sizeref = $size if $sizeref;
  59         my $bytes_left = $size;
  60         my $offset = 0;
  61         my $rv = '';
  62
  63         while ($bytes_left) {
  64                 my $read = read($in, $rv, $bytes_left, $offset);
  65                 defined($read) or die "sysread pipe failed: $!\n";
  66                 $bytes_left -= $read;
  67                 $offset += $read;
  68         }
  69
  70         my $read = read($in, my $buf, 1);
  71         defined($read) or die "read pipe failed: $!\n";
  72         if ($read != 1 || $buf ne "\n") {
  73                 die "newline missing after blob\n";
  74         }
  75         \$rv;
  76 }
  77
  78 sub DESTROY {
  79         my ($self) = @_;
  80         my $pid = $self->{pid} or return;
  81         $self->{pid} = undef;
  82         foreach my $f (qw(in out)) {
  83                 my $fh = $self->{$f};
  84                 defined $fh or next;
  85                 close $fh;
  86                 $self->{$f} = undef;
  87         }
  88         waitpid $pid, 0;
  89 }
  90
  91 1;