[PATCH] git-http-backend: memory usage fix for static files

[Eric Wong <e@80x24.org>]

When serving large static files, Danga::Socket::write may queue
up callbacks and defer firing them until the socket is writable.
This prevents us from scheduling writes or buffering until we
know the socket is writable.  This prevents needless buffering
by Danga::Socket.

TODO: implement this for smart HTTP, too, but that would
throttle pack generation; so maybe not a good idea?
---
 lib/PublicInbox/GitHTTPBackend.pm | 98 ++++++++++++++++++++++++++++-----------
 t/githttpbackend.psgi             | 25 ++++++++++
 2 files changed, 96 insertions(+), 27 deletions(-)
 create mode 100644 t/githttpbackend.psgi

diff --git a/lib/PublicInbox/GitHTTPBackend.pm b/lib/PublicInbox/GitHTTPBackend.pm
index 4b39693..5863462 100644
--- a/lib/PublicInbox/GitHTTPBackend.pm
+++ b/lib/PublicInbox/GitHTTPBackend.pm
@@ -33,6 +33,15 @@ our $ANY = join('|', @binary, @text);
 my $BIN = join('|', @binary);
 my $TEXT = join('|', @text);
 
+my $nextq;
+sub do_next () {
+	my $q = $nextq;
+	$nextq = undef;
+	while (my $cb = shift @$q) {
+		$cb->(); # this may redefine nextq
+	}
+}
+
 sub r {
 	[ $_[0] , [qw(Content-Type text/plain Content-Length 0) ], [] ]
 }
@@ -50,6 +59,17 @@ sub serve {
 	serve_dumb($cgi, $git, $path);
 }
 
+sub err ($@) {
+	my ($env, @msg) = @_;
+	$env->{'psgi.errors'}->print(@msg, "\n");
+}
+
+sub drop_client ($) {
+	if (my $io = $_[0]->{'psgix.io'}) {
+		$io->close; # this is Danga::Socket::close
+	}
+}
+
 sub serve_dumb {
 	my ($cgi, $git, $path) = @_;
 
@@ -61,18 +81,51 @@ sub serve_dumb {
 	} else {
 		return r(404);
 	}
+
 	my $f = "$git->{git_dir}/$path";
-	return r(404) unless -f $f && -r _;
+	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};
 
-	# TODO: If-Modified-Since and Last-Modified
+	# TODO: If-Modified-Since and Last-Modified?
 	open my $in, '<', $f or return r(404);
-	my $code = 200;
 	my $len = $size;
-	my @h;
+	my $n = 65536; # try to negotiate a big TCP window, first
+	my ($next, $fh);
+	my $cb = sub {
+		$n = $len if $len < $n;
+		my $r = sysread($in, my $buf, $n);
+		if (!defined $r) {
+			err($env, "$f read error: $!");
+			drop_client($env);
+		} elsif ($r <= 0) {
+			err($env, "$f EOF with $len bytes left");
+			drop_client($env);
+		} else {
+			$len -= $r;
+			$fh->write($buf);
+			if ($len == 0) {
+				$fh->close;
+			} elsif ($next) {
+				# avoid recursion in Danga::Socket::write
+				unless ($nextq) {
+					$nextq = [];
+					Danga::Socket->AddTimer(0, *do_next);
+				}
+				# avoid buffering too much in case we have
+				# slow clients:
+				$n = 8192;
+				push @$nextq, $next;
+				return;
+			}
+		}
+		# all done, cleanup references:
+		$fh = $next = undef;
+	};
 
-	my $env = $cgi->{env};
+	my $code = 200;
+	my @h;
 	my $range = $env->{HTTP_RANGE};
 	if (defined $range && $range =~ /\bbytes=(\d*)-(\d*)\z/) {
 		($code, $len) = prepare_range($cgi, $in, \@h, $1, $2, $size);
@@ -81,22 +134,17 @@ sub serve_dumb {
 			return [ 416, \@h, [] ];
 		}
 	}
-
 	push @h, 'Content-Type', $type, 'Content-Length', $len;
