]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/GitHTTPBackend.pm
githttpbackend: simplify compatibility code
[public-inbox.git] / lib / PublicInbox / GitHTTPBackend.pm
index 97d96d526121752060ff3274dbcdfee57cfebc31..4ad3fd1ee3aca9ef0b3c44e3a9ac6598163ba825 100644 (file)
@@ -7,9 +7,14 @@ package PublicInbox::GitHTTPBackend;
 use strict;
 use warnings;
 use Fcntl qw(:seek);
-use IO::File;
-use PublicInbox::Spawn qw(spawn);
+use IO::Handle;
 use HTTP::Date qw(time2str);
+use HTTP::Status qw(status_message);
+use Plack::Util;
+use PublicInbox::Qspawn;
+
+# 32 is same as the git-daemon connection limit
+my $default_limiter = PublicInbox::Qspawn::Limiter->new(32);
 
 # n.b. serving "description" and "cloneurl" should be innocuous enough to
 # not cause problems.  serving "config" might...
@@ -22,7 +27,7 @@ my @binary = qw!
        objects/pack/pack-[a-f0-9]{40}\.(?:pack|idx)
        !;
 
-our $ANY = join('|', @binary, @text);
+our $ANY = join('|', @binary, @text, 'git-upload-pack');
 my $BIN = join('|', @binary);
 my $TEXT = join('|', @text);
 
@@ -30,30 +35,29 @@ my @no_cache = ('Expires', 'Fri, 01 Jan 1980 00:00:00 GMT',
                'Pragma', 'no-cache',
                'Cache-Control', 'no-cache, max-age=0, must-revalidate');
 
