CGI-Tiny
view release on metacpan or search on metacpan
0.011 2021-04-29 02:12:59 EDT
- Rename set_response_content_type and set_response_content_disposition to set_response_type and set_response_disposition
- Add set_response_fixed_length method
0.010 2021-04-28 23:14:59 EDT
- Replace set_response_download method with set_response_content_disposition
- Add reset_response_headers method
0.009 2021-04-28 03:03:52 EDT
- query_param_names, body_param_names, cookie_names, and upload_names now return names in the original request order
- Add set_response_download and set_response_body_buffer methods
- Add file and handle render options
0.008 2021-04-27 21:11:22 EDT
- Fix parsing of empty multipart/form-data forms and some other edge cases
- Add response_status_code method
0.007 2021-04-27 02:00:33 EDT
- Support reading request body parameters from multipart/form-data requests
- Add uploads, upload_names, upload, and upload_array methods to support multipart/form-data file uploads
- Add body_parts method to return raw multipart/form-data parts
- Add set_request_body_buffer and set_multipart_form_charset methods
0.006 2021-04-25 14:48:30 EDT
- Use Unicode::UTF8 for encoding output data if available
- query_params, body_params, and cookies methods now return pairs instead of a hashref
- Remove query_pairs and body_pairs methods
- Add query_param_names, body_param_names, and cookie_names methods
- Add cookie_array method to support multiple request cookies with the same name
set_request_body_limit
$cgi = $cgi->set_request_body_limit(16*1024*1024);
Sets the limit in bytes for the request body. Defaults to the value of
the CGI_TINY_REQUEST_BODY_LIMIT environment variable or 16777216 (16
MiB). A value of 0 will remove the limit (not recommended unless you
have other safeguards on memory usage).
Since the request body is not parsed until needed, methods that parse
the request body like "body" or "upload" will set the response status
to 413 Payload Too Large and throw an exception if the content length
is over the limit. Files uploaded through a multipart/form-data request
body also count toward this limit, though they are streamed to
temporary files when parsed.
set_multipart_form_options
$cgi = $cgi->set_multipart_form_options({discard_files => 1, tempfile_args => [SUFFIX => '.dat']});
Set a hash reference of options to pass when parsing a
multipart/form-data request body with "parse_multipart_form_data" in
CGI::Tiny::Multipart. No effect after the form data has been parsed
such as by calling "body_params" or "uploads" for the first time.
NOTE: Options like parse_as_files and on_file_buffer can alter the
content and file keys of the form field structure returned by
"body_parts". Thus "uploads" may not contain file and may instead
contain content, and "body_params" text field values may be read from
file, which will be expected to be a seekable filehandle if present.
set_multipart_form_charset
$cgi = $cgi->set_multipart_form_charset('UTF-8');
Sets the default charset for decoding multipart/form-data forms,
defaults to UTF-8. Parameter and upload field names, upload filenames,
and text parameter values that don't specify a charset will be decoded
from this charset. Set to an empty string to disable this decoding,
effectively interpreting such values in ISO-8859-1.
set_input_handle
$cgi = $cgi->set_input_handle($fh);
Sets the input handle to read the request body from. If not set, reads
from STDIN. The handle will have binmode applied before reading to
body
my $bytes = $cgi->body;
Retrieve the request body as bytes.
NOTE: This will read the whole request body into memory, so make sure
the "set_request_body_limit" can fit well within the available memory.
Not available after calling "body_parts", "body_params", or "uploads"
(or related accessors) on a multipart/form-data request, since this
type of request body is not retained in memory after parsing.
body_json
my $data = $cgi->body_json;
Decode an application/json request body from UTF-8-encoded JSON.
NOTE: This will read the whole request body into memory, so make sure
my $pairs = $cgi->body_params;
Retrieve application/x-www-form-urlencoded or multipart/form-data body
parameters as an ordered array reference of name/value pairs,
represented as two-element array references. Names and values are
decoded to Unicode characters.
NOTE: This will read the text form fields into memory, so make sure the
"set_request_body_limit" can fit well within the available memory.
multipart/form-data file uploads will be streamed to temporary files
accessible via "uploads" and related methods.
body_param_names
my $arrayref = $cgi->body_param_names;
Retrieve application/x-www-form-urlencoded or multipart/form-data body
parameter names, decoded to Unicode characters, as an ordered array
reference, without duplication.
NOTE: This will read the text form fields into memory as in
NOTE: This will read the text form fields into memory as in
"body_params".
body_parts
my $parts = $cgi->body_parts;
Retrieve multipart/form-data request body parts as an ordered array
reference using "parse_multipart_form_data" in CGI::Tiny::Multipart.
Most applications should retrieve multipart form data through
"body_params" and "uploads" (or related accessors) instead.
NOTE: This will read the text form fields into memory, so make sure the
"set_request_body_limit" can fit well within the available memory. File
uploads will be streamed to temporary files.
uploads
my $pairs = $cgi->uploads;
Retrieve multipart/form-data file uploads as an ordered array reference
of name/upload pairs, represented as two-element array references.
Names are decoded to Unicode characters.
NOTE: This will read the text form fields into memory, so make sure the
"set_request_body_limit" can fit well within the available memory.
File uploads are represented as a hash reference containing the
following keys:
filename
Original filename supplied to file input. An empty filename may
indicate that no file was submitted.
content_type
Content-Type of uploaded file, undef if unspecified.
size
File size in bytes.
file
File::Temp object storing the file contents in a temporary file,
which will be cleaned up when the CGI script ends by default. The
filehandle will be open with the seek pointer at the start of the
file for reading.
upload_names
my $arrayref = $cgi->upload_names;
Retrieve multipart/form-data file upload names, decoded to Unicode
characters, as an ordered array reference, without duplication.
NOTE: This will read the text form fields into memory as in "uploads".
upload
my $upload = $cgi->upload('foo');
Retrieve a named multipart/form-data file upload. If the upload name
was passed multiple times, returns the last value. Use "upload_array"
to get multiple uploads with the same name.
See "uploads" for details on the representation of the upload.
NOTE: This will read the text form fields into memory as in "uploads".
upload_array
my $arrayref = $cgi->upload_array('foo');
Retrieve all multipart/form-data file uploads of the specified name as
an ordered array reference.
See "uploads" for details on the representation of the uploads.
NOTE: This will read the text form fields into memory as in "uploads".
Response
set_nph
$cgi = $cgi->set_nph;
$cgi = $cgi->set_nph(1);
If set to a true value or called without a value before rendering
response headers, CGI::Tiny will act as a NPH (Non-Parsed Header)
settings are applied to the CGI::Tiny object inside the cgi block.
* Exceptions within the cgi block are handled by default by rendering
a server error response and emitting the error as a warning. This can
be customized with "set_error_handler".
* Request parameter accessors in CGI::Tiny are not context sensitive,
as context sensitivity can lead to surprising behavior and
vulnerabilities
<https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2014-1572>.
"param", "query_param", "body_param", and "upload" always return a
single value; "param_array", "query_param_array", "body_param_array",
and "upload_array" must be used to retrieve multi-value parameters.
* CGI::Tiny's "param" accessor is also not method-sensitive; it
accesses either query or body request parameters with the same
behavior regardless of request method, and query and body request
parameters can be accessed separately with "query_param" and
"body_param" respectively.
* CGI::Tiny's "param" accessor only retrieves text parameters;
uploaded files and their metadata are accessed with "upload" and
related methods.
* CGI::Tiny decodes request parameters to Unicode characters
automatically, and "render"/"render_chunk" provide methods to encode
response content from Unicode characters to UTF-8 by default.
* In CGI.pm, response headers must be printed manually before any
response content is printed to avoid malformed responses. In
CGI::Tiny, the "render" or "render_chunk" methods are used to print
response content, and automatically print response headers when first
several of them have no features for rendering responses.
* CGI::Simple shares all of the interface design problems of CGI.pm,
though it does not reimplement the HTML generation helpers.
* CGI::Thin is ancient and only implements parsing of request query
or body parameters, without decoding them to Unicode characters.
* CGI::Minimal has context-sensitive parameter accessors, and only
implements parsing of request query/body parameters (without decoding
them to Unicode characters) and uploads.
* CGI::Lite has context-sensitive parameter accessors, and only
implements parsing of request query/body parameters (without decoding
them to Unicode characters), uploads, and cookies.
* CGI::Easy has a robust interface, but pre-parses all request
information.
CAVEATS
CGI is an extremely simplistic protocol and relies particularly on the
global state of environment variables and the STDIN and STDOUT standard
filehandles. CGI::Tiny does not prevent you from messing with these
interfaces directly, but it may result in confusion.
lib/CGI/Tiny.pm view on Meta::CPAN
}
return $self->{body_params};
}
sub body_parts {
my ($self) = @_;
return [] unless $ENV{CONTENT_TYPE} and $ENV{CONTENT_TYPE} =~ m/^multipart\/form-data\b/i;
return [map { +{%$_} } @{$self->_body_multipart}];
}
sub uploads { [map { [@$_] } @{$_[0]->_body_uploads->{ordered}}] }
sub upload_names { [@{$_[0]->_body_uploads->{names}}] }
sub upload { my $u = $_[0]->_body_uploads->{keyed}; exists $u->{$_[1]} ? $u->{$_[1]}[-1] : undef }
sub upload_array { my $u = $_[0]->_body_uploads->{keyed}; exists $u->{$_[1]} ? [@{$u->{$_[1]}}] : [] }
sub _body_uploads {
my ($self) = @_;
unless (exists $self->{body_uploads}) {
$self->{body_uploads} = {names => \my @names, ordered => \my @ordered, keyed => \my %keyed};
if ($ENV{CONTENT_TYPE} and $ENV{CONTENT_TYPE} =~ m/^multipart\/form-data\b/i) {
my $default_charset = $self->{multipart_form_charset};
$default_charset = 'UTF-8' unless defined $default_charset;
foreach my $part (@{$self->_body_multipart}) {
next unless defined $part->{filename};
my ($name, $filename, $size, $headers, $file, $content) = @$part{'name','filename','size','headers','file','content'};
if (length $default_charset) {
require Encode;
$name = Encode::decode($default_charset, "$name");
$filename = Encode::decode($default_charset, "$filename");
}
my $upload = {
filename => $filename,
size => $size,
content_type => $headers->{'content-type'},
};
$upload->{file} = $file if defined $file;
$upload->{content} = $content if defined $content;
push @names, $name unless exists $keyed{$name};
push @ordered, [$name, $upload];
push @{$keyed{$name}}, $upload;
}
}
}
return $self->{body_uploads};
}
sub _body_length {
my ($self) = @_;
my $limit = $self->{request_body_limit};
$limit = $ENV{CGI_TINY_REQUEST_BODY_LIMIT} unless defined $limit;
$limit = DEFAULT_REQUEST_BODY_LIMIT unless defined $limit;
my $length = $ENV{CONTENT_LENGTH} || 0;
if ($limit and $length > $limit) {
$self->{response_status} = "413 $HTTP_STATUS{413}" unless $self->{headers_rendered};
lib/CGI/Tiny.pod view on Meta::CPAN
=head3 set_request_body_limit
$cgi = $cgi->set_request_body_limit(16*1024*1024);
Sets the limit in bytes for the request body. Defaults to the value of the
C<CGI_TINY_REQUEST_BODY_LIMIT> environment variable or 16777216 (16 MiB). A
value of 0 will remove the limit (not recommended unless you have other
safeguards on memory usage).
Since the request body is not parsed until needed, methods that parse the
request body like L</"body"> or L</"upload"> will set the response status to
C<413 Payload Too Large> and throw an exception if the content length is over
the limit. Files uploaded through a C<multipartE<sol>form-data> request body
also count toward this limit, though they are streamed to temporary files when
parsed.
=head3 set_multipart_form_options
$cgi = $cgi->set_multipart_form_options({discard_files => 1, tempfile_args => [SUFFIX => '.dat']});
Set a hash reference of options to pass when parsing a
C<multipartE<sol>form-data> request body with
L<CGI::Tiny::Multipart/"parse_multipart_form_data">. No effect after the form
data has been parsed such as by calling L</"body_params"> or L</"uploads"> for
the first time.
B<NOTE:> Options like C<parse_as_files> and C<on_file_buffer> can alter the
C<content> and C<file> keys of the form field structure returned by
L</"body_parts">. Thus L</"uploads"> may not contain C<file> and may instead
contain C<content>, and L</"body_params"> text field values may be read from
C<file>, which will be expected to be a seekable filehandle if present.
=head3 set_multipart_form_charset
$cgi = $cgi->set_multipart_form_charset('UTF-8');
Sets the default charset for decoding C<multipartE<sol>form-data> forms,
defaults to C<UTF-8>. Parameter and upload field names, upload filenames, and
text parameter values that don't specify a charset will be decoded from this
charset. Set to an empty string to disable this decoding, effectively
interpreting such values in C<ISO-8859-1>.
=head3 set_input_handle
$cgi = $cgi->set_input_handle($fh);
Sets the input handle to read the request body from. If not set, reads from
C<STDIN>. The handle will have C<binmode> applied before reading to remove any
lib/CGI/Tiny.pod view on Meta::CPAN
=head3 body
my $bytes = $cgi->body;
Retrieve the request body as bytes.
B<NOTE:> This will read the whole request body into memory, so make sure the
L</"set_request_body_limit"> can fit well within the available memory.
Not available after calling L</"body_parts">, L</"body_params">, or
L</"uploads"> (or related accessors) on a C<multipartE<sol>form-data> request,
since this type of request body is not retained in memory after parsing.
=head3 body_json
my $data = $cgi->body_json;
Decode an C<application/json> request body from UTF-8-encoded JSON.
B<NOTE:> This will read the whole request body into memory, so make sure the
L</"set_request_body_limit"> can fit well within the available memory.
lib/CGI/Tiny.pod view on Meta::CPAN
my $pairs = $cgi->body_params;
Retrieve C<applicationE<sol>x-www-form-urlencoded> or
C<multipartE<sol>form-data> body parameters as an ordered array reference of
name/value pairs, represented as two-element array references. Names and values
are decoded to Unicode characters.
B<NOTE:> This will read the text form fields into memory, so make sure the
L</"set_request_body_limit"> can fit well within the available memory.
C<multipartE<sol>form-data> file uploads will be streamed to temporary files
accessible via L</"uploads"> and related methods.
=head3 body_param_names
my $arrayref = $cgi->body_param_names;
Retrieve C<applicationE<sol>x-www-form-urlencoded> or
C<multipartE<sol>form-data> body parameter names, decoded to Unicode
characters, as an ordered array reference, without duplication.
B<NOTE:> This will read the text form fields into memory as in
lib/CGI/Tiny.pod view on Meta::CPAN
B<NOTE:> This will read the text form fields into memory as in
L</"body_params">.
=head3 body_parts
my $parts = $cgi->body_parts;
Retrieve C<multipartE<sol>form-data> request body parts as an ordered array
reference using L<CGI::Tiny::Multipart/"parse_multipart_form_data">. Most
applications should retrieve multipart form data through L</"body_params"> and
L</"uploads"> (or related accessors) instead.
B<NOTE:> This will read the text form fields into memory, so make sure the
L</"set_request_body_limit"> can fit well within the available memory. File
uploads will be streamed to temporary files.
=head3 uploads
my $pairs = $cgi->uploads;
Retrieve C<multipartE<sol>form-data> file uploads as an ordered array reference
of name/upload pairs, represented as two-element array references. Names are
decoded to Unicode characters.
B<NOTE:> This will read the text form fields into memory, so make sure the
L</"set_request_body_limit"> can fit well within the available memory.
File uploads are represented as a hash reference containing the following keys:
=over
=item filename
Original filename supplied to file input. An empty filename may indicate that
no file was submitted.
=item content_type
C<Content-Type> of uploaded file, undef if unspecified.
=item size
File size in bytes.
=item file
L<File::Temp> object storing the file contents in a temporary file, which will
be cleaned up when the CGI script ends by default. The filehandle will be open
with the C<seek> pointer at the start of the file for reading.
=back
=head3 upload_names
my $arrayref = $cgi->upload_names;
Retrieve C<multipartE<sol>form-data> file upload names, decoded to Unicode
characters, as an ordered array reference, without duplication.
B<NOTE:> This will read the text form fields into memory as in L</"uploads">.
=head3 upload
my $upload = $cgi->upload('foo');
Retrieve a named C<multipartE<sol>form-data> file upload. If the upload name
was passed multiple times, returns the last value. Use L</"upload_array">
to get multiple uploads with the same name.
See L</"uploads"> for details on the representation of the upload.
B<NOTE:> This will read the text form fields into memory as in L</"uploads">.
=head3 upload_array
my $arrayref = $cgi->upload_array('foo');
Retrieve all C<multipartE<sol>form-data> file uploads of the specified name as
an ordered array reference.
See L</"uploads"> for details on the representation of the uploads.
B<NOTE:> This will read the text form fields into memory as in L</"uploads">.
=head2 Response
=head3 set_nph
$cgi = $cgi->set_nph;
$cgi = $cgi->set_nph(1);
If set to a true value or called without a value before rendering response
headers, CGI::Tiny will act as a
lib/CGI/Tiny.pod view on Meta::CPAN
Exceptions within the C<cgi> block are handled by default by rendering a server
error response and emitting the error as a warning. This can be customized with
L</"set_error_handler">.
=item *
Request parameter accessors in CGI::Tiny are not context sensitive, as context
sensitivity can lead to surprising behavior and
L<vulnerabilities|https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2014-1572>.
L</"param">, L</"query_param">, L</"body_param">, and L</"upload"> always
return a single value; L</"param_array">, L</"query_param_array">,
L</"body_param_array">, and L</"upload_array"> must be used to retrieve
multi-value parameters.
=item *
CGI::Tiny's L</"param"> accessor is also not method-sensitive; it accesses
either query or body request parameters with the same behavior regardless of
request method, and query and body request parameters can be accessed
separately with L</"query_param"> and L</"body_param"> respectively.
=item *
CGI::Tiny's L</"param"> accessor only retrieves text parameters; uploaded
files and their metadata are accessed with L</"upload"> and related methods.
=item *
CGI::Tiny decodes request parameters to Unicode characters automatically, and
L</"render">/L</"render_chunk"> provide methods to encode response content from
Unicode characters to UTF-8 by default.
=item *
In CGI.pm, response headers must be printed manually before any response
lib/CGI/Tiny.pod view on Meta::CPAN
=item *
L<CGI::Thin> is ancient and only implements parsing of request query or body
parameters, without decoding them to Unicode characters.
=item *
L<CGI::Minimal> has context-sensitive parameter accessors, and only implements
parsing of request query/body parameters (without decoding them to Unicode
characters) and uploads.
=item *
L<CGI::Lite> has context-sensitive parameter accessors, and only implements
parsing of request query/body parameters (without decoding them to Unicode
characters), uploads, and cookies.
=item *
L<CGI::Easy> has a robust interface, but pre-parses all request information.
=back
=head1 CAVEATS
CGI is an extremely simplistic protocol and relies particularly on the global
lib/CGI/Tiny/Multipart.pod view on Meta::CPAN
Buffer size (number of bytes to read at once) for reading the request body from
an input filehandle. Defaults to 262144 (256 KiB). A value of 0 will use the
default value.
=item parse_as_files
parse_as_files => 1
parse_as_files => 0
If set to a true value, all form field values will be parsed as file uploads,
calling C<on_file_buffer> or storing the contents in a tempfile. If set to a
false (but defined) value, all form field values will be returned as
C<content>, even file uploads. By default, text field values will be returned
as C<content> and file uploads will be parsed by C<on_file_buffer> or stored in
tempfiles.
=item on_file_buffer
on_file_buffer => sub { my ($bytes, $hashref, $eof) = @_; }
Callback for custom parsing of file upload form fields. If specified, it will
be called with each (possibly empty) chunk of file contents that is read from
the form as bytes. The hash reference representing this form field is passed as
the second argument. The third argument will be true the last time the callback
is called for a particular form field.
The hash reference passed to the callback persists between calls for the same
form field, and is the same hash reference that will ultimately be returned to
represent the form field. It will contain the C<headers>, undecoded C<name> and
C<filename>, and C<size> of contents read so far (including the bytes just
passed to the callback). Modifying these values may result in unexpected
behavior, but other modifications to the hash reference are allowed.
If C<on_file_buffer> is not specified, file uploads will be stored in C<file>
as a L<File::Temp> object created with C<tempfile_args>.
# approximate the default behavior
on_file_buffer => sub {
my ($bytes, $hashref, $eof) = @_;
$hashref->{file} //= File::Temp->new;
print {$hashref->{file}} $bytes;
if ($eof) {
$hashref->{file}->flush;
seek $hashref->{file}, 0, 0;
}
}
=item tempfile_args
tempfile_args => [TEMPLATE => 'tempXXXXX', SUFFIX => '.dat']
Arguments to pass to the L<File::Temp> constructor when creating tempfiles for
file uploads. By default no arguments are passed. Not used if a custom
C<on_file_buffer> callback is passed.
=item discard_files
discard_files => 1
If set to a true value, file upload field contents will be discarded without
calling C<on_file_buffer>, and neither C<content> nor C<file> will be provided
for those form fields. Note that this discards the contents of form fields with
a defined C<filename> regardless of the C<parse_as_files> setting.
=back
Form fields are represented as hash references containing:
=over
lib/CGI/Tiny/Multipart.pod view on Meta::CPAN
Filename from C<Content-Disposition> header if present, undecoded.
=item size
Size of form field contents in bytes.
=item content
Form field contents as undecoded bytes, for form fields without a defined
C<filename>, or for all form fields if the C<parse_as_files> option was set to
a false value. File uploads are stored in a temporary C<file> instead by
default.
=item file
L<File::Temp> object referencing temporary file containing the form field
contents, for form fields with a defined C<filename>, or for all form fields if
the C<parse_as_files> option was set to a true value.
=back
--delimiter--\r
postamble
EOB
local $ENV{CONTENT_TYPE} = 'multipart/form-data; boundary=delimiter';
local $ENV{CONTENT_LENGTH} = length $body_string;
open my $in_fh, '<', \$body_string or die "failed to open handle for input: $!";
open my $out_fh, '>', \my $out_data or die "failed to open handle for output: $!";
my $parts;
my ($param_query, $params, $param_names, $param_snowman, $param_snowman_array);
my ($uploads, $upload_names, $upload_file, $upload_file_array, $upload_empty, $upload_empty_array);
cgi {
$_->set_input_handle($in_fh);
$_->set_output_handle($out_fh);
$_->set_multipart_form_options({discard_files => 0});
$_->set_multipart_form_charset('UTF-8');
$parts = $_->body_parts;
$param_query = $_->param('query');
$params = $_->body_params;
$param_names = $_->body_param_names;
$param_snowman = $_->body_param('snowman');
$param_snowman_array = $_->param_array('snowman');
$uploads = $_->uploads;
$upload_names = $_->upload_names;
$upload_file = $_->upload('file');
$upload_file_array = $_->upload_array('file');
$upload_empty = $_->upload('empty');
$upload_empty_array = $_->upload_array('empty');
$_->render;
};
ok length($out_data), 'response rendered';
my $response = _parse_response($out_data);
ok defined($response->{headers}{date}), 'Date set';
like $response->{status}, qr/^200\b/, '200 response status';
my @files;
foreach my $i (0..$#$parts) {
name => 'file', filename => 'test2.dat', size => 11, file_contents => '{"test":42}'},
{headers => {'content-disposition' => 'form-data; name="snowman"; filename="snowman\\\\\\".txt"', 'content-type' => 'text/plain;charset=UTF-16LE'},
name => 'snowman', filename => 'snowman\".txt', size => length($utf16le_snowman), file_contents => $utf16le_snowman},
], 'right multipart body parts';
is $param_query, 'foo', 'right generic param';
is_deeply $params, [['snowman', '☃!'], ['snowman', "☃...\n"], ['newline\"', "\n"], ['empty', ''], ['empty', '']], 'right multipart body params';
is_deeply $param_names, ['snowman', 'newline\"', 'empty'], 'right multipart body param names';
is $param_snowman, "☃...\n", 'right multipart body param value';
is_deeply $param_snowman_array, ['snow', '☃!', "☃...\n"], 'right multipart body param values';
is $uploads->[-1][0], 'snowman', 'right upload name';
my $upload_snowman = $uploads->[-1][1];
ok defined $upload_snowman, 'last upload';
is $upload_snowman->{filename}, 'snowman\".txt', 'right upload filename';
is $upload_snowman->{size}, length $utf16le_snowman, 'right upload size';
is $upload_snowman->{content_type}, 'text/plain;charset=UTF-16LE', 'right upload Content-Type';
is do { local $/; seek $upload_snowman->{file}, 0, 0; scalar readline $upload_snowman->{file} }, $utf16le_snowman, 'right upload contents';
is_deeply $upload_names, ['file', 'snowman'], 'right upload names';
is $upload_file->{filename}, 'test2.dat', 'right upload filename';
is $upload_file->{content_type}, 'application/json', 'right upload Content-Type';
is $upload_file_array->[0]{filename}, 'test.dat', 'right upload filename';
is $upload_file_array->[1]{filename}, 'test2.dat', 'right upload filename';
is $upload_empty, undef, 'missing upload';
is_deeply $upload_empty_array, [], 'missing upload array';
};
subtest 'Multipart body (discard files)' => sub {
local @ENV{@env_keys} = ('')x@env_keys;
local $ENV{PATH_INFO} = '/';
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{SCRIPT_NAME} = '/';
local $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
my $utf16le_snowman = encode 'UTF-16LE', "☃...\n";
my $body_string = <<"EOB";
--delimiter--\r
postamble
EOB
local $ENV{CONTENT_TYPE} = 'multipart/form-data; boundary=delimiter';
local $ENV{CONTENT_LENGTH} = length $body_string;
open my $in_fh, '<', \$body_string or die "failed to open handle for input: $!";
open my $out_fh, '>', \my $out_data or die "failed to open handle for output: $!";
my $parts;
my ($params, $param_names, $param_snowman, $param_snowman_array);
my ($uploads, $upload_names, $upload_file, $upload_file_array);
cgi {
$_->set_input_handle($in_fh);
$_->set_output_handle($out_fh);
$_->set_multipart_form_options({discard_files => 1});
$_->set_multipart_form_charset('UTF-8');
$parts = $_->body_parts;
$params = $_->body_params;
$param_names = $_->body_param_names;
$param_snowman = $_->body_param('snowman');
$param_snowman_array = $_->body_param_array('snowman');
$uploads = $_->uploads;
$upload_names = $_->upload_names;
$upload_file = $_->upload('file');
$upload_file_array = $_->upload_array('file');
$_->render;
};
ok length($out_data), 'response rendered';
my $response = _parse_response($out_data);
ok defined($response->{headers}{date}), 'Date set';
like $response->{status}, qr/^200\b/, '200 response status';
is_deeply $parts, [
{headers => {'content-disposition' => 'form-data; name=snowman', 'content-type' => 'text/plain;charset=UTF-16LE'},
name => 'snowman', filename => undef, size => length($utf16le_snowman), content => $utf16le_snowman},
{headers => {'content-disposition' => 'form-data; name="file"; filename="test.dat"', 'content-type' => 'application/octet-stream'},
name => 'file', filename => 'test.dat', size => 18},
], 'right multipart body parts';
is_deeply $params, [['snowman', "☃...\n"]], 'right multipart body params';
is_deeply $param_names, ['snowman'], 'right multipart body param names';
is $param_snowman, "☃...\n", 'right multipart body param value';
is_deeply $param_snowman_array, ["☃...\n"], 'right multipart body param values';
is $uploads->[-1][0], 'file', 'right upload name';
is_deeply $upload_names, ['file'], 'right upload names';
is $upload_file->{filename}, 'test.dat', 'right upload filename';
is $upload_file->{content_type}, 'application/octet-stream', 'right upload Content-Type';
is $upload_file_array->[0]{filename}, 'test.dat', 'right upload filename';
};
subtest 'Multipart body (parse all as files)' => sub {
local @ENV{@env_keys} = ('')x@env_keys;
local $ENV{PATH_INFO} = '/';
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{SCRIPT_NAME} = '/';
local $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
my $utf16le_snowman = encode 'UTF-16LE', "☃...\n";
my $body_string = <<"EOB";
--delimiter--\r
postamble
EOB
local $ENV{CONTENT_TYPE} = 'multipart/form-data; boundary=delimiter';
local $ENV{CONTENT_LENGTH} = length $body_string;
open my $in_fh, '<', \$body_string or die "failed to open handle for input: $!";
open my $out_fh, '>', \my $out_data or die "failed to open handle for output: $!";
my $parts;
my ($params, $param_names, $param_snowman, $param_snowman_array);
my ($uploads, $upload_names, $upload_file, $upload_file_array);
cgi {
$_->set_input_handle($in_fh);
$_->set_output_handle($out_fh);
$_->set_multipart_form_options({parse_as_files => 1});
$_->set_multipart_form_charset('UTF-8');
$parts = $_->body_parts;
$params = $_->body_params;
$param_names = $_->body_param_names;
$param_snowman = $_->body_param('snowman');
$param_snowman_array = $_->body_param_array('snowman');
$uploads = $_->uploads;
$upload_names = $_->upload_names;
$upload_file = $_->upload('file');
$upload_file_array = $_->upload_array('file');
$_->render;
};
ok length($out_data), 'response rendered';
my $response = _parse_response($out_data);
ok defined($response->{headers}{date}), 'Date set';
like $response->{status}, qr/^200\b/, '200 response status';
my @files;
foreach my $i (0..$#$parts) {
{headers => {'content-disposition' => 'form-data; name=snowman', 'content-type' => 'text/plain;charset=UTF-16LE'},
name => 'snowman', filename => undef, size => length($utf16le_snowman), file_contents => $utf16le_snowman},
{headers => {'content-disposition' => 'form-data; name="file"; filename="test.dat"', 'content-type' => 'application/octet-stream'},
name => 'file', filename => 'test.dat', size => 18, file_contents => "00000000\n11111111\0"},
], 'right multipart body parts';
is_deeply $params, [['snowman', "☃...\n"]], 'right multipart body params';
is_deeply $param_names, ['snowman'], 'right multipart body param names';
is $param_snowman, "☃...\n", 'right multipart body param value';
is_deeply $param_snowman_array, ["☃...\n"], 'right multipart body param values';
is $uploads->[-1][0], 'file', 'right upload name';
is_deeply $upload_names, ['file'], 'right upload names';
is $upload_file->{filename}, 'test.dat', 'right upload filename';
is $upload_file->{content_type}, 'application/octet-stream', 'right upload Content-Type';
is $upload_file_array->[0]{filename}, 'test.dat', 'right upload filename';
};
subtest 'Multipart body (parse none as files)' => sub {
local @ENV{@env_keys} = ('')x@env_keys;
local $ENV{PATH_INFO} = '/';
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{SCRIPT_NAME} = '/';
local $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
my $utf16le_snowman = encode 'UTF-16LE', "☃...\n";
my $body_string = <<"EOB";
--delimiter--\r
postamble
EOB
local $ENV{CONTENT_TYPE} = 'multipart/form-data; boundary=delimiter';
local $ENV{CONTENT_LENGTH} = length $body_string;
open my $in_fh, '<', \$body_string or die "failed to open handle for input: $!";
open my $out_fh, '>', \my $out_data or die "failed to open handle for output: $!";
my $parts;
my ($params, $param_names, $param_snowman, $param_snowman_array);
my ($uploads, $upload_names, $upload_file, $upload_file_array);
cgi {
$_->set_input_handle($in_fh);
$_->set_output_handle($out_fh);
$_->set_multipart_form_options({parse_as_files => 0});
$_->set_multipart_form_charset('UTF-8');
$parts = $_->body_parts;
$params = $_->body_params;
$param_names = $_->body_param_names;
$param_snowman = $_->body_param('snowman');
$param_snowman_array = $_->body_param_array('snowman');
$uploads = $_->uploads;
$upload_names = $_->upload_names;
$upload_file = $_->upload('file');
$upload_file_array = $_->upload_array('file');
$_->render;
};
ok length($out_data), 'response rendered';
my $response = _parse_response($out_data);
ok defined($response->{headers}{date}), 'Date set';
like $response->{status}, qr/^200\b/, '200 response status';
is_deeply $parts, [
{headers => {'content-disposition' => 'form-data; name=snowman', 'content-type' => 'text/plain;charset=UTF-16LE'},
name => 'snowman', filename => undef, size => length($utf16le_snowman), content => $utf16le_snowman},
{headers => {'content-disposition' => 'form-data; name="file"; filename="test.dat"', 'content-type' => 'application/octet-stream'},
name => 'file', filename => 'test.dat', size => 18, content => "00000000\n11111111\0"},
], 'right multipart body parts';
is_deeply $params, [['snowman', "☃...\n"]], 'right multipart body params';
is_deeply $param_names, ['snowman'], 'right multipart body param names';
is $param_snowman, "☃...\n", 'right multipart body param value';
is_deeply $param_snowman_array, ["☃...\n"], 'right multipart body param values';
is $uploads->[-1][0], 'file', 'right upload name';
is_deeply $upload_names, ['file'], 'right upload names';
is $upload_file->{filename}, 'test.dat', 'right upload filename';
is $upload_file->{content_type}, 'application/octet-stream', 'right upload Content-Type';
is $upload_file->{content}, "00000000\n11111111\0", 'upload contents in memory';
is $upload_file_array->[0]{filename}, 'test.dat', 'right upload filename';
};
subtest 'Multipart body (custom parsing)' => sub {
local @ENV{@env_keys} = ('')x@env_keys;
local $ENV{PATH_INFO} = '/';
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{SCRIPT_NAME} = '/';
local $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
my $utf16le_snowman = encode 'UTF-16LE', "☃...\n";
my $body_string = <<"EOB";
postamble
EOB
local $ENV{CONTENT_TYPE} = 'multipart/form-data; boundary=delimiter';
local $ENV{CONTENT_LENGTH} = length $body_string;
open my $in_fh, '<', \$body_string or die "failed to open handle for input: $!";
open my $out_fh, '>', \my $out_data or die "failed to open handle for output: $!";
my $file_bytes = '';
my $parts;
my ($params, $param_names, $param_snowman, $param_snowman_array);
my ($uploads, $upload_names, $upload_file, $upload_file_array);
cgi {
$_->set_input_handle($in_fh);
$_->set_output_handle($out_fh);
$_->set_multipart_form_options({on_file_buffer => sub { $file_bytes .= $_[0] }});
$_->set_multipart_form_charset('UTF-8');
$parts = $_->body_parts;
$params = $_->body_params;
$param_names = $_->body_param_names;
$param_snowman = $_->body_param('snowman');
$param_snowman_array = $_->body_param_array('snowman');
$uploads = $_->uploads;
$upload_names = $_->upload_names;
$upload_file = $_->upload('file');
$upload_file_array = $_->upload_array('file');
$_->render;
};
ok length($out_data), 'response rendered';
my $response = _parse_response($out_data);
ok defined($response->{headers}{date}), 'Date set';
like $response->{status}, qr/^200\b/, '200 response status';
is_deeply $parts, [
{headers => {'content-disposition' => 'form-data; name=snowman', 'content-type' => 'text/plain;charset=UTF-16LE'},
name => 'snowman', filename => undef, size => length($utf16le_snowman), content => $utf16le_snowman},
{headers => {'content-disposition' => 'form-data; name="file"; filename="test.dat"', 'content-type' => 'application/octet-stream'},
name => 'file', filename => 'test.dat', size => 18},
], 'right multipart body parts';
is_deeply $params, [['snowman', "☃...\n"]], 'right multipart body params';
is_deeply $param_names, ['snowman'], 'right multipart body param names';
is $param_snowman, "☃...\n", 'right multipart body param value';
is_deeply $param_snowman_array, ["☃...\n"], 'right multipart body param values';
is $uploads->[-1][0], 'file', 'right upload name';
is_deeply $upload_names, ['file'], 'right upload names';
is $upload_file->{filename}, 'test.dat', 'right upload filename';
is $upload_file->{content_type}, 'application/octet-stream', 'right upload Content-Type';
is $upload_file->{file}, undef, 'no upload file';
is $upload_file->{content}, undef, 'no upload content';
is $upload_file_array->[0]{filename}, 'test.dat', 'right upload filename';
is $file_bytes, "00000000\n11111111\0", 'parsed file contents';
};
subtest 'Multipart body read into memory' => sub {
local @ENV{@env_keys} = ('')x@env_keys;
local $ENV{PATH_INFO} = '/';
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{SCRIPT_NAME} = '/';
local $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
my $utf8_snowman = encode 'UTF-8', '☃!';
\r
$utf8_snowman
\r
--fffff--\r
EOB
local $ENV{CONTENT_TYPE} = 'multipart/form-data; boundary=fffff';
local $ENV{CONTENT_LENGTH} = length $body_string;
open my $in_fh, '<', \$body_string or die "failed to open handle for input: $!";
open my $out_fh, '>', \my $out_data or die "failed to open handle for output: $!";
my ($body, $parts, $params, $param_names, $param_snowman, $uploads, $upload_names, $upload_snowman);
cgi {
$_->set_input_handle($in_fh);
$_->set_output_handle($out_fh);
$body = $_->body;
$parts = $_->body_parts;
$params = $_->body_params;
$param_names = $_->body_param_names;
$param_snowman = $_->body_param('; filename=snowman\\');
$uploads = $_->uploads;
$upload_names = $_->upload_names;
$upload_snowman = $_->upload('file');
$_->render;
};
ok length($out_data), 'response rendered';
my $response = _parse_response($out_data);
ok defined($response->{headers}{date}), 'Date set';
like $response->{status}, qr/^200\b/, '200 response status';
is $body, $body_string, 'right body content bytes';
my @files;
is_deeply $parts, [
{headers => {'content-disposition' => 'form-data; name="; filename=snowman\\\\"'},
name => '; filename=snowman\\', filename => undef, size => length($utf8_snowman), content => $utf8_snowman},
{headers => {'content-disposition' => 'form-data; name="file"; filename="test.txt\\\\"', 'content-type' => 'text/plain;charset=UTF-8'},
name => 'file', filename => 'test.txt\\', size => length($utf8_snowman) + 1, file_contents => "$utf8_snowman\n"},
], 'right multipart body parts';
is_deeply $params, [['; filename=snowman\\', '☃!']], 'right multipart body params';
is_deeply $param_names, ['; filename=snowman\\'], 'right multipart body param names';
is $param_snowman, '☃!', 'right multipart body param value';
is $uploads->[0][0], 'file', 'right upload name';
is_deeply $upload_names, ['file'], 'right upload names';
is $upload_snowman->{filename}, 'test.txt\\', 'right upload filename';
is $upload_snowman->{content_type}, 'text/plain;charset=UTF-8', 'right upload Content-Type';
};
subtest 'Malformed multipart boundary' => sub {
local @ENV{@env_keys} = ('')x@env_keys;
local $ENV{PATH_INFO} = '/';
local $ENV{REQUEST_METHOD} = 'POST';
local $ENV{SCRIPT_NAME} = '/';
local $ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
my $body_string = <<"EOB";
--\r
( run in 1.143 second using v1.01-cache-2.11-cpan-b16cb0d3907 )