view release on metacpan or  search on metacpan

lib/Catalyst/Engine/HTTP/Prefork.pm  view on Meta::CPAN

    print "You can connect to your server at $url\n";
}

# The below methods run in the child process

sub post_accept_hook {
    my $self = shift;
    
    $self->{client} = {
        headerbuf => '',
        inputbuf  => '',
        keepalive => 1,
    };
}

sub process_request {
    my $self = shift;
    my $conn = $self->{server}->{client};

    while ( $self->{client}->{keepalive} ) {
        last if !$conn->connected;
        
        # Read until we see all headers
        last if !$self->_read_headers;
    
        # Parse headers
        my $h = HTTP::HeaderParser::XS->new( \delete $self->{client}->{headerbuf} );
    
        if ( !$h ) {
            # Bad request
            DEBUG && warn "[$$] Bad request\n";
            $self->_http_error(400);
            last;
        }
    
        # Initialize CGI environment
        my $uri = $h->request_uri();
        my ( $path, $query_string ) = split /\?/, $uri, 2;
    
        my $version = $h->version_number();
        my $proto   = sprintf( "HTTP/%d.%d", int( $version / 1000 ), $version % 1000 );
  
        local %ENV = (
            PATH_INFO       => $path         || '',
            QUERY_STRING    => $query_string || '',
            REMOTE_ADDR     => $self->{server}->{peeraddr},
            REMOTE_HOST     => $self->{server}->{peerhost} || $self->{server}->{peeraddr},
            REQUEST_METHOD  => $h->request_method() || '',
            SERVER_NAME     => $self->{server}->{sockaddr}, # XXX: needs to be resolved?
            SERVER_PORT     => $self->{server}->{port}->[0],
            SERVER_PROTOCOL => $proto,
            %{ $self->{env} },
        );
    
        # Add headers
        my $headers = $h->getHeaders();
        $self->{client}->{headers} = $headers;
        
        # prepare_connection and prepare_path need a few headers in %ENV
        $ENV{HTTP_X_FORWARDED_FOR}  = $headers->{'X-Forwarded-For'} 
            if $headers->{'X-Forwarded-For'};
        $ENV{HTTP_X_FORWARDED_HOST} = $headers->{'X-Forwarded-Host'} 
            if $headers->{'X-Forwarded-Host'};
    
        # Determine whether we will keep the connection open after the request
        my $connection = $headers->{Connection};
        if ( $proto && $proto eq 'HTTP/1.0' ) {
            if ( $connection && $connection =~ /^keep-alive$/i ) {
                # Keep-alive only with explicit header in HTTP/1.0
                $self->{client}->{keepalive} = 1;
            }
            else {
                $self->{client}->{keepalive} = 0;
            }
        }
        elsif ( $proto && $proto eq 'HTTP/1.1' ) {
            if ( $connection && $connection =~ /^close$/i ) {
                $self->{client}->{keepalive} = 0;
            }
            else {
                # Keep-alive assumed in HTTP/1.1
                $self->{client}->{keepalive} = 1;
            }
            
            # Do we need to send 100 Continue?
            if ( $headers->{Expect} ) {
                if ( $headers->{Expect} eq '100-continue' ) {
                    syswrite STDOUT, 'HTTP/1.1 100 Continue' . $CRLF . $CRLF;
                    DEBUG && warn "[$$] Sent 100 Continue response\n";
                }
                else {
                    DEBUG && warn "[$$] Invalid Expect header, returning 417\n";
                    $self->_http_error( 417, 'HTTP/1.1' );
                    last;
                }
            }
            
            # Check for an absolute request and determine the proper Host value
            if ( $ENV{PATH_INFO} =~ /^http/i ) {
                my ($host, $path) = $ENV{PATH_INFO} =~ m{^http://([^/]+)(/.+)}i;
                $ENV{HTTP_HOST} = $host;
                $ENV{PATH_INFO} = $path;
                DEBUG && warn "[$$] Absolute path request, host: $host, path: $path\n";
            }
            elsif ( $headers->{Host} ) {
                $ENV{HTTP_HOST} = $headers->{Host};
            }
            else {
                # No host, bad request
                DEBUG && warn "[$$] Bad request, HTTP/1.1 without Host header\n";
                $self->_http_error( 400, 'HTTP/1.1' );
                last;
            }
        }
    
        # Pass flow control to Catalyst
        $self->{appclass}->handle_request( $self->{client} );
    
        DEBUG && warn "[$$] Request done\n";
    
        if ( $self->{client}->{keepalive} ) {