File Coverage

blib/lib/CGI/Easy/Request.pm

Criterion	Covered	Total	%
statement	139	139	100.0
branch	56	68	82.3
condition	12	14	85.7
subroutine	15	15	100.0
pod	2	2	100.0
total	224	238	94.1

package CGI::Easy::Request;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('1.0.0');    # REMINDER: update Changes

# REMINDER: update dependencies in Makefile.PL
use CGI::Easy::Util qw( uri_unescape_plus burst_urlencoded burst_multipart );
use URI::Escape qw( uri_unescape );
use MIME::Base64;

use constant MiB => 1024*1024;  ## no critic(Capitalization)

my $MAX_POST = MiB;

sub new {
    my ($class, $opt) = @_;
    my $self = {
        scheme                  => $ENV{HTTPS} ? 'https' : 'http',
        host                    => undef,
        port                    => $ENV{SERVER_PORT},
        path                    => undef,
        GET                     => {},  # for GET, HEAD, DELETE, …
        POST                    => {},  # for POST, PUT
        filename                => {},
        mimetype                => {},
        cookie                  => {},
        REMOTE_ADDR             => $ENV{REMOTE_ADDR},
        REMOTE_PORT             => $ENV{REMOTE_PORT},
        AUTH_TYPE               => $ENV{AUTH_TYPE},
        REMOTE_USER             => $ENV{REMOTE_USER},
        REMOTE_PASS             => undef,
        ENV                     => { %ENV },
        STDIN                   => q{},
        error                   => q{},
    };
    bless $self, $class;

    my $pre = $opt->{frontend_prefix};
    if (defined $pre) {
        $pre = uc $pre;
        $pre =~ s/-/_/xmsg;
        if (defined $ENV{"HTTP_${pre}REMOTE_ADDR"}) {
            $self->{REMOTE_ADDR} = $ENV{"HTTP_${pre}REMOTE_ADDR"};
            $self->{REMOTE_PORT} = $ENV{"HTTP_${pre}REMOTE_PORT"};
            $self->{scheme}      = $ENV{"HTTP_${pre}HTTPS"} ? 'https' : 'http';
        }
    }

    my $host = $ENV{HTTP_HOST};
    my $path = $ENV{REQUEST_URI};
    if ($path =~ s{\A\w+://(?:[^/@]*@)?([^/]+)}{}xms) {
        $host = $1;
    }
    $host =~ s{:\d+\z}{}xms;
    $path =~ s{[?].*}{}xms;
    $path = uri_unescape($path);  # WARNING nginx allow %2F, apache didn't
    if (!length $path) {
        $path = q{/};
    }
    $self->{host} = $host;
    $self->{path} = $path;

    if ($ENV{HTTP_AUTHORIZATION}) {
        if ($ENV{HTTP_AUTHORIZATION} =~ /\ABasic\s+(\S+)\z/xms) {
            my ($user, $pass) = split /:/xms, decode_base64($1), 2;
            if (defined $pass) {
                $self->{AUTH_TYPE}   = 'Basic';
                $self->{REMOTE_USER} = $user;
                $self->{REMOTE_PASS} = $pass;
            }
        }
        if (!defined $self->{REMOTE_PASS}) {
            $self->{error} = 'failed to parse HTTP_AUTHORIZATION';
        }
    }

    $self->_read_cookie();

    if ($ENV{REQUEST_METHOD} eq 'POST' || $ENV{REQUEST_METHOD} eq 'PUT') {
        $self->_read_post($opt->{max_post});
		if ($opt->{post_with_get}) {
			$self->_read_get();
		}
	} else {
		$self->_read_get();
	}

    if (!$opt->{keep_all_values}) {
        $self->_force_scalar_params();
    }

    if (!$opt->{raw}) {
        $self->_decode_utf8();
    }

	return $self;
}

sub param {
	my ($self, $name) = @_;
    if (defined $name) {
	    my @result;
        for my $method (qw( POST GET )) {
            if (exists $self->{$method}{$name}) {
                my $value = $self->{$method}{$name};
                push @result, ref $value ? @{$value} : $value;
            }
        }
        return wantarray ? @result : $result[0];
    }
    else {
        my %p = map { $_ => 1 } keys %{$self->{POST} || {}}, keys %{$self->{GET} || {}};
        return keys %p;
    }
}

sub _force_scalar_params {
    my ($self) = @_;
    for my $p ($self->{GET}, $self->{POST}, $self->{filename}, $self->{mimetype}) {
        for my $name (keys %{ $p || {} }) {
            if ($name !~ /\[\]\z/xms) {
                $p->{ $name } = $p->{ $name }[0];
            }
        }
    }
    return;
}

sub _decode_utf8 {
    my ($self) = @_;
    utf8::decode($self->{path});
    for my $key (qw( GET POST filename mimetype cookie )) {
        my %tmp;
        for my $name (keys %{ $self->{$key} || {} }) {
            if (ref $self->{$key}{$name}) {
                for my $i (0 .. $#{ $self->{$key}{$name} }) {
                    if (!($key eq 'POST' && defined $self->{mimetype}{$name}[$i])) {
                        utf8::decode($self->{$key}{$name}[$i]);
                    }
                }
            }
            else {
                if (!($key eq 'POST' && defined $self->{mimetype}{$name})) {
                    utf8::decode($self->{$key}{$name});
                }
            }
            my $namestr = $name; utf8::decode($namestr);
            $tmp{ $namestr } = $self->{$key}{$name};
        }
        $self->{$key} = \%tmp;
    }
    return;
}

sub _read_cookie {
    my ($self) = @_;
    foreach (split /;\s?/xms, $self->{ENV}{HTTP_COOKIE} || q{}) {
        s/\s*(.*?)\s*/$1/xms;
        my ($key, $value) = split /=/xms, $_, 2;
        # Some foreign cookies are not in name=value format, so ignore them.
        next if !defined $value;
        $key   = uri_unescape_plus($key);
        $value = uri_unescape_plus($value);
        # A bug in Netscape can cause several cookies with same name to
        # appear.  The FIRST one in HTTP_COOKIE is the most recent version.
        next if exists $self->{cookie}{$key};
        $self->{cookie}{$key} = $value;
    }
    return;
}

sub _read_get {
	my $self = shift;
	$self->{GET} = burst_urlencoded($self->{ENV}{QUERY_STRING});
    return;
}

sub _read_post {
	my ($self, $max_post) = @_;

    $max_post ||= $MAX_POST;
	if ($self->{ENV}{CONTENT_LENGTH} > $max_post) {
        $self->{error} = 'POST body too large';
        return;
    }

	my $buffer = q{};
	if ($self->{ENV}{CONTENT_LENGTH} > 0) {
        binmode STDIN;
        my $n = read STDIN, $buffer, $self->{ENV}{CONTENT_LENGTH}, 0;
        $self->{STDIN} = $buffer;
        if ($n != $self->{ENV}{CONTENT_LENGTH}) {
            $self->{error} = 'POST body incomplete';
            return;
        }
	}

	# Boundaries are supposed to consist of only the following
	# (1-70 of them, not ending in ' ') A-Za-z0-9 '()+,_-./:=?
    my $multipart = qr{\Amultipart/form-data;\s+boundary=(.*)\z}xmsi;
	if ($self->{ENV}{CONTENT_TYPE}) {
        if ($self->{ENV}{CONTENT_TYPE} =~ m/$multipart/xms) {
            my $boundary = $1;
            @{$self}{'POST','filename','mimetype'}
                = burst_multipart($buffer, $boundary);
        }
        elsif ($self->{ENV}{CONTENT_TYPE} eq 'application/x-www-form-urlencoded') {
            $self->{POST} = burst_urlencoded($buffer);
        }
    }
    return;
}


1; # Magic true value required at end of module
__END__

=encoding utf8

=head1 NAME

CGI::Easy::Request - parse CGI params


=head1 SYNOPSIS

    use CGI::Easy::Request;

    my $r = CGI::Easy::Request->new();
    my $r = CGI::Easy::Request->new({
        frontend_prefix     => 'X-Real-',
        max_post            => 10*1024*1024,
        post_with_get       => 1,
        raw                 => 1,
        keep_all_values     => 1,
    });

    if ($r->{error}) {  # incorrect HTTP request
        print "417 Expectation Failed\r\n\r\n";
        print $r->{error};
        exit;
    }

    my @all_param_names = $r->param();
    my $myparam = $r->param('myparam'); # first 'myparam' value
    my @myparam = $r->param('myparam'); # all 'myparam' values

    print $r->{GET}{'myarray[]'}[0];
    print $r->{GET}{myparam};       # without keep_all_values=>1
    print $r->{GET}{myparam}[0];    # with keep_all_values=>1

    $uploaded_file      = $r->{POST}{myfile};
    $uploaded_filename  = $r->{filename}{myfile};

    print $r->{cookie}{mycookie};

    print $r->{ENV}{HTTP_USER_AGENT};


=head1 DESCRIPTION

Parse CGI params (from %ENV and STDIN) and provide user with ease to use
hash (object) with all interesting data.

=head2 FEATURES

=over

=item * DoS protection

Maximum size of content in STDIN is B<always> limited.

=item * HTTP Basic authorization support

Provide CGI with remote user name and password.

=item * UTF8 support

Decode path, GET/POST/cookie names and values (except uploaded files content)
and uploaded file names from UTF8 to Unicode.

=item * Frontend web server support

Can take REMOTE_ADDR/REMOTE_PORT and "https" scheme from non-standard HTTP
headers (like X-Real-REMOTE-ADDR) which is usually set by nginx/lighttpd
frontends.

=item * HEAD/GET/POST/PUT/DELETE/… support

Params sent with POST or PUT method will be placed in C<< {POST} >>,
params for all other methods (including unknown) will be placed in C<< {GET} >>.

=back


=head1 INTERFACE

=over

=item new( [\%opt] )

Parse CGI request from %ENV and STDIN.

Create new object, which contain all parsed data in public fields.
You can access/modify all fields of this object in any way.

If given, %opt may contain these fields:

=over

=item {frontend_prefix}

If there frontend web server used, then CGI executed on backend web server
will not be able to detect user's IP/port and is HTTPS used in usual way,
because CGI "user" now isn't real user, but frontend web server instead.

In this case usual environment variables REMOTE_ADDR and REMOTE_PORT will
contain frontend web server's address, and variable HTTPS will not exists
(because frontend will not use https to connect to backend even if user
connects to frontend using https).

Frontend can be configured to send real user's IP/port/https in custom
HTTP headers (like X-Real-REMOTE_ADDR, X-Real-REMOTE_PORT, X-Real-HTTPS).
For example, nginx configuration may looks like:

    server {
        listen *:80;
        ...
        proxy_set_header    X-Real-REMOTE_ADDR      $remote_addr;
        proxy_set_header    X-Real-REMOTE_PORT      $remote_port;
        proxy_set_header    X-Real-HTTPS            "";
    }
    server {
        listen *:443;
        ...
        proxy_set_header    X-Real-REMOTE_ADDR      $remote_addr;
        proxy_set_header    X-Real-REMOTE_PORT      $remote_port;
        proxy_set_header    X-Real-HTTPS            on;
    }

If you can guarantee only frontend is able to connect to backend, then you can
safely trust these X-Real-* headers. In this case you can set
C<< frontend_prefix => 'X-Real-' >> and new() will parse headers with this
prefix instead of standard REMOTE_ADDR, REMOTE_PORT and HTTPS variables.

=item {max_post}

To protect against DoS attack, size of POST/PUT request is B<always> limited.
Default limit is 1 MB. You can change it using C<< {max_post} >> option
(value in bytes).

=item {post_with_get}

Sometimes POST/PUT request sent to url which also contain some parameters
(after '?'). By default these parameters will be ignored, and only
parameters sent in HTTP request body (STDIN) will be parsed (to C<< {POST} >>).
If you want to additionally parse parameters from url you should set
C<< post_with_get => 1 >> option (these parameters will be parsed to
C<< {GET} >> and not mixed with parameters in C<< {POST} >>).

=item {keep_all_values}

By default only parameters which names ending with '[]' are allowed to have
more than one value. These parameters stored in fields
C<< {GET}, {POST}, {filename} and {mimetype} >> as ARRAYREF, while all other
parameters stored as SCALAR (only first value for these parameters is stored).
If you want to allow more than one value in all parameters you should set
C<< keep_all_values => 1 >> option, and all parameters will be stored as ARRAYREF.

=item {raw}

By default we suppose request send either in UTF8 (or ASCII) encoding.
Request path, GET/POST/cookie names and values (except uploaded files content)
and uploaded file names will be decoded from UTF8 to Unicode.

If you need to handle requests in other encodings, you should disable
automatic decoding from UTF8 using C<< raw => 1 >> option and decode
all these things manually.

=back

Created object will contain these fields:

=over

=item {scheme}

'http' or 'https'.

You may need to use C<< frontend_prefix >> option if you've frontend and
backend web servers to reliably detect 'https' scheme.

=item {host}

=item {port}

Host name and port for requested url.

=item {path}

Path from url, always begin with '/'.

Will be decoded from UTF8 to Unicode unless new() called with option
C<< raw=>1 >>.

=item {GET}

=item {POST}

Will contain request parameters. For request methods POST and PUT
parameters will be stored in C<< {POST} >> (if option C<< post_with_get => 1 >>
used then parameters from url will be additionally stored in C<< {GET >>),
for all other methods (HEAD/GET/DELETE/etc.) parameters will be stored
in C<< {GET} >>.

These fields will contain HASHREF with parameter names, which value will depend
on C<< keep_all_values >> option. By default, value for parameters which
names ending with '[]' will be ARRAYREF, and for all other SCALAR (only first
value for these parameters will be stored if more than one available).

Example: request "GET http://example.com/some.cgi?a=5&a=6&b[]=7&b[]=8&c=9"
will be parsed to

    # by default:
    GET => {
        'a'     => 5,
        'b[]'   => [ 7, 8 ],
        'c'     => 9,
    },
    POST => {}

    # with option keep_all_values=>1:
    GET => {
        'a'     => [ 5, 6 ],
        'b[]'   => [ 7, 8 ],
        'c'     => [ 9 ],
    },
    POST => {}

Parameter names and values (except file content) be decoded from UTF8 to
Unicode unless new() called with option C<< raw=>1 >>.

=item {filename}

=item {mimetype}

When C<< <INPUT TYPE="FILE"> >> used to upload files, browser will send
uploaded file name and MIME type in addition to file contents.
These values will be available in fields C<< {filename} >> and C<< {mimetype} >>,
which have same format as C<< {POST} >> field.

Example: submitted form contain parameter "a" with value "5" and parameter
"image" with value of file "C:\Images\some.gif" will be parsed to:

    GET => {},
    POST => {
        a       => 5,
        image   => '...binary image data...',
    },
    filename => {
        a       => undef,
        image   => 'C:\Images\some.gif',
    }
    mimetype => {
        a       => undef,
        image   => 'image/gif',
    }

Parameter names and file names will be decoded from UTF8 to Unicode unless
new() called with option C<< raw=>1 >>.

=item {cookie}

Will contain hash with cookie names and values. Example:

    cookie => {
        some_cookie     => 'some value',
        other_cookie    => 'other value',
    }

Cookie names and values will be decoded from UTF8 to Unicode unless
new() called with option C<< raw=>1 >>.

=item {REMOTE_ADDR}

=item {REMOTE_PORT}

User's IP and port.

You may need to use C<< frontend_prefix >> option if you've frontend and
backend web servers.

=item {AUTH_TYPE}

=item {REMOTE_USER}

=item {REMOTE_PASS}

There two ways to use HTTP authentication:

1) Web server will check user login/pass, and will provide values for
C<< {AUTH_TYPE} >> and C<< {REMOTE_USER} >>. In this case C<< {REMOTE_PASS} >>
will contain undef().

2) Your CGI will manually check authentication. Only 'Basic' type of HTTP
authentication supported by this module. In this case C<< {AUTH_TYPE} >> will be
set to 'Basic', and C<< {REMOTE_USER} >> and C<< {REMOTE_PASS} >> will contain
login/pass sent by user, and your CGI should check is they correct.
To allow this type of manual authentication you may need to configure
C<.htaccess> to force Apache to send HTTP_AUTHORIZATION environment to your
CGI/FastCGI script:

    <Files "myscript.cgi">
        RewriteEngine On
        RewriteRule .* - [E=HTTP_AUTHORIZATION:%{HTTP:Authorization},L]
    </Files>