+
 	sub {
 		my ($res) = @_; # Plack callback
-		my $fh = $res->([ $code, \@h ]);
-		my $buf;
-		my $n = 8192;
-		while ($len > 0) {
-			$n = $len if $len < $n;
-			my $r = sysread($in, $buf, $n);
-			last if (!defined($r) || $r <= 0);
-			$len -= $r;
-			$fh->write($buf);
+		$fh = $res->([ $code, \@h ]);
+		if (defined $env->{'pi-httpd.async'}) {
+			$next = sub { $fh->write($cb) };
+			$cb->(); # start it off!
+		} else {
+			$cb->() while $fh;
 		}
-		die "$f truncated with $len bytes remaining\n" if $len;
-		$fh->close;
 	}
 }
 
@@ -149,7 +197,6 @@ sub serve_smart {
 	my $input = $env->{'psgi.input'};
 	my $buf;
 	my $in;
-	my $err = $env->{'psgi.errors'};
 	my $fd = eval { fileno($input) };
 	if (defined $fd && $fd >= 0) {
 		$in = $input;
@@ -158,7 +205,7 @@ sub serve_smart {
 	}
 	my ($rpipe, $wpipe);
 	unless (pipe($rpipe, $wpipe)) {
-		$err->print("error creating pipe: $! - going static\n");
+		err($env, "error creating pipe: $! - going static");
 		return;
 	}
 	my %env = %ENV;
@@ -179,7 +226,7 @@ sub serve_smart {
 	my %rdr = ( 0 => fileno($in), 1 => fileno($wpipe) );
 	my $pid = spawn([qw(git http-backend)], \%env, \%rdr);
 	unless (defined $pid) {
-		$err->print("error spawning: $! - going static\n");
+		err($env, "error spawning: $! - going static");
 		return;
 	}
 	$wpipe = $in = undef;
@@ -202,10 +249,8 @@ sub serve_smart {
 			my $e = $pid == waitpid($pid, 0) ?
 				$? : "PID:$pid still running?";
 			if ($e) {
-				$err->print("http-backend ($git_dir): $e\n");
-				if (my $io = $env->{'psgix.io'}) {
-					$io->close;
-				}
+				err($env, "git http-backend ($git_dir): $e");
+				drop_client($env);
 			}
 		}
 		return unless $res;
@@ -220,7 +265,7 @@ sub serve_smart {
 		}
 		my $e = $!;
 		$end->();
-		$err->print("git http-backend ($git_dir): $e\n");
+		err($env, "git http-backend ($git_dir): $e\n");
 	};
 	my $cb = sub { # read git-http-backend output and stream to client
 		my $r = $rpipe ? $rpipe->sysread($buf, 8192, length($buf)) : 0;
@@ -274,8 +319,7 @@ sub input_to_file {
 	while (1) {
 		my $r = $input->read($buf, 8192);
 		unless (defined $r) {
-			my $err = $env->{'psgi.errors'};
-			$err->print("error reading input: $!\n");
+			err($env, "error reading input: $!");
 			return;
 		}
 		last if ($r == 0);
diff --git a/t/githttpbackend.psgi b/t/githttpbackend.psgi
new file mode 100644
index 0000000..31599c6
--- /dev/null
+++ b/t/githttpbackend.psgi
@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use strict;
+use warnings;
+use PublicInbox::GitHTTPBackend;
+use PublicInbox::Git;
+use Plack::Builder;
+use Plack::Request;
+my $git_dir = $ENV{GIANT_GIT_DIR} or die 'GIANT_GIT_DIR not defined in env';
+my $git = PublicInbox::Git->new($git_dir);
+builder {
+	enable 'Chunked' if $ENV{TEST_CHUNK};
+	enable 'Head';
+	sub {
+		my ($env) = @_;
+		my $pr = Plack::Request->new($env);
+		if ($pr->path_info =~ m!\A/(.+)\z!s) {
+			PublicInbox::GitHTTPBackend::serve($pr, $git, $1);
+		} else {
+			[ 404, [ qw(Content-Type text/plain
+					Content-Length 0) ], [] ]
+		}
+	}
+}
-- 
EW