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
  11 sub new {
  12         my ($class, $git_dir) = @_;
  13         bless { git_dir => $git_dir }, $class;
  14 }
  15
  16 sub _cat_file_begin {
  17         my ($self) = @_;
  18         return if $self->{pid};
  19         my ($in_r, $in_w, $out_r, $out_w);
  20
  21         pipe($in_r, $in_w) or die "pipe failed: $!\n";
  22         pipe($out_r, $out_w) or die "pipe failed: $!\n";
  23
  24         my @cmd = ('git', "--git-dir=$self->{git_dir}", qw(cat-file --batch));
  25         my $pid = fork;
  26         defined $pid or die "fork failed: $!\n";
  27         if ($pid == 0) {
  28                 dup2(fileno($out_r), 0) or die "redirect stdin failed: $!\n";
  29                 dup2(fileno($in_w), 1) or die "redirect stdout failed: $!\n";
  30                 exec(@cmd) or die 'exec `' . join(' '). "' failed: $!\n";
  31         }
  32         close $out_r or die "close failed: $!\n";
  33         close $in_w or die "close failed: $!\n";
  34
  35         $self->{in} = $in_r;
  36         $self->{out} = $out_w;
  37         $self->{pid} = $pid;
  38 }
  39
  40 sub cat_file {
  41         my ($self, $object) = @_;
  42
  43         $object .= "\n";
  44         my $len = bytes::length($object);
  45
  46         $self->_cat_file_begin;
  47         my $written = syswrite($self->{out}, $object);
  48         if (!defined $written) {
  49                 die "pipe write error: $!\n";
  50         } elsif ($written != $len) {
  51                 die "wrote too little to pipe ($written < $len)\n";
  52         }
  53
  54         my $in = $self->{in};
  55         my $head = <$in>;
  56         $head =~ / missing$/ and return undef;
  57         $head =~ /^[0-9a-f]{40} \S+ (\d+)$/ or
  58                 die "Unexpected result from git cat-file: $head\n";
  59
  60         my $size = $1;
  61         my $bytes_left = $size;
  62         my $offset = 0;
  63         my $rv = '';
  64
  65         while ($bytes_left) {
  66                 my $read = read($in, $rv, $bytes_left, $offset);
  67                 defined($read) or die "sysread pipe failed: $!\n";
  68                 $bytes_left -= $read;
  69                 $offset += $read;
  70         }
  71
  72         my $read = read($in, my $buf, 1);
  73         defined($read) or die "read pipe failed: $!\n";
  74         if ($read != 1 || $buf ne "\n") {
  75                 die "newline missing after blob\n";
  76         }
  77         \$rv;
  78 }
  79
  80 sub DESTROY {
  81         my ($self) = @_;
  82         my $pid = $self->{pid} or return;
  83         $self->{pid} = undef;
  84         foreach my $f (qw(in out)) {
  85                 my $fh = $self->{$f};
  86                 defined $fh or next;
  87                 close $fh;
  88                 $self->{$f} = undef;
  89         }
  90         waitpid $pid, 0;
  91 }
  92
  93 1;