lib/PublicInbox/GitCatFile.pm

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