]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/HTTP.pm
treewide: run update-copyrights from gnulib for 2019
[public-inbox.git] / lib / PublicInbox / HTTP.pm
index 53d508368fc68b6bf5e255a59c94f37c5e677a8b..df328904a86b57e318879afa67da71ecea35ee8f 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright (C) 2016-2019 all contributors <meta@public-inbox.org>
+# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 #
 # Generic PSGI server for convenience.  It aims to provide
@@ -11,13 +11,14 @@ package PublicInbox::HTTP;
 use strict;
 use warnings;
 use base qw(PublicInbox::DS);
-use fields qw(httpd env input_left remote_addr remote_port forward);
+use fields qw(httpd env input_left remote_addr remote_port forward alive);
 use bytes (); # only for bytes::length
 use Fcntl qw(:seek);
 use Plack::HTTPParser qw(parse_http_request); # XS or pure Perl
+use Plack::Util;
 use HTTP::Status qw(status_message);
 use HTTP::Date qw(time2str);
-use IO::Handle;
+use IO::Handle; # ->write
 use PublicInbox::DS qw(msg_more);
 use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
 use PublicInbox::Tmpfile;
@@ -79,7 +80,7 @@ sub event_step { # called by PublicInbox::DS
        # only read more requests if we've drained the write buffer,
        # otherwise we can be buffering infinitely w/o backpressure
 
-       return read_input($self) if defined $self->{env};
+       return read_input($self) if ref($self->{env});
        my $rbuf = $self->{rbuf} // (\(my $x = ''));
        $self->do_read($rbuf, 8192, bytes::length($$rbuf)) or return;
        rbuf_process($self, $rbuf);
@@ -123,7 +124,6 @@ sub read_input ($;$) {
        my ($self, $rbuf) = @_;
        $rbuf //= $self->{rbuf} // (\(my $x = ''));
        my $env = $self->{env};
-       return if $env->{REMOTE_ADDR}; # in app dispatch
        return read_input_chunked($self, $rbuf) if env_chunked($env);
 
        # env->{CONTENT_LENGTH} (identity)
@@ -152,9 +152,10 @@ sub app_dispatch {
        my ($self, $input, $rbuf) = @_;
        $self->rbuf_idle($rbuf);
        my $env = $self->{env};
+       $self->{env} = undef; # for exists() check in ->busy
        $env->{REMOTE_ADDR} = $self->{remote_addr};
        $env->{REMOTE_PORT} = $self->{remote_port};
-       if (my $host = $env->{HTTP_HOST}) {
+       if (defined(my $host = $env->{HTTP_HOST})) {
                $host =~ s/:([0-9]+)\z// and $env->{SERVER_PORT} = $1;
                $env->{SERVER_NAME} = $host;
        }
@@ -164,7 +165,7 @@ sub app_dispatch {
        }
        # note: NOT $self->{sock}, we want our close (+ PublicInbox::DS::close),
        # to do proper cleanup:
-       $env->{'psgix.io'} = $self; # only for ->close
+       $env->{'psgix.io'} = $self; # for ->close or async_pass
        my $res = Plack::Util::run_app($self->{httpd}->{app}, $env);
        eval {
                if (ref($res) eq 'CODE') {
@@ -173,7 +174,10 @@ sub app_dispatch {
                        response_write($self, $env, $res);
                }
        };
-       $self->close if $@;
+       if ($@) {
+               err($self, "response_write error: $@");
+               $self->close;
+       }
 }
 
 sub response_header_write {
@@ -222,22 +226,20 @@ sub response_header_write {
 }
 
 # middlewares such as Deflater may write empty strings
-sub chunked_wcb ($) {
-       my ($self) = @_;
-       sub {
-               return if $_[0] eq '';
-               msg_more($self, sprintf("%x\r\n", bytes::length($_[0])));
-               msg_more($self, $_[0]);
-
-               # use $self->write(\"\n\n") if you care about real-time
-               # streaming responses, public-inbox WWW does not.
-               msg_more($self, "\r\n");
-       }
+sub chunked_write ($$) {
+       my $self = $_[0];
+       return if $_[1] eq '';
+       msg_more($self, sprintf("%x\r\n", bytes::length($_[1])));
+       msg_more($self, $_[1]);
+
+       # use $self->write(\"\n\n") if you care about real-time
+       # streaming responses, public-inbox WWW does not.
+       msg_more($self, "\r\n");
 }
 
-sub identity_wcb ($) {
-       my ($self) = @_;
-       sub { $self->write(\($_[0])) if $_[0] ne '' }
+sub identity_write ($$) {
+       my $self = $_[0];
+       $self->write(\($_[1])) if $_[1] ne '';
 }
 
 sub next_request ($) {
@@ -251,76 +253,77 @@ sub next_request ($) {
        }
 }
 
-sub response_done_cb ($$) {
+sub response_done {
        my ($self, $alive) = @_;
-       sub {
-               delete $self->{env}; # we're no longer busy
-               $self->write(\"0\r\n\r\n") if $alive == 2;
-               $self->write($alive ? \&next_request : \&close);
-       }
+       delete $self->{env}; # we're no longer busy
+       $self->write(\"0\r\n\r\n") if $alive == 2;
+       $self->write($alive ? \&next_request : \&close);
 }
 
-sub getline_response ($$$) {
-       my ($self, $write, $close) = @_;
-       my $pull; # DANGER: self-referential
-       $pull = sub {
-               my $forward = $self->{forward};
-               # limit our own running time for fairness with other
-               # clients and to avoid buffering too much:
-               my $buf = eval {
-                       local $/ = \8192;
-                       $forward->getline;
-               } if $forward;
-
-               if (defined $buf) {
-                       $write->($buf); # may close in PublicInbox::DS::write
-
-                       if ($self->{sock}) {
-                               my $wbuf = $self->{wbuf} ||= [];
-                               push @$wbuf, $pull;
-
-                               # wbuf may be populated by $write->($buf),
-                               # no need to rearm if so:
-                               $self->requeue if scalar(@$wbuf) == 1;
-                               return; # likely
-                       }
-               } elsif ($@) {
-                       err($self, "response ->getline error: $@");
-                       $self->close;
+sub getline_pull {
+       my ($self) = @_;
+       my $forward = $self->{forward};
+
+       # limit our own running time for fairness with other
+       # clients and to avoid buffering too much:
+       my $buf = eval {
+               local $/ = \8192;
+               $forward->getline;
+       } if $forward;
+
+       if (defined $buf) {
+               # may close in PublicInbox::DS::write
+               if ($self->{alive} == 2) {
+                       chunked_write($self, $buf);
+               } else {
+                       identity_write($self, $buf);
                }
 
-               $pull = undef; # all done!
-               # avoid recursion
-               if (delete $self->{forward}) {
-                       eval { $forward->close };
-                       if ($@) {
-                               err($self, "response ->close error: $@");
-                               $self->close; # idempotent
-                       }
-               }
-               $forward = undef;
-               $close->(); # call response_done_cb
-       };
+               if ($self->{sock}) {
+                       # autovivify wbuf
+                       my $new_size = push(@{$self->{wbuf}}, \&getline_pull);
 
-       $pull->(); # kick-off!
+                       # wbuf may be populated by {chunked,identity}_write()
+                       # above, no need to rearm if so:
+                       $self->requeue if $new_size == 1;
+                       return; # likely
+               }
+       } elsif ($@) {
+               err($self, "response ->getline error: $@");
+               $self->close;
+       }
+       # avoid recursion
+       if (delete $self->{forward}) {
+               eval { $forward->close };
+               if ($@) {
+                       err($self, "response ->close error: $@");
+                       $self->close; # idempotent
+               }
+       }
+       response_done($self, delete $self->{alive});
 }
 
 sub response_write {
        my ($self, $env, $res) = @_;
        my $alive = response_header_write($self, $env, $res);
-       my $close = response_done_cb($self, $alive);
-       my $write = $alive == 2 ? chunked_wcb($self) : identity_wcb($self);
        if (defined(my $body = $res->[2])) {
                if (ref $body eq 'ARRAY') {
-                       $write->($_) foreach @$body;
-                       $close->();
+                       if ($alive == 2) {
+                               chunked_write($self, $_) for @$body;
+                       } else {
+                               identity_write($self, $_) for @$body;
+                       }
+                       response_done($self, $alive);
                } else {
                        $self->{forward} = $body;
-                       getline_response($self, $write, $close);
+                       $self->{alive} = $alive;
+                       getline_pull($self); # kick-off!
                }
+       # these are returned to the calling application:
+       } elsif ($alive == 2) {
+               bless [ $self, $alive ], 'PublicInbox::HTTP::Chunked';
        } else {
-               # this is returned to the calling application:
-               Plack::Util::inline_object(write => $write, close => $close);
+               bless [ $self, $alive ], 'PublicInbox::HTTP::Identity';
        }
 }
 
@@ -452,7 +455,6 @@ sub quit {
 
 sub close {
        my $self = $_[0];
-       delete $self->{env}; # prevent circular references
        if (my $forward = delete $self->{forward}) {
                eval { $forward->close };
                err($self, "forward ->close error: $@") if $@;
@@ -463,7 +465,32 @@ sub close {
 # for graceful shutdown in PublicInbox::Daemon:
 sub busy () {
        my ($self) = @_;
-       ($self->{rbuf} || $self->{env} || $self->{wbuf});
+       ($self->{rbuf} || exists($self->{env}) || $self->{wbuf});
+}
+
+# Chunked and Identity packages are used for writing responses.
+# They may be exposed to the PSGI application when the PSGI app
+# returns a CODE ref for "push"-based responses
+package PublicInbox::HTTP::Chunked;
+use strict;
+
+sub write {
+       # ([$http], $buf) = @_;
+       PublicInbox::HTTP::chunked_write($_[0]->[0], $_[1])
+}
+
+sub close {
+       # $_[0] = [$http, $alive]
+       PublicInbox::HTTP::response_done(@{$_[0]});
+}
+
+package PublicInbox::HTTP::Identity;
+use strict;
+our @ISA = qw(PublicInbox::HTTP::Chunked);
+
+sub write {
+       # ([$http], $buf) = @_;
+       PublicInbox::HTTP::identity_write($_[0]->[0], $_[1]);
 }
 
 1;