=item {ENV}

=item {STDIN}

These fields will contain copy of %ENV and STDIN contents as they was seen
by new(). This is useful to access values in %ENV which doesn't included in
other fields of this object, and to manually parse non-standard data in STDIN.

=item {error}

This field will contain empty string if HTTP request was formed correctly, or
error message if HTTP request was formed incorrectly. Possible errors are:

    failed to parse HTTP_AUTHORIZATION
    POST body too large
    POST body incomplete

=back

Return created CGI::Easy::Request object.


=item param( )

=item param( $name )

This method shouldn't be called if you modified format of C<< {GET} >> or
C<< {POST} >> fields.

When called without parameter will return ARRAY with all CGI parameter
names, both GET and POST parameter names will be joined.

When called with parameter name will return value of this parameter (from
POST parameter if it exists, or from GET if it doesn't exist in POST parameters).
All stored values (see C<< keep_all_values >> option) for this parameter
will be returned in ARRAY context, and only first value will be returned
in SCALAR context.


=back


=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Receiving (from FORM upload) large files will use a lot of memory - this
module doesn't use temporary files and keep everything in memory.


=head1 SUPPORT

Please report any bugs or feature requests through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Easy>.
I will be notified, and then you'll automatically be notified of progress
on your bug as I make changes.

You can also look for information at:

=over

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CGI-Easy>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/CGI-Easy>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/CGI-Easy>

=item * Search CPAN

L<http://search.cpan.org/dist/CGI-Easy/>

=back


=head1 AUTHOR

Alex Efros  C<< <[e-mail]> >>


=head1 LICENSE AND COPYRIGHT

Copyright 2009-2010 Alex Efros <[e-mail]>.

This program is distributed under the MIT (X11) License:
L<http://www.opensource.org/licenses/mit-license.php>

Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the "Software"), to deal in the Software without
restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following
conditions:

The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.