-my $nextq;
-sub do_next () {
-       my $q = $nextq;
-       $nextq = undef;
-       while (my $cb = shift @$q) {
-               $cb->(); # this may redefine nextq
-       }
-}
-
-sub r ($) {
-       my ($s) = @_;
-       [ $s, [qw(Content-Type text/plain Content-Length 0), @no_cache ], [] ]
+sub r ($;$) {
+       my ($code, $msg) = @_;
+       $msg ||= status_message($code);
+       my $len = length($msg);
+       [ $code, [qw(Content-Type text/plain Content-Length), $len, @no_cache],
+               [$msg] ]
 }
 
 sub serve {
-       my ($cgi, $git, $path) = @_;
+       my ($env, $git, $path) = @_;
+
+       # XXX compatibility... ugh, can we stop supporting this?
+       $git = PublicInbox::Git->new($git) unless ref($git);
 
-       my $service = $cgi->param('service') || '';
-       if ($service =~ /\Agit-\w+-pack\z/ || $path =~ /\Agit-\w+-pack\z/) {
-               my $ok = serve_smart($cgi, $git, $path);
+       # Documentation/technical/http-protocol.txt in git.git
+       # requires one and exactly one query parameter:
+       if ($env->{QUERY_STRING} =~ /\Aservice=git-\w+-pack\z/ ||
+                               $path =~ /\Agit-\w+-pack\z/) {
+               my $ok = serve_smart($env, $git, $path);
                return $ok if $ok;
        }
 
-       serve_dumb($cgi, $git, $path);
+       serve_dumb($env, $git, $path);
 }
 
 sub err ($@) {
@@ -67,15 +71,29 @@ sub drop_client ($) {
        }
 }
 
+my $prev = 0;
+my $exp;
+sub cache_one_year {
+       my ($h) = @_;
+       my $t = time + 31536000;
+       push @$h, 'Expires', $t == $prev ? $exp : ($exp = time2str($prev = $t)),
+               'Cache-Control', 'public, max-age=31536000';
+}
+
 sub serve_dumb {
-       my ($cgi, $git, $path) = @_;
+       my ($env, $git, $path) = @_;
 
        my @h;
        my $type;
-       if ($path =~ /\A(?:$BIN)\z/o) {
-               $type = 'application/octet-stream';
-               push @h, 'Expires', time2str(time + 31536000);
-               push @h, 'Cache-Control', 'public, max-age=31536000';
+       if ($path =~ m!\Aobjects/[a-f0-9]{2}/[a-f0-9]{38}\z!) {
+               $type = 'application/x-git-loose-object';
+               cache_one_year(\@h);
+       } elsif ($path =~ m!\Aobjects/pack/pack-[a-f0-9]{40}\.pack\z!) {
+               $type = 'application/x-git-packed-objects';
+               cache_one_year(\@h);
+       } elsif ($path =~ m!\Aobjects/pack/pack-[a-f0-9]{40}\.idx\z!) {
+               $type = 'application/x-git-packed-objects-toc';
+               cache_one_year(\@h);
        } elsif ($path =~ /\A(?:$TEXT)\z/o) {
                $type = 'text/plain';
                push @h, @no_cache;
@@ -83,11 +101,9 @@ sub serve_dumb {
                return r(404);
        }
 
-       my $f = "$git->{git_dir}/$path";
+       my $f = $git->{git_dir} . '/' . $path;
        return r(404) unless -f $f && -r _; # just in case it's a FIFO :P
-       my @st = stat(_);
-       my $size = $st[7];
-       my $env = $cgi->{env};
+       my $size = -s _;
 
        # TODO: If-Modified-Since and Last-Modified?
        open my $in, '<', $f or return r(404);
@@ -95,7 +111,7 @@ sub serve_dumb {
        my $code = 200;
        push @h, 'Content-Type', $type;
        if (($env->{HTTP_RANGE} || '') =~ /\bbytes=(\d*)-(\d*)\z/) {
-               ($code, $len) = prepare_range($cgi, $in, \@h, $1, $2, $size);
+               ($code, $len) = prepare_range($env, $in, \@h, $1, $2, $size);
                if ($code == 416) {
                        push @h, 'Content-Range', "bytes */$size";
                        return [ 416, \@h, [] ];
@@ -123,7 +139,7 @@ sub serve_dumb {
 }
 
 sub prepare_range {
-       my ($cgi, $in, $h, $beg, $end, $size) = @_;
+       my ($env, $in, $h, $beg, $end, $size) = @_;
        my $code = 200;
        my $len = $size;
        if ($beg eq '') {
@@ -157,7 +173,7 @@ sub prepare_range {
                        push @$h, "bytes $beg-$end/$size";
 
                        # FIXME: Plack::Middleware::Deflater bug?
-                       $cgi->{env}->{'psgix.no-compress'} = 1;
+                       $env->{'psgix.no-compress'} = 1;
                }
        }
        ($code, $len);
@@ -165,23 +181,12 @@ sub prepare_range {
 
 # returns undef if 403 so it falls back to dumb HTTP
 sub serve_smart {
-       my ($cgi, $git, $path) = @_;
-       my $env = $cgi->{env};
-
-       my $input = $env->{'psgi.input'};
-       my $buf;
-       my $in;
-       my $fd = eval { fileno($input) };
-       if (defined $fd && $fd >= 0) {
-               $in = $input;
-       } else {
+       my ($env, $git, $path) = @_;
+       my $in = $env->{'psgi.input'};
+       my $fd = eval { fileno($in) };
+       unless (defined $fd && $fd >= 0) {
                $in = input_to_file($env) or return r(500);
        }
-       my ($rpipe, $wpipe);
-       unless (pipe($rpipe, $wpipe)) {
-               err($env, "error creating pipe: $! - going static");
-               return;
-       }
        my %env = %ENV;
        # GIT_COMMITTER_NAME, GIT_COMMITTER_EMAIL
        # may be set in the server-process and are passed as-is
@@ -194,107 +199,81 @@ sub serve_smart {
                my $val = $env->{$name};
                $env{$name} = $val if defined $val;
        }
+       my $limiter = $git->{-httpbackend_limiter} || $default_limiter;
        my $git_dir = $git->{git_dir};
        $env{GIT_HTTP_EXPORT_ALL} = '1';
        $env{PATH_TRANSLATED} = "$git_dir/$path";
-       my %rdr = ( 0 => fileno($in), 1 => fileno($wpipe) );
-       my $pid = spawn([qw(git http-backend)], \%env, \%rdr);
-       unless (defined $pid) {
-               err($env, "error spawning: $! - going static");
-               return;
-       }
-       $wpipe = $in = undef;
-       $buf = '';
-       my ($vin, $fh, $res);
+       my $rdr = { 0 => fileno($in) };
+       my $qsp = PublicInbox::Qspawn->new([qw(git http-backend)], \%env, $rdr);
+       my ($fh, $rpipe);
+       my $end = sub {
+               if (my $err = $qsp->finish) {
+                       err($env, "git http-backend ($git_dir): $err");
+               }
+               $fh->close if $fh; # async-only
+       };
 
        # Danga::Socket users, we queue up the read_enable callback to
        # fire after pending writes are complete:
-       my $pi_http = $env->{'psgix.io'};
-       my $read_enable = sub { $rpipe->watch_read(1) };
-       my $read_disable = sub {
-               $rpipe->watch_read(0);
-               $pi_http->write($read_enable);
+       my $buf = '';
+       my $rd_hdr = sub {
+               my $r = sysread($rpipe, $buf, 1024, length($buf));
+               return if !defined($r) && ($!{EINTR} || $!{EAGAIN});
+               return r(500, 'http-backend error') unless $r;
+               $r = parse_cgi_headers(\$buf) or return; # incomplete headers
+               $r->[0] == 403 ? serve_dumb($env, $git, $path) : $r;
        };
-
-       my $end = sub {
-               if ($fh) {
-                       $fh->close;
-                       $fh = undef;
-               }
-               if ($rpipe) {
-                       # _may_ be Danga::Socket::close via
-                       # PublicInbox::HTTPD::Async::close:
-                       $rpipe->close;
-                       $rpipe = undef;
-               }
-               if (defined $pid) {
-                       my $e = $pid == waitpid($pid, 0) ?
-                               $? : "PID:$pid still running?";
-                       err($env, "git http-backend ($git_dir): $e") if $e;
+       my $res;
+       my $async = $env->{'pi-httpd.async'}; # XXX unstable API
+       my $io = $env->{'psgix.io'};
+       my $cb = sub {
+               my $r = $rd_hdr->() or return;
+               $rd_hdr = undef;
+               if (scalar(@$r) == 3) { # error:
+                       if ($async) {
+                               $async->close; # calls rpipe->close
+                       } else {
+                               $rpipe->close;
+                               $end->();
+                       }
+                       return $res->($r);
                }
-               return unless $res;
-               my $dumb = serve_dumb($cgi, $git, $path);
-               ref($dumb) eq 'ARRAY' ? $res->($dumb) : $dumb->($res);
-       };
-       my $fail = sub {
-               if ($!{EAGAIN} || $!{EINTR}) {
-                       select($vin, undef, undef, undef) if defined $vin;
-                       # $vin is undef on async, so this is a noop on EAGAIN
-                       return;
+               if ($async) {
+                       $fh = $res->($r);
+                       return $async->async_pass($io, $fh, \$buf);
                }
-               my $e = $!;
-               $end->();
-               err($env, "git http-backend ($git_dir): $e\n");
+
+               # for synchronous PSGI servers
+               require PublicInbox::GetlineBody;
+               $r->[2] = PublicInbox::GetlineBody->new($rpipe, $end, $buf);
+               $res->($r);
        };
-       my $cb = sub { # read git-http-backend output and stream to client
-               my $r = $rpipe ? $rpipe->sysread($buf, 8192, length($buf)) : 0;
-               return $fail->() unless defined $r;
-               return $end->() if $r == 0; # EOF
-               if ($fh) { # stream body from git-http-backend to HTTP client
-                       $fh->write($buf);
-                       $buf = '';
-                       $read_disable->() if $read_disable;
-               } elsif ($buf =~ s/\A(.*?)\r\n\r\n//s) { # parse headers
-                       my $h = $1;
-                       my $code = 200;
-                       my @h;
-                       foreach my $l (split(/\r\n/, $h)) {
-                               my ($k, $v) = split(/:\s*/, $l, 2);
-                               if ($k =~ /\AStatus\z/i) {
-                                       ($code) = ($v =~ /\b(\d+)\b/);
-                               } else {
-                                       push @h, $k, $v;
-                               }
-                       }
-                       if ($code == 403) {
-                               # smart cloning disabled, serve dumbly
-                               # in $end since we never undef $res in here
-                       } else { # write response header:
-                               $fh = $res->([ $code, \@h ]);
-                               $res = undef;
-                               $fh->write($buf);
+       sub {
+               ($res) = @_;
+
+               # hopefully this doesn't break any middlewares,
+               # holding the input here is a waste of FDs and memory
+               $env->{'psgi.input'} = undef;
+
+               $qsp->start($limiter, sub { # may run later, much later...
+                       ($rpipe) = @_;
+                       $in = undef;
+                       if ($async) {
+                               $async = $async->($rpipe, $cb, $end);
+                       } else { # generic PSGI
+                               $cb->() while $rd_hdr;
                        }
-                       $buf = '';
-               } # else { keep reading ... }
+               });
        };
-       if (my $async = $env->{'pi-httpd.async'}) {
-               # $async is PublicInbox::HTTPD::Async->new($rpipe, $cb)
-               $rpipe = $async->($rpipe, $cb);
-               sub { ($res) = @_ } # let Danga::Socket handle the rest.
-       } else { # synchronous loop for other PSGI servers
-               $read_enable = $read_disable = undef;
-               $vin = '';
-               vec($vin, fileno($rpipe), 1) = 1;
-               sub {
-                       ($res) = @_;
-                       while ($rpipe) { $cb->() }
-               }
-       }
 }
 
 sub input_to_file {
        my ($env) = @_;
-       my $in = IO::File->new_tmpfile;
+       open(my $in, '+>', undef);
+       unless (defined $in) {
+               err($env, "could not open temporary file: $!");
+               return;
+       }
        my $input = $env->{'psgi.input'};
        my $buf;
        while (1) {
@@ -303,12 +282,40 @@ sub input_to_file {
                        err($env, "error reading input: $!");
                        return;
                }
-               last if ($r == 0);
-               $in->write($buf);
+               my $off = 0;
+               while ($r > 0) {
+                       my $w = syswrite($in, $buf, $r, $off);
+                       if (defined $w) {
+                               $r -= $w;
+                               $off += $w;
+                       } else {
+                               err($env, "error writing temporary file: $!");
+                               return;
+                       }
+               }
+       }
+       unless (defined(sysseek($in, 0, SEEK_SET))) {
+               err($env, "error seeking temporary file: $!");
+               return;
        }
-       $in->flush;
-       $in->sysseek(0, SEEK_SET);
        return $in;
 }
 
+sub parse_cgi_headers {
+       my ($bref) = @_;
+       $$bref =~ s/\A(.*?)\r\n\r\n//s or return;
+       my $h = $1;
+       my $code = 200;
+       my @h;
+       foreach my $l (split(/\r\n/, $h)) {
+               my ($k, $v) = split(/:\s*/, $l, 2);
+               if ($k =~ /\AStatus\z/i) {
+                       ($code) = ($v =~ /\b(\d+)\b/);
+               } else {
+                       push @h, $k, $v;
+               }
+       }
+       [ $code, \@h ]
+}
+
 1;