Any-Daemon-HTTP

 view release on metacpan or  search on metacpan

lib/Any/Daemon/FCGI/ClientConn.pm  view on Meta::CPAN

    my $type_id = $frame_name2id{$type} or panic $type;
    my $empty   = ! length $body;  # write one empty frame

    while(length $body || $empty)
    {   my $chunk  = substr $body, 0, MAX_FRAME_SEND, '';
        my $size   = length $chunk;
        my $pad    = (-$size) % 8;    # advise to pad on 8 bytes
        my $frame  = pack "CCnnCxa${size}x${pad}"
          , FCGI_VERSION, $type_id, $req_id, $size, $pad, $chunk;

        while(length $frame)
        {   my $wrote = syswrite $self->socket, $frame;
            if(defined $wrote)
            {   substr $frame, 0, $wrote, '';
                next;
            }

            return unless $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
            usleep 1000;  # 1 ms
        }

        last if $empty;
    }
}


sub get_request()
{   my $self = shift;
    my $requests = $self->{ADFC_requests};
    my $reqdata;

    ### At the moment, we will only support processing of whole requests
    #   and full replies: no chunking inside the server.

    while(1)
    {   my ($type, $req_id, $body) = $self->_next_record
            or return;

        if($req_id==0)
        {   $self->_management_record($body);
            next;
        }

        if($type eq 'BEGIN_REQUEST')
        {   my ($role_id, $flags) = unpack 'nC', $$body;
            my $role = $server_role_id2name{$role_id}
                or $self->_fcgi_end_request(UNKNOWN_ROLE => $req_id);

            $requests->{$req_id} =
              { request_id      => $req_id
              , data_complete   => $role ne 'FILTER'
              , stdin_complete  => $role eq 'AUTHORIZER'
              , params_complete => 0
              , role            => $role
              , params          => undef,
              , stdin           => undef,
              , data            => undef,
              };

            unless($flags & FCGI_KEEP_CONN)
            {   # Actually, this flag is incorrectly: more threads may still be
                # active.  So, let's close when they all have ceased to exist.
                info __x"fcgi {id} is last request", id => $req_id;
                $self->{ADFC_keep_conn} = 0;
            }

            next;
        }

        defined $req_id or panic;
        $reqdata = $requests->{$req_id};
        unless($reqdata)
        {   notice __x"fcgi received {type} for {id} which does not exist now"
              , type => $type, id => $req_id;
            next;
        }

        if($type eq 'ABORT_REQUEST')
        {   delete $requests->{$req_id};
        }
        elsif($type eq 'PARAMS')
        {   if(length $$body) { $reqdata->{params} .= $$body }
            else { $reqdata->{params_complete} = 1 }
        }
        elsif($type eq 'STDIN')  # Not for Authorizer
        {   if(length $$body) { $reqdata->{stdin}  .= $$body }
            else { $reqdata->{stdin_complete} = 1 }
        }
        elsif($type eq 'DATA')   # Filter only
        {   if(length $$body) { $reqdata->{data}   .= $$body }
            else { $reqdata->{data_complete} = 1 }
        }

        last if $reqdata->{params_complete}
             && $reqdata->{stdin_complete}
             && $reqdata->{data_complete};
    }

    # We still have this record in $reqdata
    my $req_id = $reqdata->{request_id};
    delete $requests->{$req_id};

    my $enc_params = delete $reqdata->{params};
    my $p = $reqdata->{params} = eval { $self->_body2hash(\$enc_params) };
    if($@)
    {    notice __x"fcgi {id} params error: {err}", id => $req_id, err => $@;
         delete $requests->{$req_id};
         return $self->get_request;
    }

    my $expected_stdin = $p->{CONTENT_LENGTH} || 0;
    $expected_stdin == length $reqdata->{stdin}
        or error __x"fcgi {id} received {got} bytes on stdin, expected {need}"
             , id   => $req_id
             , got  => length $reqdata->{stdin}
             , need => $expected_stdin;

    my $expected_data = $p->{FCGI_DATA_LENGTH} || 0;
    $expected_data == length $reqdata->{data}
        or error __x"fcgi {id} received {got} bytes for data, expected {need}"
            , id   => $req_id



( run in 2.935 seconds using v1.01-cache-2.11-cpan-5623c5533a1 )