view release on metacpan or  search on metacpan

lib/Net/Async/FastCGI/Request.pm  view on Meta::CPAN

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2005-2024 -- leonerd@leonerd.org.uk

package Net::Async::FastCGI::Request 0.26;

use v5.14;
use warnings;

use Carp;

use Net::FastCGI::Constant qw( :type :flag :protocol_status );
use Net::FastCGI::Protocol qw( 
   parse_params
   build_end_request_body
);

# The largest amount of data we can fit in a FastCGI record - MUST NOT
# be greater than 2^16-1
use constant MAXRECORDDATA => 65535;

use Encode qw( find_encoding );
use POSIX qw( EAGAIN );

my $CRLF = "\x0d\x0a";

=head1 NAME

C<Net::Async::FastCGI::Request> - a single active FastCGI request

=head1 SYNOPSIS

   use Net::Async::FastCGI;
   use IO::Async::Loop;

   my $fcgi = Net::Async::FastCGI->new(
      on_request => sub {
         my ( $fcgi, $req ) = @_;

         my $path = $req->param( "PATH_INFO" );
         $req->print_stdout( "Status: 200 OK\r\n" .
                             "Content-type: text/plain\r\n" .
                             "\r\n" .
                             "You requested $path" );
         $req->finish();
      }
   );

   my $loop = IO::Async::Loop->new();

   $loop->add( $fcgi );

   $loop->run;

=head1 DESCRIPTION

Instances of this object class represent individual requests received from the
webserver that are currently in-progress, and have not yet been completed.
When given to the controlling program, each request will already have its
parameters (and, on servers without stdin streaming enabled, its STDIN data).
The program can then write response data to the STDOUT stream, messages to the
STDERR stream, and eventually finish it.

This module would not be used directly by a program using
C<Net::Async::FastCGI>, but rather, objects in this class are passed into the
C<on_request> event of the containing C<Net::Async::FastCGI> object.

=cut

sub new
{
   my $class = shift;
   my %args = @_;

   my $rec = $args{rec};

   my $self = bless {
      conn       => $args{conn},
      fcgi       => $args{fcgi},

      reqid      => $rec->{reqid},
      keepconn   => $rec->{flags} & FCGI_KEEP_CONN,

      stdin        => "",
      stdindone    => 0,
      stream_stdin => $args{stream_stdin},

      params     => {},
      paramsdone => 0,

      stdout     => "",
      stderr     => "",

      used_stderr => 0,
   }, $class;

   $self->set_encoding( $args{fcgi}->_default_encoding );

   return $self;
}

