view release on metacpan or  search on metacpan

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

# Copyrights 2013-2020 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Any-Daemon-HTTP. Meta-POD processed
# with OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Any::Daemon::FCGI::ClientConn;
use vars '$VERSION';
$VERSION = '0.30';


use warnings;
use strict;

use Log::Report      'any-daemon-http';

use HTTP::Request ();
use Time::HiRes   qw(usleep);
use Errno         qw(EAGAIN EINTR EWOULDBLOCK);
use IO::Select    ();
use Socket        qw/inet_aton PF_INET AF_INET SHUT_RD SHUT_WR/;

use Any::Daemon::FCGI::Request ();

use constant
  { FCGI_VERSION    => 1
  , FCGI_KEEP_CONN  => 1    # flag bit
  , MAX_FRAME_SEND  => 32 * 1024   # may have 65535 bytes content
  , MAX_READ_CHUNKS => 16 * 1024
  , CRLF            => "\x0D\x0A"
  , RESERVED        => 0
  };

# Implementation heavily based on Net::Async::FastCGI::Request and
# Mojo::Server::FastCGI

my %server_role_name2id =
  ( RESPONDER          => 1
  , AUTHORIZER         => 2
  , FILTER             => 3
  );

my %frame_name2id =
  ( BEGIN_REQUEST      => 1
  , ABORT_REQUEST      => 2
  , END_REQUEST        => 3
  , PARAMS             => 4
  , STDIN              => 5
  , STDOUT             => 6
  , STDERR             => 7
  , DATA               => 8
  , GET_VALUES         => 9
  , GET_VALUES_RESULT  => 10
  , UNKNOWN_TYPE       => 11
  );

my %end_status2id =
  ( REQUEST_COMPLETE   => 0
  , CANT_MPX_CONN      => 1
  , OVERLOADED         => 2
  , UNKNOWN_ROLE       => 3
  );

my %server_role_id2name = reverse %server_role_name2id;
my %frame_id2name       = reverse %frame_name2id;


sub new($%) { (bless {}, $_[0])->init($_[1]) }

sub init($)
{   my ($self, $args) = @_;
    $self->{ADFC_requests}  = {};
    $self->{ADFC_max_conns} = $args->{max_childs} or panic;
    $self->{ADFC_max_reqs}  = $args->{max_childs};

    $self->{ADFC_select}    = my $select = IO::Select->new;
    $self->{ADFC_socket}    = my $socket = $args->{socket} or panic;

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

    $self;
}

sub keep_connection()
{   my $self = shift;
    $self->{ADFC_keep_conn} || keys %{$self->{ADFC_requests}}
}

#### MANAGEMENT RECORDS
# have req_id==0

sub _management_record($$)
{   my ($self, $type, $body) = @_;
      $type eq 'GET_VALUES' ? $self->_fcgi_get_values($body)
    :                         $self->_fcgi_unknown($body);
}

# Request record FCGI_GET_VALUES may be used by the front-end server to
# collect back_end settings.  In Apache, you have to configure it manually.

sub _fcgi_get_values($)
{   my $self = shift;
    my %need = $self->_body2hash(shift);

    # The maximum number of concurrent transport connections this
    # application will accept.
    $need{FCGI_MAX_CONNS} = $self->{ADFC_max_conns}
        if exists $need{FCGI_MAX_CONNS};

    # The maximum number of concurrent requests this application will accept.
    $need{FCGI_MAX_REQS} = $self->{ADFC_max_reqs}
        if exists $need{FCGI_MAX_REQS};

    # "0" if this application does not multiplex connections (i.e. handle
    # concurrent requests over each connection), "1" otherwise.
    $need{FCGI_MPXS_CONNS} = 0
        if exists $need{FCGI_MPXS_CONNS};

    $self->_reply_record(GET_VALUES_RESULT => 0, $self->hash2body(\%need));
}

# Reply record FCGI_UNKNOWN_TYPE is designed for protocol upgrades: to 
# respond to unknown record types.

sub _fcgi_unknown($)
{   my ($self, $body) = @_;
    $self->_reply_record(UNKNOWN_TYPE => 0, '');
}

# Reply END_REQUEST is used for all ways to close a BEGIN_REQUEST session.
# It depends on the $status code which additionals fields were sent.

sub _fcgi_end_request($$;$)
{   my ($self, $status, $req_id, $rc) = @_;
    my $body = pack "nCCCC", $rc || 0, $end_status2id{$status}
      , RESERVED, RESERVED, RESERVED;

    $self->_reply_record(END_REQUEST => $req_id, $body);
}

# Convert the FGCI request into a full HTTP::Request object
sub _body2hash($$)
{   my ($self, $body) = @_;
    my %h;

    while(length $$body)
    {   my $name_len  = $self->_take_encoded_nv($body);
        my $value_len = $self->_take_encoded_nv($body);
 
        my $name  = substr $$body, 0, $name_len,  '';
        $h{$name} = substr $$body, 0, $value_len, '';
    }

    \%h;
}

sub _hash2body($)
{   my ($self, $h) = @_;
    my @params;
    foreach my $name (sort keys %$h)
    {    my $name_len = length $name;
         my $val_len  = length $h->{$name};
         push @params, pack "NNxa{$name_len}xa{$val_len}"
           , $name_len, $val_len, $name, $h->{$name};
    }
    join '', @params;
}

# Numerical values are 1 or 4 bytes.  Long when first bit == 1
sub _take_encoded_nv($)
{   my ($self, $body) = @_;
    my $short = unpack 'C', substr $$body, 0, 1, '';
    $short & 0x80 or return $short;

    my $long  = pack('C', $short & 0x7F) . substr($$body, 0, 3, '');
    unpack 'N', $long;
}

sub _read_chunk($)
{   my ($self, $need) = @_;
    my $stdin = $self->{ADFC_stdin};

    return substr $$stdin, 0, $need, ''
       if length $$stdin > $need;

    my $select = $self->{ADFC_select};

    while(length $$stdin < $need)
    {   $select->can_read or next;

        my $bytes_read = sysread $self->socket, my $more, MAX_READ_CHUNKS, 0;
        if(defined $bytes_read)
        {   $bytes_read or last;
            $$stdin .= $more;
            next;
        }

        last unless $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;

        usleep 1000;   # 1 ms
    }