view release on metacpan or  search on metacpan

lib/Starlight/Server.pm  view on Meta::CPAN

    local $SIG{PIPE} = 'IGNORE';

    while (!defined $max_reqs_per_child || $proc_req_count < $max_reqs_per_child) {
        my ($conn, $peer) = $self->{listen_sock}->accept or do {
            warn "failed to accept: $!\n";
            next;
        };

        my ($peerport, $peerhost, $peeraddr) = (0, undef, undef);
        if ($self->{_listen_sock_is_tcp}) {
            if (HAS_INET6 && Socket::sockaddr_family(getsockname($conn)) == AF_INET6) {
                ($peerport, $peerhost) = Socket::unpack_sockaddr_in6($peer);
                $peeraddr = Socket::inet_ntop(AF_INET6, $peerhost);
            } else {
                ($peerport, $peerhost) = Socket::unpack_sockaddr_in($peer);
                $peeraddr = Socket::inet_ntoa($peerhost);
            }
            if (try { TCP_NODELAY }) {
                $conn->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1)
                    or do {
                    warn "setsockopt(TCP_NODELAY) failed for $peeraddr:$peerport: $!\n";
                    next;
                    };
            }
        }

        if ($conn->isa('IO::Socket::SSL')) {
            $conn->accept_SSL or do {
                my @err = ();
                push @err, $!                          if $!;
                push @err, $IO::Socket::SSL::SSL_ERROR if $IO::Socket::SSL::SSL_ERROR;
                warn "failed to ssl handshake with $peeraddr:$peerport: @{[join ': ', @err]}\n";
                next;
            };
        }

        $self->{_is_deferred_accept} = $self->{_using_defer_accept};
        $conn->blocking(0)
            or do {
            warn "failed to set socket to nonblocking mode for $peeraddr:$peerport: $!\n";
            next;
            };

        my $req_count = 0;
        my $pipelined_buf = '';
        while (1) {
            ++$req_count;
            ++$proc_req_count;
            my $env = {
                SERVER_PORT            => $self->{port} || 0,
                SERVER_NAME            => $self->{host} || '*',
                SCRIPT_NAME            => '',
                REMOTE_ADDR            => $peeraddr,
                REMOTE_PORT            => $peerport,
                'psgi.version'         => [1, 1],
                'psgi.errors'          => *STDERR,
                'psgi.url_scheme'      => $self->{ssl} ? 'https' : 'http',
                'psgi.run_once'        => Plack::Util::FALSE,
                'psgi.multithread'     => $self->{is_multithread},
                'psgi.multiprocess'    => $self->{is_multiprocess},
                'psgi.streaming'       => Plack::Util::TRUE,
                'psgi.nonblocking'     => Plack::Util::FALSE,
                'psgix.input.buffered' => Plack::Util::TRUE,
                'psgix.io'             => $conn,
                'psgix.harakiri'       => Plack::Util::TRUE,
            };

            my $may_keepalive = $req_count < $self->{max_keepalive_reqs};
            if ($may_keepalive && $max_reqs_per_child && $proc_req_count >= $max_reqs_per_child) {
                $may_keepalive = undef;
            }
            $may_keepalive = 1 if length $pipelined_buf;
            my $keepalive;
            ($keepalive, $pipelined_buf) = $self->handle_connection(
                $env, $conn, $app,
                $may_keepalive, $req_count != 1, $pipelined_buf
            );

            if ($env->{'psgix.harakiri.commit'}) {
                $conn->close;
                return;
            }
            last unless $keepalive;

# TODO add special cases for clients with broken keep-alive support, as well as disabling keep-alive for HTTP/1.0 proxies
        }
        $conn->close;
    }
}

my $bad_response = [400, ['Content-Type' => 'text/plain', 'Connection' => 'close'], ['Bad Request']];

sub handle_connection {
    my ($self, $env, $conn, $app, $use_keepalive, $is_keepalive, $prebuf) = @_;

    my $buf = '';
    my $pipelined_buf = '';
    my $res = $bad_response;

    local $self->{can_exit} = (defined $prebuf) ? 0 : 1;
    while (1) {
        my $rlen;
        if ($rlen = length $prebuf) {
            $buf = $prebuf;
            undef $prebuf;
        } else {
            $rlen = $self->read_timeout(
                $conn, \$buf, MAX_REQUEST_SIZE - length($buf), length($buf),
                $is_keepalive ? $self->{keepalive_timeout} : $self->{timeout},
            ) or return;
        }
        $self->{can_exit} = 0;
        my $reqlen = parse_http_request($buf, $env);
        if ($reqlen >= 0) {

            # handle request
            my $protocol = $env->{SERVER_PROTOCOL};
            if ($use_keepalive) {
                if ($protocol eq 'HTTP/1.1') {
                    if (my $c = $env->{HTTP_CONNECTION}) {
                        $use_keepalive = undef