sub write_record
{
   my $self = shift;
   my ( $rec ) = @_;

   return if $self->is_aborted;

   my $content = $rec->{content};
   my $contentlen = length( $content );
   if( $contentlen > MAXRECORDDATA ) {
      warn __PACKAGE__."->write_record() called with content longer than ".MAXRECORDDATA." bytes - truncating";
      $content = substr( $content, 0, MAXRECORDDATA );
   }

   $rec->{reqid} = $self->{reqid} unless defined $rec->{reqid};

   my $conn = $self->{conn};

   $conn->write_record( $rec, $content );

lib/Net/Async/FastCGI/Request.pm  view on Meta::CPAN

=head2 protocol

   $protocol = $req->protocol;

Returns the value of the C<SERVER_PROTOCOL> parameter.

=cut

sub protocol
{
   my $self = shift;
   return $self->param( "SERVER_PROTOCOL" );
}

=head2 set_encoding

   $req->set_encoding( $encoding );

Sets the character encoding used by the request's STDIN, STDOUT and STDERR
streams. This method may be called at any time to change the encoding in
effect, which will be used the next time C<read_stdin_line>, C<read_stdin>,
C<print_stdout> or C<print_stderr> are called. This encoding will remain in
effect until changed again. The encoding of a new request is determined by the
C<default_encoding> parameter of the containing C<Net::Async::FastCGI> object.
If the value C<undef> is passed, the encoding will be removed, and the above
methods will work directly on bytes instead of encoded strings.

=cut

sub set_encoding
{
   my $self = shift;
   my ( $encoding ) = @_;

   if( defined $encoding ) {
      my $codec = find_encoding( $encoding );
      defined $codec or croak "Unrecognised encoding '$encoding'";
      $self->{codec} = $codec;
   }
   else {
      undef $self->{codec};
   }
}

=head2 read_stdin_line

   $line = $req->read_stdin_line;

This method works similarly to the C<< <HANDLE> >> operator. If at least one
line of data is available then it is returned, including the linefeed, and
removed from the buffer. If not, then any remaining partial line is returned
and removed from the buffer. If no data is available any more, then C<undef>
is returned instead.

=cut

sub read_stdin_line
{
   my $self = shift;
   croak "Cannot call ->read_stdin_line on streaming-stdin requests" if $self->{stream_stdin};

   my $codec = $self->{codec};

   if( $self->{stdin} =~ s/^(.*[\r\n])// ) {
      return $codec ? $codec->decode( $1 ) : $1;
   }
   elsif( $self->{stdin} =~ s/^(.+)// ) {
      return $codec ? $codec->decode( $1 ) : $1;
   }
   else {
      return undef;
   }
}

=head2 read_stdin

   $data = $req->read_stdin( $size );

This method works similarly to the C<read(HANDLE)> function. It returns the
next block of up to $size bytes from the STDIN buffer. If no data is available
any more, then C<undef> is returned instead. If $size is not defined, then it
will return all the available data.

=cut

sub read_stdin
{
   my $self = shift;
   croak "Cannot call ->read_stdin on streaming-stdin requests" if $self->{stream_stdin};
   my ( $size ) = @_;

   return undef unless length $self->{stdin};

   $size = length $self->{stdin} unless defined $size;

   my $codec = $self->{codec};

   # If $size is too big, substr() will cope
   my $bytes = substr( $self->{stdin}, 0, $size, "" );
   return $codec ? $codec->decode( $bytes ) : $bytes;
}

=head2 set_on_stdin_read

   $req->set_on_stdin_read( $on_stdin_read );

      $again = $on_stdin_read->( $req, $buffref, $eof );

I<Since version 0.26.>

Only valid on requests on servers with stdin streaming enabled.

This method should be called as part of the C<on_request> event on the server,
to set the callback function to invoke when new data is provided to the stdin
stream for this request.

The callback function is invoked in a similar style to the C<on_read> event
handler of an L<IO::Async::Stream>. It is passed the request itself, along
with a SCALAR reference to the buffer containing the stdin data, and a boolean
indicating if the end of stdin data has been reached.

It should inspect this buffer and remove some prefix of it that it wishes to
consume. Any remaining content will be present on the next call. If it returns
a true value, the callback will be invoked again immediately, to consume more
data. This continues until there is no more data left, or it returns false.

=cut

sub set_on_stdin_read
{
   my $self = shift;
   croak "Cannot call ->set_on_stdin_read except on streaming-stdin requests" unless $self->{stream_stdin};
   ( $self->{on_stdin_read} ) = @_;
}

sub _print_stream
{
   my $self = shift;
   my ( $data, $stream ) = @_;

   while( length $data ) {
      # Send chunks of up to MAXRECORDDATA bytes at once
      my $chunk = substr( $data, 0, MAXRECORDDATA, "" );
      $self->write_record( { type => $stream, content => $chunk } );
   }
}

sub _flush_streams
{
   my $self = shift;

   if( length $self->{stdout} ) {
      $self->_print_stream( $self->{stdout}, FCGI_STDOUT );
      $self->{stdout} = "";
   }
   elsif( my $cb = $self->{stdout_cb} ) {
      $cb->();
   }

   if( length $self->{stderr} ) {
      $self->_print_stream( $self->{stderr}, FCGI_STDERR );
      $self->{stderr} = "";
   }
}

sub _needs_flush
{
   my $self = shift;
   return defined $self->{stdout_cb};
}

=head2 print_stdout

   $req->print_stdout( $data );

This method appends the given data to the STDOUT stream of the FastCGI
request, sending it to the webserver to be sent to the client.

=cut

sub print_stdout
{
   my $self = shift;
   my ( $data ) = @_;

   my $codec = $self->{codec};

   $self->{stdout} .= $codec ? $codec->encode( $data ) : $data;

   $self->{conn}->_req_needs_flush( $self );
}

=head2 print_stderr

   $req->print_stderr( $data );

This method appends the given data to the STDERR stream of the FastCGI
request, sending it to the webserver.

=cut

sub print_stderr
{
   my $self = shift;
   my ( $data ) = @_;

   my $codec = $self->{codec};

   $self->{used_stderr} = 1;
   $self->{stderr} .= $codec ? $codec->encode( $data ) : $data;

   $self->{conn}->_req_needs_flush( $self );
}

=head2 stream_stdout_then_finish

   $req->stream_stdout_then_finish( $readfn, $exitcode );

This method installs a callback for streaming data to the STDOUT stream.
Whenever the output stream is otherwise-idle, the function will be called to
generate some more data to output. When this function returns C<undef> it
indicates the end of the stream, and the request will be finished with the
given exit code.

If this method is used, then care should be taken to ensure that the number of
bytes written to the server matches the number that was claimed in the
C<Content-Length>, if such was provided. This logic should be performed by the
containing application; C<Net::Async::FastCGI> will not track it.

=cut

sub stream_stdout_then_finish
{
   my $self = shift;
   my ( $readfn, $exitcode ) = @_;

   $self->{stdout_cb} = sub {
      my $data = $readfn->();

      if( defined $data ) {
         $self->print_stdout( $data );
      }
      else {
         delete $self->{stdout_cb};
         $self->finish( $exitcode );
      }
   };

   $self->{conn}->_req_needs_flush( $self );
}

=head2 stdin

   $stdin = $req->stdin;

Returns an IO handle representing the request's STDIN buffer. This may be read
from using the C<read> or C<readline> functions or the C<< <$stdin> >>
operator.

Note that this will be a tied IO handle, it will not be useable directly as an
OS-level filehandle.

=cut

sub stdin
{
   my $self = shift;

   return Net::Async::FastCGI::Request::TiedHandle->new(
      READ => sub { 
         $_[1] = $self->read_stdin( $_[2] );
         return defined $_[1] ? length $_[1] : 0;
      },
      READLINE => sub {
         return $self->read_stdin_line;
      },
   );
}