Catalyst-Runtime

 view release on metacpan or  search on metacpan

lib/Catalyst/Request.pm  view on Meta::CPAN

package Catalyst::Request;

use Socket qw( getaddrinfo getnameinfo AI_NUMERICHOST NI_NAMEREQD NIx_NOSERV );
use Carp;
use utf8;
use URI::http;
use URI::https;
use URI::QueryParam;
use HTTP::Headers;
use Stream::Buffered;
use Hash::MultiValue;
use Scalar::Util;
use HTTP::Body;
use Catalyst::Exception;
use Catalyst::Request::PartData;
use Moose;

use namespace::clean -except => 'meta';

with 'MooseX::Emulate::Class::Accessor::Fast';

has env => (is => 'ro', writer => '_set_env', predicate => '_has_env');
# XXX Deprecated crap here - warn?
has action => (is => 'rw');
# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
has user => (is => 'rw');
sub snippets        { shift->captures(@_) }

has _read_position => (
    # FIXME: work around Moose bug RT#75367
    # init_arg => undef,
    is => 'ro',
    writer => '_set_read_position',
    default => 0,
);
has _read_length => (
    # FIXME: work around Moose bug RT#75367
    # init_arg => undef,
    is => 'ro',
    default => sub {
        my $self = shift;
        $self->header('Content-Length') || 0;
    },
    lazy => 1,
);

has address => (is => 'rw');
has arguments => (is => 'rw', default => sub { [] });
has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);

sub prepare_cookies {
    my ( $self ) = @_;

    if ( my $header = $self->header('Cookie') ) {
        return { CGI::Simple::Cookie->parse($header) };
    }
    {};
}

has query_keywords => (is => 'rw');
has match => (is => 'rw');
has method => (is => 'rw');
has protocol => (is => 'rw');
has query_parameters  => (is => 'rw', lazy=>1, default => sub { shift->_use_hash_multivalue ? Hash::MultiValue->new : +{} });
has secure => (is => 'rw', default => 0);
has captures => (is => 'rw', default => sub { [] });
has uri => (is => 'rw', predicate => 'has_uri');
has remote_user => (is => 'rw');
has headers => (
  is      => 'rw',
  isa     => 'HTTP::Headers',
  handles => [qw(content_encoding content_length content_type header referer user_agent)],
  builder => 'prepare_headers',
  lazy => 1,
);

sub prepare_headers {
    my ($self) = @_;

    my $env = $self->env;
    my $headers = HTTP::Headers->new();

    for my $header (keys %{ $env }) {
        next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
        (my $field = $header) =~ s/^HTTPS?_//;
        $field =~ tr/_/-/;
        $headers->header($field => $env->{$header});
    }
    return $headers;
}

has _log => (
    is => 'ro',
    weak_ref => 1,
    required => 1,
);

has io_fh => (
    is=>'ro',
    predicate=>'_has_io_fh',
    lazy=>1,
    builder=>'_build_io_fh');

sub _build_io_fh {
    my $self = shift;
    return $self->env->{'psgix.io'}
      || (
        $self->env->{'net.async.http.server.req'} &&
        $self->env->{'net.async.http.server.req'}->stream)   ## Until I can make ioasync cabal see the value of supportin psgix.io (jnap)
      || die "Your Server does not support psgix.io";
};

has data_handlers => ( is=>'ro', isa=>'HashRef', default=>sub { +{} } );

has body_data => (
    is=>'ro',
    lazy=>1,
    builder=>'_build_body_data');

sub _build_body_data {

lib/Catalyst/Request.pm  view on Meta::CPAN

  default   => sub {
    my ($self) = @_;
    my ( $err, $sockaddr ) = getaddrinfo(
        $self->address,
        # no service
        '',
        { flags => AI_NUMERICHOST }
    );
    if ( $err ) {
        $self->_log->warn("resolve of hostname failed: $err");
        return $self->address;
    }
    ( $err, my $hostname ) = getnameinfo(
        $sockaddr->{addr},
        NI_NAMEREQD,
        # we are only interested in the hostname, not the servicename
        NIx_NOSERV
    );
    if ( $err ) {
        $self->_log->warn("resolve of hostname failed: $err");
        return $self->address;
    }
    return $hostname;
  },
);

has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );

sub args            { shift->arguments(@_) }
sub body_params     { shift->body_parameters(@_) }
sub input           { shift->body(@_) }
sub params          { shift->parameters(@_) }
sub query_params    { shift->query_parameters(@_) }
sub path_info       { shift->path(@_) }

=for stopwords param params

=head1 NAME

Catalyst::Request - provides information about the current client request

