From: Torsten Raudssus Date: Sat, 30 Mar 2024 00:12:28 +0000 (+0100) Subject: Changing default behavior of upload handling to stop taking over the upload extension... X-Git-Tag: v1.23^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FHTTP-Body.git;a=commitdiff_plain;h=cc75c886256f187cda388641931e8dafad6c2346 Changing default behavior of upload handling to stop taking over the upload extension, adding configuration options for changing this behavior back or add custom File::Temp arguments. Updating documentation. --- diff --git a/lib/HTTP/Body.pm b/lib/HTTP/Body.pm index 807703d..bc83c13 100644 --- a/lib/HTTP/Body.pm +++ b/lib/HTTP/Body.pm @@ -62,14 +62,46 @@ and multipart/form-data. Chunked bodies are supported by not passing a length value to new(). -It is currently used by L to parse POST bodies. +It is currently used by L, L, L, L and +L. =head1 NOTES When parsing multipart bodies, temporary files are created to store any uploaded files. You must delete these temporary files yourself after -processing them, or set $body->cleanup(1) to automatically delete them -at DESTROY-time. +processing them, or set $body->cleanup(1) to automatically delete them at +DESTROY-time. + +With version 1.23, we have changed the basic behavior of how temporary files +are prepared for uploads. The extension of the file is no longer transferred +to the temporary file, the extension will always be C<.upload>. We have also +introduced variables that make it possible to set the behavior as required. + +=over 4 + +=item $HTTP::Body::MultiPart::file_temp_suffix + +This is the extension that is given to all multipart files. The default +setting here is C<.upload>. If you want the old behavior from before version +1.23, simply undefine the value here. + +=item $HTTP::Body::MultiPart::basename_regexp + +This is the regexp used to determine out the file extension. This is of +course no longer necessary, unless you undefine +C. + +=item $HTTP::Body::MultiPart::file_temp_template + +This gets passed through to the L TEMPLATE parameter. There is no +special default in our module. + +=item %HTTP::Body::MultiPart::file_temp_parameters + +In this hash you can add up custom settings for the L invokation. +Those override every other setting. + +=back =head1 METHODS @@ -451,7 +483,17 @@ sub param_order { =head1 SUPPORT Since its original creation this module has been taken over by the Catalyst -development team. If you want to contribute patches, these will be your +development team. If you need general support using this module: + +IRC: + + Join #catalyst on irc.perl.org. + +Mailing Lists: + + http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst + +If you want to contribute patches, these will be your primary contact points: IRC: @@ -474,11 +516,11 @@ Andy Grundman, C Simon Elliott C -Kent Fredric +Kent Fredric C -Christian Walde +Christian Walde C -Torsten Raudssus +Torsten Raudssus C =head1 LICENSE diff --git a/lib/HTTP/Body/MultiPart.pm b/lib/HTTP/Body/MultiPart.pm index c9273d4..18354ab 100644 --- a/lib/HTTP/Body/MultiPart.pm +++ b/lib/HTTP/Body/MultiPart.pm @@ -256,7 +256,9 @@ sub parse_body { =cut our $basename_regexp = qr/[^.]+(\.[^\\\/]+)$/; -#our $basename_regexp = qr/(\.\w+(?:\.\w+)*)$/; +our $file_temp_suffix = '.upload'; +our $file_temp_template; +our %file_temp_parameters; sub handler { my ( $self, $part ) = @_; @@ -277,7 +279,11 @@ sub handler { my $basename = (File::Spec->splitpath($filename))[2]; my $suffix = $basename =~ $basename_regexp ? $1 : q{}; - my $fh = File::Temp->new( UNLINK => 0, DIR => $self->tmpdir, SUFFIX => $suffix ); + my $fh = File::Temp->new( + UNLINK => 0, DIR => $self->tmpdir, SUFFIX => ($file_temp_suffix||$suffix), + ( $file_temp_template ? ( TEMPLATE => $file_temp_template ) : () ), + %file_temp_parameters, + ); $part->{fh} = $fh; $part->{tempname} = $fh->filename; @@ -311,6 +317,10 @@ sub handler { =back +=head1 SUPPORT + +See L + =head1 AUTHOR Christian Hansen, C diff --git a/lib/HTTP/Body/OctetStream.pm b/lib/HTTP/Body/OctetStream.pm index 00efce0..290506d 100644 --- a/lib/HTTP/Body/OctetStream.pm +++ b/lib/HTTP/Body/OctetStream.pm @@ -45,6 +45,10 @@ sub spin { =back +=head1 SUPPORT + +See L + =head1 AUTHOR Christian Hansen, C diff --git a/lib/HTTP/Body/UrlEncoded.pm b/lib/HTTP/Body/UrlEncoded.pm index aacef3b..5359cb5 100644 --- a/lib/HTTP/Body/UrlEncoded.pm +++ b/lib/HTTP/Body/UrlEncoded.pm @@ -64,6 +64,10 @@ sub spin { =back +=head1 SUPPORT + +See L + =head1 AUTHORS Christian Hansen, C diff --git a/lib/HTTP/Body/XForms.pm b/lib/HTTP/Body/XForms.pm index 83d0a05..d0903d4 100644 --- a/lib/HTTP/Body/XForms.pm +++ b/lib/HTTP/Body/XForms.pm @@ -47,6 +47,10 @@ sub spin { =back +=head1 SUPPORT + +See L + =head1 AUTHOR Daniel Ruoso, C diff --git a/lib/HTTP/Body/XFormsMultipart.pm b/lib/HTTP/Body/XFormsMultipart.pm index 6e4434c..4b4c9f3 100644 --- a/lib/HTTP/Body/XFormsMultipart.pm +++ b/lib/HTTP/Body/XFormsMultipart.pm @@ -88,6 +88,10 @@ sub handler { =back +=head1 SUPPORT + +See L + =head1 AUTHOR Daniel Ruoso C diff --git a/t/08multipart-suffix.t b/t/08multipart-suffix.t index b72d161..e6d7ddd 100644 --- a/t/08multipart-suffix.t +++ b/t/08multipart-suffix.t @@ -19,6 +19,8 @@ use File::Temp qw/ tempdir /; my $path = catdir( getcwd(), 't', 'data', 'multipart' ); { + $HTTP::Body::MultiPart::file_temp_suffix = undef; + my $uploads = uploads_for('001'); { diff --git a/t/09rt88342.t b/t/09rt88342-diff-regexp.t similarity index 94% copy from t/09rt88342.t copy to t/09rt88342-diff-regexp.t index d71d3d0..27ffad0 100644 --- a/t/09rt88342.t +++ b/t/09rt88342-diff-regexp.t @@ -19,9 +19,10 @@ use File::Temp qw/ tempdir /; my $path = catdir( getcwd(), 't', 'data', 'multipart' ); { + $HTTP::Body::MultiPart::file_temp_suffix = undef; $HTTP::Body::MultiPart::basename_regexp = qr/(\.\w+(?:\.\w+)*)$/; - my $uploads = uploads_for('015'); + my $uploads = uploads_for('015'); { my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload}{tempname} ); diff --git a/t/10mixparamcontent.t b/t/10mixparamcontent.t index dc7688c..27f93c5 100644 --- a/t/10mixparamcontent.t +++ b/t/10mixparamcontent.t @@ -28,15 +28,23 @@ SKIP: { arg1 => [ undef, '', 'Content-Type' =>'text/plain; charset=UTF-8', - 'Content' => $string_in_utf8, ], + 'Content' => $string_in_utf8, + ], arg2 => [ undef, '', 'Content-Type' =>'text/plain; charset=SHIFT_JIS', - 'Content' => $string_in_shiftjis, ], + 'Content' => $string_in_shiftjis, + ], arg2 => [ undef, '', 'Content-Type' =>'text/plain; charset=SHIFT_JIS', - 'Content' => $string_in_shiftjis, ], + 'Content' => $string_in_shiftjis, + ], + arg3 => [ + "$path", Encode::encode_utf8('♥ttachment.txt'), + 'Content-Type' => 'text/plain; charset=UTF-8', + 'Content' => $string_in_utf8, + ], file => [ "$path", Encode::encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8' ], @@ -105,6 +113,10 @@ SKIP: { 'arg2 part data correct', ); + my $filename = $body->upload->{'arg3'} ? ($body->upload->{'arg3'}->{tempname}||"") : ""; + + ok($filename =~ qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, 'arg3 temp file extension correct'); + }; done_testing; diff --git a/t/11new-suffix.t b/t/11new-suffix.t new file mode 100644 index 0000000..42c8ffe --- /dev/null +++ b/t/11new-suffix.t @@ -0,0 +1,99 @@ +#!perl + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/lib"; + +use Test::More tests => 6; +use Test::Deep; + +use Cwd; +use HTTP::Body; +use File::Spec::Functions; +use IO::File; +use PAML; +use File::Temp qw/ tempdir /; + +my $path = catdir( getcwd(), 't', 'data', 'multipart' ); + +{ + my $uploads = uploads_for('001'); + + { + my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} ); + like( + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + } + + { + my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload4}{tempname} ); + like( + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + } + +} + +{ + my $uploads = uploads_for('006'); + + { + my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} ); + like( + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + } + +} + +{ + my $uploads = uploads_for('014'); + + { + my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload}{tempname} ); + like( + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + } + + { + my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} ); + like( + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + } + + like( + $uploads->{upload2}{tempname}, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + +} + +sub uploads_for { + my $number = shift; + + my $headers = PAML::LoadFile( catfile( $path, "$number-headers.pml" ) ); + my $content = IO::File->new( catfile( $path, "$number-content.dat" ) ); + my $body = HTTP::Body->new( $headers->{'Content-Type'}, $headers->{'Content-Length'} ); + my $tempdir = tempdir( 'XXXXXXX', CLEANUP => 1, DIR => File::Spec->tmpdir() ); + $body->tmpdir($tempdir); + + binmode $content, ':raw'; + + while ( $content->read( my $buffer, 1024 ) ) { + $body->add($buffer); + } + + $body->cleanup(1); + + return $body->upload; +} diff --git a/t/09rt88342.t b/t/12rt88342-new.t similarity index 58% rename from t/09rt88342.t rename to t/12rt88342-new.t index d71d3d0..c8d18f8 100644 --- a/t/09rt88342.t +++ b/t/12rt88342-new.t @@ -6,7 +6,7 @@ use warnings; use FindBin; use lib "$FindBin::Bin/lib"; -use Test::More tests => 3; +use Test::More tests => 5; use Test::Deep; use Cwd; @@ -19,34 +19,47 @@ use File::Temp qw/ tempdir /; my $path = catdir( getcwd(), 't', 'data', 'multipart' ); { - $HTTP::Body::MultiPart::basename_regexp = qr/(\.\w+(?:\.\w+)*)$/; - - my $uploads = uploads_for('015'); + my $uploads = uploads_for('015'); { my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload}{tempname} ); like( - $file, qr/^.{10}\.tar\.gz\.Z$/, - 'tempname preserves .tar.gz.Z suffix' + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' ); } { my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} ); like( - $file, qr/^.{10}\.png$/, - 'tempname preserves .png suffix' + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' ); } { my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload3}{tempname} ); like( - $file, qr/^.{10}\.txt$/, - 'tempname preserves .txt suffix' + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + } + + { + my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload4}{tempname} ); + like( + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' ); } + { + my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload5}{tempname} ); + like( + $file, qr/\Q$HTTP::Body::MultiPart::file_temp_suffix\E$/, + 'everything is file_temp_suffix now' + ); + } } sub uploads_for { diff --git a/t/data/multipart/015-content.dat b/t/data/multipart/015-content.dat index de73506..5ad9da3 100644 --- a/t/data/multipart/015-content.dat +++ b/t/data/multipart/015-content.dat @@ -16,4 +16,22 @@ Content-Type: text/plain blah blah +------------0xKhTmLbOuNdArY +Content-Disposition: form-data; name="upload4"; filename="malicious.txt;xeyes;foo.something" +Content-Type: text/plain + +blah blah + +------------0xKhTmLbOuNdArY +Content-Disposition: form-data; name="upload5"; filename="filename.longextlongextlongextlongextlongextlongextlongextlongextlongextlongext.txt" +Content-Type: text/plain + +blah blah + +------------0xKhTmLbOuNdArY +Content-Disposition: form-data; name="upload6"; filename="manyext.a1.b2.c3.d4.e5" +Content-Type: text/plain + +blah blah + ------------0xKhTmLbOuNdArY-- diff --git a/t/data/multipart/015-headers.pml b/t/data/multipart/015-headers.pml index 1709159..0ae2818 100644 --- a/t/data/multipart/015-headers.pml +++ b/t/data/multipart/015-headers.pml @@ -1,5 +1,5 @@ { "User-Agent" => "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/312.1 (KHTML, like Gecko) Safari/312", - "Content-Length" => 517, + "Content-Length" => 1051, "Content-Type" => "multipart/form-data; boundary=----------0xKhTmLbOuNdArY" }