=head1 SYNOPSIS

    $req = $c->request;
    $req->address eq "127.0.0.1";
    $req->arguments;
    $req->args;
    $req->base;
    $req->body;
    $req->body_data;
    $req->body_parameters;
    $req->content_encoding;
    $req->content_length;
    $req->content_type;
    $req->cookie;
    $req->cookies;
    $req->header;
    $req->headers;
    $req->hostname;
    $req->input;
    $req->query_keywords;
    $req->match;
    $req->method;
    $req->param;
    $req->parameters;
    $req->params;
    $req->path;
    $req->protocol;
    $req->query_parameters;
    $req->read;
    $req->referer;
    $req->secure;
    $req->captures;
    $req->upload;
    $req->uploads;
    $req->uri;
    $req->user;
    $req->user_agent;
    $req->env;

See also L<Catalyst>, L<Catalyst::Request::Upload>.

=head1 DESCRIPTION

This is the Catalyst Request class, which provides an interface to data for the
current client request. The request object is prepared by L<Catalyst::Engine>,
thus hiding the details of the particular engine implementation.

=head1 METHODS

=head2 $req->address

Returns the IP address of the client.

=head2 $req->arguments

Returns a reference to an array containing the arguments.

    print $c->request->arguments->[0];

For example, if your action was

    package MyApp::Controller::Foo;

    sub moose : Local {
        ...
    }

and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
would be the first and only argument.

Arguments get automatically URI-unescaped for you.

=head2 $req->args

Shortcut for L</arguments>.

=head2 $req->base

Contains the URI base. This will always have a trailing slash. Note that the
URI scheme (e.g., http vs. https) must be determined through heuristics;

lib/Catalyst/Request.pm  view on Meta::CPAN

=head2 $req->content_type

Shortcut for $req->headers->content_type.

=head2 $req->cookie

A convenient method to access $req->cookies.

    $cookie  = $c->request->cookie('name');
    @cookies = $c->request->cookie;

=cut

sub cookie {
    my $self = shift;

    if ( @_ == 0 ) {
        return keys %{ $self->cookies };
    }

    if ( @_ == 1 ) {

        my $name = shift;

        unless ( exists $self->cookies->{$name} ) {
            return undef;
        }

        return $self->cookies->{$name};
    }
}

=head2 $req->cookies

Returns a reference to a hash containing the cookies.

    print $c->request->cookies->{mycookie}->value;

The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
objects.

=head2 $req->header

Shortcut for $req->headers->header.

=head2 $req->headers

Returns an L<HTTP::Headers> object containing the headers for the current request.

    print $c->request->headers->header('X-Catalyst');

=head2 $req->hostname

Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.

=head2 $req->input

Alias for $req->body.

=head2 $req->query_keywords

Contains the keywords portion of a query string, when no '=' signs are
present.

    http://localhost/path?some+keywords

    $c->request->query_keywords will contain 'some keywords'

=head2 $req->match

This contains the matching part of a Regex action. Otherwise
it returns the same as 'action', except for default actions,
which return an empty string.

=head2 $req->method

Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).

=head2 $req->param

Returns GET and POST parameters with a CGI.pm-compatible param method. This
is an alternative method for accessing parameters in $c->req->parameters.

    $value  = $c->request->param( 'foo' );
    @values = $c->request->param( 'foo' );
    @params = $c->request->param;

Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
arguments to this method, like this:

    $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );

will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
C<quxx>. Previously this would have added C<bar> as another value to C<foo>
(creating it if it didn't exist before), and C<quxx> as another value for
C<gorch>.

B<NOTE> this is considered a legacy interface and care should be taken when
using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
return a list of as many are present, which can have unexpected consequences
when writing code of the form:

    $foo->bar(
        a => 'b',
        baz => $c->req->param( 'baz' ),
    );

If multiple C<baz> parameters are provided this code might corrupt data or
cause a hash initialization error. For a more straightforward interface see
C<< $c->req->parameters >>.

B<NOTE> Interfaces like this, which are based on L<CGI> and the C<param> method
are known to cause demonstrated exploits. It is highly recommended that you
avoid using this method, and migrate existing code away from it.  Here's a
whitepaper of the exploit:

L<http://blog.gerv.net/2014/10/new-class-of-vulnerability-in-perl-web-applications/>

B<NOTE> Further discussion on IRC indicate that the L<Catalyst> core team from 'back then'
were well aware of this hack and this is the main reason we added the new approach to
getting parameters in the first place.

Basically this is an exploit that takes advantage of how L<\param> will do one thing
in scalar context and another thing in list context.  This is combined with how Perl
chooses to deal with duplicate keys in a hash definition by overwriting the value of
existing keys with a new value if the same key shows up again.  Generally you will be