Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package perl-HTTP-Body for openSUSE:Factory
checked in at 2026-11-06 19:59:10
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-HTTP-Body (Old)
and /work/SRC/openSUSE:Factory/.perl-HTTP-Body.new.3759290 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-HTTP-Body"
Fri Nov 6 19:59:10 2026 rev:18 rq:1395878 version:1.250.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-HTTP-Body/perl-HTTP-Body.changes
2026-10-29 16:10:28.294456721 +0100
+++
/work/SRC/openSUSE:Factory/.perl-HTTP-Body.new.3759290/perl-HTTP-Body.changes
2026-11-06 20:07:34.209365340 +0100
@@ -1,0 +2,46 @@
+Fri Nov 6 11:31:37 UTC 2026 - Tina Müller <[email protected]>
+
+- updated to 1.250.0 (1.25)
+ see /usr/share/doc/packages/perl-HTTP-Body/Changes
+
+ 1.25 2026-11-05 18:47:08+01:00 Europe/Berlin
+ - SECURITY, CVE-2026-117500: the suffix of an upload's filename is
+ worked out from its last 255 bytes only, only when $file_temp_suffix
+ is unset, and for the default $basename_regexp by a string search
+ instead of the regexp; a filename of many dots ending in a backslash
+ made the default $basename_regexp take time quadratic in its length
+ (7 s per part at the 32 KiB header limit, once per part) in the
+ default configuration
+ bsc#1288651
+ - SECURITY, CVE-2026-117501: a chunked body is framed line by line with
+ a limit on the chunk-size line ($HTTP::Body::max_chunk_line_size,
+ 1024 bytes), chunk data is passed on as it arrives instead of being
+ held until the chunk is complete, malformed framing (a line that is
+ no chunk-size line, a size that does not fit an integer, chunk data
+ not followed by CRLF) croaks instead of buffering forever, and
+ nothing after the trailer or after the body parser is done is kept
+ bsc#1288652
+ - SECURITY, CVE-2026-121006: the trailer of a chunked body is limited
+ to $HTTP::Body::max_trailer_size bytes (32768) and
+ $HTTP::Body::max_trailer_lines header lines (100); everything that
+ followed the last chunk in the same call to add() was parsed with
+ HTTP::Headers, which takes time quadratic in the number of fields of
+ one name (6 s for 16 KiB of "a:" lines)
+ bsc#1289589
+ - trailing_headers: a trailer is read up to its blank line also when it
+ arrives in later calls to add() than the last chunk; it used to be
+ lost
+ - XFormsMultipart: a part other than the start part now gets its
+ temporary file and the NUL strip of RT#123615 like any upload; it used
+ to be returned by upload without a tempname, its data dropped
+ - parse_header: a continuation line at the start of a part's header
+ block is dropped instead of dying, and a line that is no header field
+ is dropped instead of being stored under a made-up field name
+ - add: the caller's buffer is no longer modified in place when it
+ exceeds the Content-Length, so a read-only value is accepted
+ - Docs: every method of the parser classes is described, add and
+ length say what they return; the README lists every limit,
+ $basename_regexp and all runtime prerequisites
+ - File::Spec is declared as a prerequisite
+
+-------------------------------------------------------------------
Old:
----
HTTP-Body-1.24.tar.gz
New:
----
HTTP-Body-1.25.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-HTTP-Body.spec ++++++
--- /var/tmp/diff_new_pack.vvjcaQ/_old 2026-11-06 20:07:35.214407459 +0100
+++ /var/tmp/diff_new_pack.vvjcaQ/_new 2026-11-06 20:07:35.215407500 +0100
@@ -18,10 +18,10 @@
%define cpan_name HTTP-Body
Name: perl-HTTP-Body
-Version: 1.240.0
+Version: 1.250.0
Release: 0
-# 1.24 -> normalize -> 1.240.0
-%define cpan_version 1.24
+# 1.25 -> normalize -> 1.250.0
+%define cpan_version 1.25
License: Artistic-1.0 OR GPL-1.0-or-later
Summary: HTTP Body Parser
URL: https://metacpan.org/release/%{cpan_name}
@@ -49,7 +49,9 @@
%description
HTTP::Body parses chunks of HTTP POST data and supports
application/octet-stream, application/json,
-application/x-www-form-urlencoded, and multipart/form-data.
+application/x-www-form-urlencoded, multipart/form-data, and XForms
+submissions (multipart/related and application/xml). A body of any other
+content type is handled like application/octet-stream.
Chunked bodies are supported by not passing a length value to new().
++++++ HTTP-Body-1.24.tar.gz -> HTTP-Body-1.25.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/Changes new/HTTP-Body-1.25/Changes
--- old/HTTP-Body-1.24/Changes 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/Changes 2026-11-05 18:47:11.000000000 +0100
@@ -1,5 +1,42 @@
This file documents the revision history for Perl extension HTTP::Body.
+1.25 2026-11-05 18:47:08+01:00 Europe/Berlin
+ - SECURITY, CVE-2026-117500: the suffix of an upload's filename is
+ worked out from its last 255 bytes only, only when $file_temp_suffix
+ is unset, and for the default $basename_regexp by a string search
+ instead of the regexp; a filename of many dots ending in a backslash
+ made the default $basename_regexp take time quadratic in its length
+ (7 s per part at the 32 KiB header limit, once per part) in the
+ default configuration
+ - SECURITY, CVE-2026-117501: a chunked body is framed line by line with
+ a limit on the chunk-size line ($HTTP::Body::max_chunk_line_size,
+ 1024 bytes), chunk data is passed on as it arrives instead of being
+ held until the chunk is complete, malformed framing (a line that is
+ no chunk-size line, a size that does not fit an integer, chunk data
+ not followed by CRLF) croaks instead of buffering forever, and
+ nothing after the trailer or after the body parser is done is kept
+ - SECURITY, CVE-2026-121006: the trailer of a chunked body is limited
+ to $HTTP::Body::max_trailer_size bytes (32768) and
+ $HTTP::Body::max_trailer_lines header lines (100); everything that
+ followed the last chunk in the same call to add() was parsed with
+ HTTP::Headers, which takes time quadratic in the number of fields of
+ one name (6 s for 16 KiB of "a:" lines)
+ - trailing_headers: a trailer is read up to its blank line also when it
+ arrives in later calls to add() than the last chunk; it used to be
+ lost
+ - XFormsMultipart: a part other than the start part now gets its
+ temporary file and the NUL strip of RT#123615 like any upload; it used
+ to be returned by upload without a tempname, its data dropped
+ - parse_header: a continuation line at the start of a part's header
+ block is dropped instead of dying, and a line that is no header field
+ is dropped instead of being stored under a made-up field name
+ - add: the caller's buffer is no longer modified in place when it
+ exceeds the Content-Length, so a read-only value is accepted
+ - Docs: every method of the parser classes is described, add and
+ length say what they return; the README lists every limit,
+ $basename_regexp and all runtime prerequisites
+ - File::Spec is declared as a prerequisite
+
1.24 2026-10-26 18:28:01+01:00 Europe/Berlin
- SECURITY, CVE-2026-116131: urlencoded bodies are limited to
$HTTP::Body::UrlEncoded::max_params fields and multipart bodies to
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/MANIFEST new/HTTP-Body-1.25/MANIFEST
--- old/HTTP-Body-1.24/MANIFEST 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/MANIFEST 2026-11-05 18:47:11.000000000 +0100
@@ -33,6 +33,13 @@
t/18chunked-size-line.t
t/19chunked-split.t
t/20temp-write-and-filename.t
+t/21filename-suffix-redos.t
+t/22chunked-malformed.t
+t/23xforms-attachment.t
+t/24part-header-lines.t
+t/25add-keeps-argument.t
+t/26filename-suffix-string-search.t
+t/27chunked-trailer.t
t/data/multipart/001-content.dat
t/data/multipart/001-headers.pml
t/data/multipart/001-results.pml
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/META.json new/HTTP-Body-1.25/META.json
--- old/HTTP-Body-1.24/META.json 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/META.json 2026-11-05 18:47:11.000000000 +0100
@@ -25,6 +25,7 @@
"runtime" : {
"requires" : {
"Carp" : "0",
+ "File::Spec" : "0",
"File::Temp" : "0.14",
"HTTP::Message" : "0",
"IO::File" : "1.14"
@@ -53,7 +54,7 @@
"web" : "https://github.com/libwww-perl/HTTP-Body";
}
},
- "version" : "1.24",
+ "version" : "1.25",
"x_generated_by_perl" : "v5.40.1",
"x_serialization_backend" : "Cpanel::JSON::XS version 4.53",
"x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/META.yml new/HTTP-Body-1.25/META.yml
--- old/HTTP-Body-1.24/META.yml 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/META.yml 2026-11-05 18:47:11.000000000 +0100
@@ -23,6 +23,7 @@
name: HTTP-Body
requires:
Carp: '0'
+ File::Spec: '0'
File::Temp: '0.14'
HTTP::Message: '0'
IO::File: '1.14'
@@ -30,7 +31,7 @@
bugtracker: https://github.com/libwww-perl/HTTP-Body/issues
homepage: https://metacpan.org/release/HTTP-Body
repository: https://github.com/libwww-perl/HTTP-Body.git
-version: '1.24'
+version: '1.25'
x_generated_by_perl: v5.40.1
x_serialization_backend: 'YAML::Tiny version 1.76'
x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/Makefile.PL
new/HTTP-Body-1.25/Makefile.PL
--- old/HTTP-Body-1.24/Makefile.PL 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/Makefile.PL 2026-11-05 18:47:11.000000000 +0100
@@ -17,6 +17,7 @@
"NAME" => "HTTP::Body",
"PREREQ_PM" => {
"Carp" => 0,
+ "File::Spec" => 0,
"File::Temp" => "0.14",
"HTTP::Message" => 0,
"IO::File" => "1.14"
@@ -29,7 +30,7 @@
"Test::Deep" => 0,
"Test::More" => "0.86"
},
- "VERSION" => "1.24",
+ "VERSION" => "1.25",
"test" => {
"TESTS" => "t/*.t"
}
@@ -40,6 +41,7 @@
"Carp" => 0,
"Digest::MD5" => 0,
"Encode" => 0,
+ "File::Spec" => 0,
"File::Spec::Functions" => 0,
"File::Temp" => "0.14",
"HTTP::Message" => 0,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/README new/HTTP-Body-1.25/README
--- old/HTTP-Body-1.24/README 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/README 2026-11-05 18:47:11.000000000 +0100
@@ -1,5 +1,5 @@
This archive contains the distribution HTTP-Body,
-version 1.24:
+version 1.25:
HTTP Body Parser
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/README.md new/HTTP-Body-1.25/README.md
--- old/HTTP-Body-1.24/README.md 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/README.md 2026-11-05 18:47:11.000000000 +0100
@@ -54,11 +54,13 @@
### Dependencies
-- [HTTP::Headers](https://metacpan.org/pod/HTTP::Headers)
-- [HTTP::Message](https://metacpan.org/pod/HTTP::Message)
+- [HTTP::Message](https://metacpan.org/pod/HTTP::Message) (includes
[HTTP::Headers](https://metacpan.org/pod/HTTP::Headers))
- [File::Temp](https://metacpan.org/pod/File::Temp) (>= 0.14)
- [IO::File](https://metacpan.org/pod/IO::File) (>= 1.14)
-- [Digest::MD5](https://metacpan.org/pod/Digest::MD5)
+- [File::Spec](https://metacpan.org/pod/File::Spec)
+- [Carp](https://metacpan.org/pod/Carp)
+
+All but HTTP::Message ship with Perl itself.
## Synopsis
@@ -142,6 +144,11 @@
| `$HTTP::Body::UrlEncoded::max_params` | 1000 | fields in a urlencoded body |
| `$HTTP::Body::MultiPart::max_header_size` | 32768 | bytes in a part's header
block |
| `$HTTP::Body::MultiPart::max_header_lines` | 100 | lines in a part's header
block |
+| `$HTTP::Body::max_chunk_line_size` | 1024 | bytes in a chunk-size line of a
chunked body |
+| `$HTTP::Body::max_trailer_size` | 32768 | bytes in the trailer of a chunked
body |
+| `$HTTP::Body::max_trailer_lines` | 100 | header lines in the trailer of a
chunked body |
+
+A chunked body with malformed framing (a line that is no chunk-size line, a
size that does not fit an integer, chunk data not followed by CRLF) makes
`add()` croak as well.
## Configuring Upload Temporary Files
@@ -151,6 +158,10 @@
# Keep the uploaded file's own extension (behavior before 1.23)
$HTTP::Body::MultiPart::file_temp_suffix = undef;
+# How that extension is taken from the filename (only used when
+# file_temp_suffix is undef; matched against the last 255 bytes)
+$HTTP::Body::MultiPart::basename_regexp = qr/(\.\w+)$/;
+
# Custom File::Temp template
$HTTP::Body::MultiPart::file_temp_template = 'uploadXXXXXX';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/dist.ini new/HTTP-Body-1.25/dist.ini
--- old/HTTP-Body-1.24/dist.ini 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/dist.ini 2026-11-05 18:47:11.000000000 +0100
@@ -17,6 +17,7 @@
[Prereqs]
Carp = 0
+File::Spec = 0
File::Temp = 0.14
HTTP::Message = 0
IO::File = 1.14
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/lib/HTTP/Body/MultiPart.pm
new/HTTP-Body-1.25/lib/HTTP/Body/MultiPart.pm
--- old/HTTP-Body-1.24/lib/HTTP/Body/MultiPart.pm 2026-10-26
18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/lib/HTTP/Body/MultiPart.pm 2026-11-05
18:47:11.000000000 +0100
@@ -1,5 +1,5 @@
package HTTP::Body::MultiPart;
-$HTTP::Body::MultiPart::VERSION = '1.24';
+$HTTP::Body::MultiPart::VERSION = '1.25';
use strict;
use base 'HTTP::Body';
use bytes;
@@ -18,7 +18,16 @@
=head1 DESCRIPTION
-HTTP Body Multipart Parser.
+HTTP Body Multipart Parser for multipart/form-data bodies.
+
+A part with a non-empty filename in its Content-Disposition is an upload: its
+data is written to a temporary file as it arrives, and the part is stored with
+L<HTTP::Body/upload> once it is complete. Every other part is stored with
+L<HTTP::Body/param> and L<HTTP::Body/part_data>, except a part with an empty
+filename (a file field left empty), which is dropped.
+
+See L<HTTP::Body/Limits> for the limits on parts and their headers, and
+L<HTTP::Body/CONFIGURING UPLOAD TEMPORARY FILES> for the temporary files.
=head1 METHODS
@@ -26,6 +35,9 @@
=item init
+Takes the boundary from the content type, croaking if it has none, and starts
+the parser in the preamble state.
+
=cut
sub init {
@@ -44,6 +56,10 @@
=item spin
+Runs the parse method of the current state (parse_preamble, parse_boundary,
+parse_header or parse_body) until one of them needs more data or the body is
+done.
+
=cut
sub spin {
@@ -64,6 +80,8 @@
=item boundary
+The boundary parameter of the content type.
+
=cut
sub boundary {
@@ -72,6 +90,8 @@
=item boundary_begin
+C<--> followed by the boundary.
+
=cut
sub boundary_begin {
@@ -80,6 +100,8 @@
=item boundary_end
+boundary_begin followed by C<-->.
+
=cut
sub boundary_end {
@@ -88,6 +110,8 @@
=item crlf
+The line ending of a multipart body, C<"\x0D\x0A">.
+
=cut
sub crlf () {
@@ -96,6 +120,8 @@
=item delimiter_begin
+crlf followed by boundary_begin: the delimiter that ends the data of a part.
+
=cut
sub delimiter_begin {
@@ -105,6 +131,8 @@
=item delimiter_end
+crlf followed by boundary_end: the close delimiter that ends the body.
+
=cut
sub delimiter_end {
@@ -114,6 +142,10 @@
=item parse_preamble
+Drops the preamble before the first boundary and moves on to the boundary
+state. Until the boundary is found, only as many bytes are kept as could be
+its start.
+
=cut
sub parse_preamble {
@@ -138,6 +170,11 @@
=item parse_boundary
+Reads a delimiter line. A delimiter starts the next part and the header
+state; a close delimiter ends the body, and whatever follows it (padding, an
+epilogue) is ignored. Croaks on a line that is neither, and when the body has
+more than C<$HTTP::Body::MultiPart::max_parts> parts.
+
=cut
our $max_parts = 1000;
@@ -182,6 +219,13 @@
=item parse_header
+Reads a part's header block, up to the blank line, into C<< $part->{headers}
>>,
+keyed by field name with the first letter of each word upper-cased; a field
+that occurs more than once gets an array reference. A continuation line is
+joined to the line before it, and a line that is no header field is dropped.
+Croaks when the block exceeds C<$HTTP::Body::MultiPart::max_header_size> bytes
+or C<$HTTP::Body::MultiPart::max_header_lines> lines.
+
=cut
our $max_header_size = 32 * 1024;
@@ -214,7 +258,8 @@
my @headers;
for ( split /$crlf/, $header ) {
if (s/^[ \t]+//) {
- $headers[-1] .= $_;
+ # a continuation line; with no line to continue it is dropped
+ $headers[-1] .= $_ if @headers;
}
else {
push @headers, $_;
@@ -225,7 +270,9 @@
for my $header (@headers) {
- $header =~ s/^($token):[\t ]*//;
+ # A line that is no header field is dropped: without a match $1 would
+ # still hold whatever the last successful match captured.
+ next unless $header =~ s/^($token):[\t ]*//;
( my $field = $1 ) =~ s/\b(\w)/uc($1)/eg;
@@ -247,6 +294,11 @@
=item parse_body
+Passes a part's data on to handler as it arrives, holding back only as many
+bytes as could be the start of the next delimiter. At the delimiter it sets
+C<< $part->{done} >>, calls handler a last time and moves on to the boundary
+state.
+
=cut
sub parse_body {
@@ -285,9 +337,20 @@
=item handler
+Called by parse_body with the part each time data arrives. On the first call
+it takes the part's name and filename from its Content-Disposition, unless a
+subclass has named the part already, and strips any NUL from the filename. A
+part with a non-empty filename gets a temporary file, and its data is written
+there as it arrives. Once the part is done it is stored as described under
+L</DESCRIPTION>. Croaks when the temporary file can not be written.
+
=cut
-our $basename_regexp = qr/[^.]+(\.[^\\\/]+)$/;
+# The default is also kept here: while $basename_regexp still holds it, the
+# suffix is found by _default_suffix, a string search with the same result.
+my $default_basename_regexp = qr/[^.]+(\.[^\\\/]+)$/;
+
+our $basename_regexp = $default_basename_regexp;
our $file_temp_suffix = '.upload';
our $file_temp_template;
our %file_temp_parameters;
@@ -302,28 +365,46 @@
my ($filename) = $disposition =~ / filename="?([^\"]*)"?/;
# Need to match empty filenames above, so this part is flagged as an
upload type
+ $part->{name} = $name;
+ $part->{filename} = $filename if defined $filename;
+ }
+
+ # A file part gets its temporary file on the first call, also when a
+ # subclass has named the part and set its filename itself.
+ if ( defined $part->{filename} && !exists $part->{tempname} ) {
+
# A NUL in the filename truncates the path for anything downstream that
# hands it to the C layer, so strip it before the name is used or
stored.
- $filename =~ s/\0//g if defined $filename;
-
- $part->{name} = $name;
+ $part->{filename} =~ s/\0//g;
- if ( defined $filename ) {
- $part->{filename} = $filename;
+ if ( $part->{filename} ne "" ) {
+ my $suffix = $file_temp_suffix;
- if ( $filename ne "" ) {
- my $basename = (File::Spec->splitpath($filename))[2];
- my $suffix = $basename =~ $basename_regexp ? $1 : q{};
+ unless ($suffix) {
+ my $basename = (File::Spec->splitpath($part->{filename}))[2];
- 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,
- );
+ # A suffix can be no longer than a file name, so only the end
+ # of a long basename is looked at. On the whole of a hostile
+ # one a regexp like the default backtracks in time quadratic
+ # in its length: seconds per part, once for every part.
+ $basename = substr( $basename, -255 ) if length($basename) >
255;
- $part->{fh} = $fh;
- $part->{tempname} = $fh->filename;
+ if ( ref $basename_regexp && $basename_regexp ==
$default_basename_regexp ) {
+ $suffix = _default_suffix($basename);
+ }
+ else {
+ $suffix = $basename =~ $basename_regexp ? $1 : q{};
+ }
}
+
+ my $fh = File::Temp->new(
+ UNLINK => 0, DIR => $self->tmpdir, SUFFIX => $suffix,
+ ( $file_temp_template ? ( TEMPLATE => $file_temp_template ) :
() ),
+ %file_temp_parameters,
+ );
+
+ $part->{fh} = $fh;
+ $part->{tempname} = $fh->filename;
}
}
@@ -356,6 +437,27 @@
}
}
+# The suffix the default $basename_regexp captures, found without a regexp,
+# in time linear in the basename's length. It starts at the first dot after
+# the last slash or backslash that follows a byte other than a dot, and runs
+# to the end; a dot that is the last byte gives no suffix.
+sub _default_suffix {
+ my ($basename) = @_;
+
+ my $last = length($basename) - 1;
+ my $dot = rindex( $basename, '/' );
+ my $back = rindex( $basename, '\\' );
+ $dot = $back if $back > $dot;
+
+ while ( ( $dot = index( $basename, '.', $dot + 1 ) ) >= 0 ) {
+ return q{} if $dot == $last;
+ return substr( $basename, $dot )
+ if $dot > 0 && substr( $basename, $dot - 1, 1 ) ne '.';
+ }
+
+ return q{};
+}
+
=back
=head1 SUPPORT
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/lib/HTTP/Body/OctetStream.pm
new/HTTP-Body-1.25/lib/HTTP/Body/OctetStream.pm
--- old/HTTP-Body-1.24/lib/HTTP/Body/OctetStream.pm 2026-10-26
18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/lib/HTTP/Body/OctetStream.pm 2026-11-05
18:47:11.000000000 +0100
@@ -1,5 +1,5 @@
package HTTP::Body::OctetStream;
-$HTTP::Body::OctetStream::VERSION = '1.24';
+$HTTP::Body::OctetStream::VERSION = '1.25';
use strict;
use base 'HTTP::Body';
use bytes;
@@ -16,7 +16,9 @@
=head1 DESCRIPTION
-HTTP Body OctetStream Parser.
+HTTP Body OctetStream Parser. It stores the body unparsed in a temporary
+file, for application/octet-stream, application/json and any content type
+HTTP::Body has no other parser for.
=head1 METHODS
@@ -24,6 +26,11 @@
=item spin
+Writes the data that has arrived to a temporary file in
+L<tmpdir|HTTP::Body/tmpdir>, which is the L<body|HTTP::Body/body>. Once the
+whole body is there, it seeks the file back to its start and sets the state to
+done. Croaks when the file can not be written.
+
=cut
sub spin {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/lib/HTTP/Body/UrlEncoded.pm
new/HTTP-Body-1.25/lib/HTTP/Body/UrlEncoded.pm
--- old/HTTP-Body-1.24/lib/HTTP/Body/UrlEncoded.pm 2026-10-26
18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/lib/HTTP/Body/UrlEncoded.pm 2026-11-05
18:47:11.000000000 +0100
@@ -1,5 +1,5 @@
package HTTP::Body::UrlEncoded;
-$HTTP::Body::UrlEncoded::VERSION = '1.24';
+$HTTP::Body::UrlEncoded::VERSION = '1.25';
use strict;
use base 'HTTP::Body';
use bytes;
@@ -25,7 +25,7 @@
=head1 DESCRIPTION
-HTTP Body UrlEncoded Parser.
+HTTP Body UrlEncoded Parser for application/x-www-form-urlencoded bodies.
=head1 METHODS
@@ -33,6 +33,12 @@
=item spin
+Waits until the whole body has arrived, then splits it into fields on C<&>
+and C<;>, decodes C<+> and percent escapes in names and values, and stores
+each field with L<HTTP::Body/param>. A field without C<=> is dropped. Croaks
+when the body has more than C<$HTTP::Body::UrlEncoded::max_params> fields (see
+L<HTTP::Body/Limits>).
+
=cut
sub spin {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/lib/HTTP/Body/XForms.pm
new/HTTP-Body-1.25/lib/HTTP/Body/XForms.pm
--- old/HTTP-Body-1.24/lib/HTTP/Body/XForms.pm 2026-10-26 18:28:04.000000000
+0100
+++ new/HTTP-Body-1.25/lib/HTTP/Body/XForms.pm 2026-11-05 18:47:11.000000000
+0100
@@ -1,5 +1,5 @@
package HTTP::Body::XForms;
-$HTTP::Body::XForms::VERSION = '1.24';
+$HTTP::Body::XForms::VERSION = '1.25';
use strict;
use base 'HTTP::Body';
use bytes;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/lib/HTTP/Body/XFormsMultipart.pm
new/HTTP-Body-1.25/lib/HTTP/Body/XFormsMultipart.pm
--- old/HTTP-Body-1.24/lib/HTTP/Body/XFormsMultipart.pm 2026-10-26
18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/lib/HTTP/Body/XFormsMultipart.pm 2026-11-05
18:47:11.000000000 +0100
@@ -1,5 +1,5 @@
package HTTP::Body::XFormsMultipart;
-$HTTP::Body::XFormsMultipart::VERSION = '1.24';
+$HTTP::Body::XFormsMultipart::VERSION = '1.25';
use strict;
use base 'HTTP::Body::MultiPart';
use bytes;
@@ -13,7 +13,7 @@
=head1 SYNOPSIS
- use HTTP::Body::XForms;
+ use HTTP::Body::XFormsMultipart;
=head1 DESCRIPTION
@@ -24,6 +24,10 @@
in the content-type. The XML content is stored unparsed on the
parameter XForms:Model.
+Every other part is an upload named after its Content-ID: its data is
+written to a temporary file like that of any multipart upload, and a NUL
+in the Content-ID is stripped.
+
=head1 METHODS
=over 4
@@ -60,8 +64,9 @@
=item handler
-This function is overridden to differ the start part, which should be
-set as the XForms:Model param if its content type is application/xml.
+This function is overridden to name the parts by their Content-ID: the
+start part becomes the XForms:Model param, and its data the body; every
+other part becomes an upload, as described above.
=cut
@@ -71,7 +76,9 @@
my $contentid = $part->{headers}{'Content-ID'};
$contentid =~ s/^.*[\<\"]//;
$contentid =~ s/[\>\"].*$//;
-
+ # It names the part and its file: a NUL would truncate that downstream.
+ $contentid =~ s/\0//g;
+
if ( $contentid eq $self->start ) {
$part->{name} = 'XForms:Model';
if ($part->{done}) {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/lib/HTTP/Body.pm
new/HTTP-Body-1.25/lib/HTTP/Body.pm
--- old/HTTP-Body-1.24/lib/HTTP/Body.pm 2026-10-26 18:28:04.000000000 +0100
+++ new/HTTP-Body-1.25/lib/HTTP/Body.pm 2026-11-05 18:47:11.000000000 +0100
@@ -1,5 +1,5 @@
package HTTP::Body;
-$HTTP::Body::VERSION = '1.24';
+$HTTP::Body::VERSION = '1.25';
use strict;
use Carp qw[ ];
@@ -29,13 +29,13 @@
=head1 SYNOPSIS
use HTTP::Body;
-
+
sub handler : method {
my ( $class, $r ) = @_;
my $content_type = $r->headers_in->get('Content-Type');
my $content_length = $r->headers_in->get('Content-Length');
-
+
my $body = HTTP::Body->new( $content_type, $content_length );
my $length = $content_length;
@@ -44,21 +44,23 @@
$r->read( my $buffer, ( $length < 8192 ) ? $length : 8192 );
$length -= length($buffer);
-
+
$body->add($buffer);
}
-
- my $uploads = $body->upload; # hashref
- my $params = $body->param; # hashref
- my $param_order = $body->param_order # arrayref
- my $body = $body->body; # IO::Handle
+
+ my $uploads = $body->upload; # hashref
+ my $params = $body->param; # hashref
+ my $param_order = $body->param_order; # arrayref
+ my $raw = $body->body; # IO::Handle
}
=head1 DESCRIPTION
HTTP::Body parses chunks of HTTP POST data and supports
application/octet-stream, application/json, application/x-www-form-urlencoded,
-and multipart/form-data.
+multipart/form-data, and XForms submissions (multipart/related and
+application/xml). A body of any other content type is handled like
+application/octet-stream.
Chunked bodies are supported by not passing a length value to new().
@@ -96,6 +98,21 @@
The largest header block a multipart part may have, in bytes and in lines; a
larger one makes add croak. The defaults are 32768 and 100.
+=item $HTTP::Body::max_chunk_line_size
+
+The largest chunk-size line (size, extensions and CRLF) of a chunked body, in
+bytes; a longer one makes add croak. The default is 1024. A chunked body
+whose framing is malformed (a line that is no chunk-size line, a size that does
+not fit an integer, chunk data not followed by CRLF) makes add croak as well.
+
+=item $HTTP::Body::max_trailer_size
+
+=item $HTTP::Body::max_trailer_lines
+
+The largest trailer of a chunked body (its header lines and the blank line
+that ends it), in bytes, and the most header lines it may have; a larger one
+makes add croak. The defaults are 32768 and 100.
+
=back
=head1 METHODS
@@ -132,6 +149,11 @@
cleanup => 0,
buffer => '',
chunk_buffer => '',
+ chunk_remaining => 0,
+ chunk_crlf => 0,
+ chunk_eof => 0,
+ chunk_trailer => undef,
+ chunk_trailer_lines => 0,
body => undef,
chunked => !defined $content_length,
content_length => defined $content_length ? $content_length : -1,
@@ -179,95 +201,169 @@
=item add
-Add string to internal buffer. Will call spin unless done. returns
-length before adding self.
+Feeds the next piece of the body to the parser, which parses as much of it as
+it can unless it is done already. Data beyond the content length is ignored.
+
+With a content length, add returns the number of bytes still expected as a
+negative number, and 0 once the body is complete. For a chunked body it
+returns nothing.
+
+add croaks when one of the limits under L</Limits> is exceeded, and when the
+framing of a chunked body is malformed.
=cut
-# chunk-size [ chunk-ext ] CRLF. The atomic group keeps the size digits from
-# backtracking into the rest of the line, which took quadratic time on a line
-# that does not end in CRLF.
-my $chunk_size_line = qr/^(?>([\da-fA-F]+))[^\n]*\x0D\x0A/;
+# chunk-size [ chunk-ext ] CRLF, matched against one line at a time. The
+# atomic group keeps the size digits from backtracking into the rest of the
+# line, and the line length limit bounds what the rest can cost.
+my $chunk_size_line = qr/^(?>([\da-fA-F]+))[^\n]*\x0D\x0A\z/;
+
+our $max_chunk_line_size = 1024;
+our $max_trailer_size = 32 * 1024;
+our $max_trailer_lines = 100;
sub add {
my $self = shift;
if ( $self->{chunked} ) {
- $self->{chunk_buffer} .= $_[0];
- # Stop once the zero-length chunk has ended the chunked stream: any
- # trailing bytes (e.g. trailing headers) must not be reparsed as
- # further chunks. This is separate from the body parser's own state,
- # which for multipart reaches 'done' at the closing boundary, before
- # the zero chunk that records the final content length.
- while ( !$self->{chunk_eof}
- && $self->{chunk_buffer} =~ $chunk_size_line ) {
- my $chunk_len = hex($1);
- # Length of the chunk-size line itself; the pattern is anchored at
^.
- my $header_len = $+[0];
+ # Nothing after the blank line that ends the trailer belongs to the
+ # body: it must neither be reparsed nor pile up in the buffer.
+ return if $self->{chunk_eof};
+
+ $self->{chunk_buffer} .= $_[0] if defined $_[0];
+
+ while ( !$self->{chunk_eof} ) {
+
+ # Inside a chunk: pass its data on as it arrives, so that a chunk
+ # never needs as much memory as it is long.
+ if ( $self->{chunk_remaining} ) {
+ my $take = length $self->{chunk_buffer};
+ $take = $self->{chunk_remaining} if $take >
$self->{chunk_remaining};
+
+ # wait for more calls to add()
+ return unless $take;
+
+ my $data = substr( $self->{chunk_buffer}, 0, $take, '' );
+ $self->{chunk_remaining} -= $take;
+ $self->{length} += $take;
+
+ # Once the body parser is done (multipart is, at its close
+ # delimiter) the rest of the body is consumed but not kept.
+ unless ( $self->{state} eq 'done' ) {
+ $self->{buffer} .= $data;
+ $self->spin;
+ }
+
+ next;
+ }
+
+ # The CRLF that ends the data of the chunk just read.
+ if ( $self->{chunk_crlf} ) {
+ return if length( $self->{chunk_buffer} ) < 2;
- if ( $chunk_len == 0 ) {
- # Strip chunk len
- substr( $self->{chunk_buffer}, 0, $header_len, '' );
+ unless ( substr( $self->{chunk_buffer}, 0, 2, '' ) eq
"\x0D\x0A" ) {
+ Carp::croak('Chunk data not followed by CRLF');
+ }
+
+ $self->{chunk_crlf} = 0;
+ }
+
+ # After the last chunk: the trailer, header lines up to a blank
+ # line that ends the body. It is collected until then.
+ if ( defined $self->{chunk_trailer} ) {
+ my $line = $self->_chunk_line(
+ $max_trailer_size ? $max_trailer_size - length
$self->{chunk_trailer} : undef,
+ "Chunked body trailer exceeds $max_trailer_size bytes",
+ );
- # End of data, there may be trailing headers
- if ( my ($headers) = $self->{chunk_buffer} =~
m/(.*)\x0D\x0A/s ) {
- if ( my $message = HTTP::Message->parse( $headers ) ) {
+ # wait for the rest of the line
+ return unless defined $line;
+
+ if ( $line =~ /^\x0D?\x0A\z/ ) {
+ if ( my $message = HTTP::Message->parse(
$self->{chunk_trailer} ) ) {
$self->{trailing_headers} = $message->headers;
}
+
+ $self->{chunk_buffer} = '';
+ $self->{chunk_trailer} = undef;
+ $self->{chunk_eof} = 1;
+
+ return;
}
- $self->{chunk_buffer} = '';
- $self->{chunk_eof} = 1;
+ # HTTP::Headers takes time quadratic in the number of fields
+ # of one name, so the number of lines is limited as well.
+ if ( $max_trailer_lines && ++$self->{chunk_trailer_lines} >
$max_trailer_lines ) {
+ Carp::croak("Chunked body trailer exceeds
$max_trailer_lines lines");
+ }
- # Set content_length equal to the amount of data we read,
- # so the spin methods can finish up.
- $self->{content_length} = $self->{length};
+ $self->{chunk_trailer} .= $line;
+
+ # trailing_headers parses the trailer again when asked
+ delete $self->{trailing_headers};
+
+ next;
}
- else {
- # Make sure we have the whole chunk body plus its trailing CRLF
- # beyond the chunk-size line before we consume it. The old test
- # measured the whole buffer, size line included, so a read that
- # split a chunk left the parser taking it short and reparsing
the
- # leftover bytes as the next chunk-size line (never
completing).
- if ( length( $self->{chunk_buffer} ) >= $header_len +
$chunk_len + 2 ) {
- # Strip chunk len
- substr( $self->{chunk_buffer}, 0, $header_len, '' );
- # Pull chunk data out of chunk buffer into real buffer
- $self->{buffer} .= substr $self->{chunk_buffer}, 0,
$chunk_len, '';
+ # A chunk-size line.
+ my $line = $self->_chunk_line(
+ $max_chunk_line_size || undef,
+ "Chunk size line exceeds $max_chunk_line_size bytes",
+ );
- # Strip remaining CRLF
- $self->{chunk_buffer} =~ s/^\x0D\x0A//;
+ # wait for the rest of the line
+ return unless defined $line;
- $self->{length} += $chunk_len;
- }
- else {
- # Not enough data for this chunk, wait for more calls to
add()
- return;
- }
+ unless ( $line =~ $chunk_size_line ) {
+ Carp::croak('Invalid chunk size line');
+ }
+
+ # hex() of a size that does not fit an integer warns and returns a
+ # float, which no buffer length would ever reach.
+ ( my $digits = $1 ) =~ s/^0+//;
+ if ( length($digits) > 15 ) {
+ Carp::croak('Chunk size too large');
}
-
- unless ( $self->{state} eq 'done' ) {
- $self->spin;
+
+ my $chunk_len = hex($digits);
+
+ if ( $chunk_len == 0 ) {
+ # End of data: set content_length equal to the amount of data
+ # we read, so the spin methods can finish up.
+ $self->{content_length} = $self->{length};
+
+ unless ( $self->{state} eq 'done' ) {
+ $self->spin;
+ }
+
+ # The trailer follows, up to a blank line.
+ $self->{chunk_trailer} = '';
+
+ next;
}
+
+ $self->{chunk_remaining} = $chunk_len;
+ $self->{chunk_crlf} = 1;
}
-
+
return;
}
my $cl = $self->content_length;
if ( defined $_[0] ) {
- $self->{length} += length( $_[0] );
-
+ # A copy: the caller's buffer is left alone, and may be read-only.
+ my $data = $_[0];
+ $self->{length} += length($data);
+
# Don't allow buffer data to exceed content-length
if ( $self->{length} > $cl ) {
- $_[0] = substr $_[0], 0, $cl - $self->{length};
+ $data = substr $data, 0, $cl - $self->{length};
$self->{length} = $cl;
}
-
- $self->{buffer} .= $_[0];
+
+ $self->{buffer} .= $data;
}
unless ( $self->state eq 'done' ) {
@@ -277,6 +373,23 @@
return ( $self->length - $cl );
}
+# Takes the next line, LF included, off the chunk buffer, or returns nothing
+# while it is incomplete. Its length is checked before it is complete, so
+# that an endless line can not grow the buffer: longer than $room bytes, it
+# croaks with $error. An undefined $room is no limit.
+sub _chunk_line {
+ my ( $self, $room, $error ) = @_;
+
+ my $eol = index( $self->{chunk_buffer}, "\x0A" );
+ my $line_len = $eol >= 0 ? $eol + 1 : length $self->{chunk_buffer};
+
+ Carp::croak($error) if defined $room && $line_len > $room;
+
+ return if $eol < 0;
+
+ return substr( $self->{chunk_buffer}, 0, $line_len, '' );
+}
+
=item body
accessor for the body.
@@ -344,9 +457,8 @@
=item length
-Returns the total length of data we expect to read if known.
-In the case of a chunked request, returns the amount of data
-read so far.
+Returns the number of bytes of the body read so far, up to the content length.
+Of a chunked body only the chunk data counts.
=cut
@@ -357,12 +469,30 @@
=item trailing_headers
If a chunked request body had trailing headers, trailing_headers will
-return an HTTP::Headers object populated with those headers.
+return an HTTP::Headers object populated with those headers. The trailer is
+read up to the blank line that ends it, also when it arrives in later calls to
+add than the last, zero-size chunk; until then, trailing_headers returns the
+header lines that have arrived so far. The body itself is done at the last
+chunk.
=cut
sub trailing_headers {
- return shift->{trailing_headers};
+ my $self = shift;
+
+ # A trailer still being read gives the lines that have arrived of it, as
+ # some clients never send its blank line. It is parsed when asked for,
+ # not again for every line that arrives.
+ if ( !$self->{trailing_headers}
+ && defined $self->{chunk_trailer}
+ && length $self->{chunk_trailer} )
+ {
+ if ( my $message = HTTP::Message->parse( $self->{chunk_trailer} ) ) {
+ $self->{trailing_headers} = $message->headers;
+ }
+ }
+
+ return $self->{trailing_headers};
}
=item spin
@@ -523,7 +653,10 @@
=item $HTTP::Body::MultiPart::basename_regexp
The regexp used to work out the uploaded file's extension. It only matters
-when C<file_temp_suffix> is undefined.
+when C<file_temp_suffix> is undefined, and is matched against the last 255
+bytes of the uploaded file's basename, which is as long as a suffix can be.
+The default, C<qr/[^.]+(\.[^\\\/]+)$/>, is not run as a regexp: as long as the
+variable still holds it, a string search with the same result is used.
=item $HTTP::Body::MultiPart::file_temp_template
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/18chunked-size-line.t
new/HTTP-Body-1.25/t/18chunked-size-line.t
--- old/HTTP-Body-1.24/t/18chunked-size-line.t 2026-10-26 18:28:04.000000000
+0100
+++ new/HTTP-Body-1.25/t/18chunked-size-line.t 2026-11-05 18:47:11.000000000
+0100
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More tests => 5;
use HTTP::Body;
use Time::HiRes qw/ time /;
@@ -20,8 +20,17 @@
{
# A size line whose first LF has no CR before it never matches; the
# old pattern backtracked over it in time quadratic in its length.
+ # Without the line length limit the line reaches the pattern whole.
+ local $HTTP::Body::max_chunk_line_size = 0;
my $body = HTTP::Body->new( $ct, undef );
my $t = time;
- $body->add( ( '1' x 100_000 ) . "\n\r\n" );
+ eval { $body->add( ( '1' x 100_000 ) . "\n\r\n" ) };
cmp_ok( time - $t, '<', 5, 'unterminated chunk size line is rejected in
linear time' );
+ like( $@, qr/Invalid chunk size line/, '... and refused' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ eval { $body->add( ( '1' x 100_000 ) . "\n\r\n" ) };
+ like( $@, qr/Chunk size line exceeds/, 'with the limit it is refused by
its length alone' );
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/21filename-suffix-redos.t
new/HTTP-Body-1.25/t/21filename-suffix-redos.t
--- old/HTTP-Body-1.24/t/21filename-suffix-redos.t 1970-01-01
01:00:00.000000000 +0100
+++ new/HTTP-Body-1.25/t/21filename-suffix-redos.t 2026-11-05
18:47:11.000000000 +0100
@@ -0,0 +1,51 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+use HTTP::Body;
+use File::Temp qw/ tempdir /;
+use Time::HiRes qw/ time /;
+
+my $ct = 'multipart/form-data; boundary=x';
+
+# A filename of many dots that ends in a backslash made the default
+# $basename_regexp backtrack in time quadratic in the filename's length:
+# about 7 seconds for a part whose header block fills the 32 KiB limit,
+# and that once per part, up to $max_parts times per body.
+my $hostile = ( 'a.' x 16000 ) . 'a\\';
+my $part = qq{--x\r\nContent-Disposition: form-data; name="f";
filename="$hostile"\r\n\r\nD\r\n};
+
+sub parse {
+ my $raw = shift;
+ my $body = HTTP::Body->new( $ct, length $raw );
+ $body->tmpdir( tempdir( CLEANUP => 1 ) );
+ $body->cleanup(1);
+ $body->add($raw);
+ return $body;
+}
+
+{
+ my $t = time;
+ my $body = parse( ( $part x 2 ) . "--x--\r\n" );
+ cmp_ok( time - $t, '<', 5, 'hostile filename is handled in linear time
with the fixed suffix' );
+ is( $body->state, 'done', 'body with hostile filenames is parsed' );
+}
+
+{
+ local $HTTP::Body::MultiPart::file_temp_suffix = undef;
+ my $t = time;
+ my $body = parse( ( $part x 2 ) . "--x--\r\n" );
+ cmp_ok( time - $t, '<', 5, 'hostile filename is handled in linear time
with the suffix taken from the filename' );
+ is( $body->state, 'done', 'body with hostile filenames is parsed in that
mode too' );
+}
+
+{
+ # The suffix is taken from the end of the filename, so a long name keeps
it.
+ local $HTTP::Body::MultiPart::file_temp_suffix = undef;
+ my $long = ( 'n' x 300 ) . '.txt';
+ my $body = parse( qq{--x\r\nContent-Disposition: form-data; name="f";
filename="$long"\r\n\r\nD\r\n--x--\r\n} );
+ like( $body->upload->{f}{tempname}, qr/\.txt$/, 'suffix of a filename
longer than 255 bytes is kept' );
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/22chunked-malformed.t
new/HTTP-Body-1.25/t/22chunked-malformed.t
--- old/HTTP-Body-1.24/t/22chunked-malformed.t 1970-01-01 01:00:00.000000000
+0100
+++ new/HTTP-Body-1.25/t/22chunked-malformed.t 2026-11-05 18:47:11.000000000
+0100
@@ -0,0 +1,76 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+use HTTP::Body;
+
+my $ct = 'application/octet-stream';
+
+# A line that is not a chunk-size line used to end the parse silently, with
+# every later add() growing the chunk buffer forever.
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ eval { $body->add("zzz\r\n") };
+ like( $@, qr/Invalid chunk size line/, 'a line that is no chunk-size line
is refused' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ eval { $body->add( '1' x 2000 ) };
+ like( $@, qr/Chunk size line exceeds/, 'an unterminated chunk-size line
over the limit is refused' );
+}
+
+{
+ local $HTTP::Body::max_chunk_line_size = 0;
+ my $body = HTTP::Body->new( $ct, undef );
+ eval { $body->add( '1' x 2000 ) };
+ is( $@, '', 'the chunk-size line limit can be disabled' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ my @warnings;
+ local $SIG{__WARN__} = sub { push @warnings, @_ };
+ eval { $body->add( ( 'F' x 40 ) . "\r\n" ) };
+ like( $@, qr/Chunk size too large/, 'a chunk size beyond the integer range
is refused' );
+ is( scalar @warnings, 0, '... without an overflow warning' );
+}
+
+# A chunk used to be held back until it had arrived completely, so a large
+# chunk needed as much memory as it was long.
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add( sprintf "%x\r\n", 1_000_000 );
+ $body->add( 'x' x 8192 ) for 1 .. 10;
+ is( $body->length, 81920, 'chunk data reaches the body before the chunk is
complete' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ eval { $body->add("5\r\nhelloXX") };
+ like( $@, qr/not followed by CRLF/, 'chunk data not followed by CRLF is
refused' );
+}
+
+# Nothing after the last chunk is kept.
+{
+ my $body = HTTP::Body->new( 'application/x-www-form-urlencoded', undef );
+ $body->add("3\r\na=b\r\n0\r\n\r\n");
+ $body->add( 'z' x 100_000 );
+ is( $body->state, 'done', 'body stays done after the last chunk' );
+ is( length $body->{chunk_buffer}, 0, 'data after the last chunk is
dropped' );
+ is_deeply( $body->param, { a => 'b' }, 'parameters are unchanged by it' );
+}
+
+# A multipart body is done at its close delimiter; later chunks are not kept.
+{
+ my $mp = qq{--x\r\nContent-Disposition: form-data;
name="a"\r\n\r\nv\r\n--x--\r\n};
+ my $body = HTTP::Body->new( 'multipart/form-data; boundary=x', undef );
+ $body->add( sprintf "%x\r\n%s\r\n", length $mp, $mp );
+ my $chunk = 'y' x 10_000;
+ $body->add( sprintf "%x\r\n%s\r\n", length $chunk, $chunk ) for 1 .. 10;
+ is( length $body->{buffer}, 0, 'chunk data after the body parser is done
is dropped' );
+ is( $body->param->{a}, 'v', 'the parsed parameter is kept' );
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/23xforms-attachment.t
new/HTTP-Body-1.25/t/23xforms-attachment.t
--- old/HTTP-Body-1.24/t/23xforms-attachment.t 1970-01-01 01:00:00.000000000
+0100
+++ new/HTTP-Body-1.25/t/23xforms-attachment.t 2026-11-05 18:47:11.000000000
+0100
@@ -0,0 +1,35 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+use HTTP::Body;
+use File::Temp qw/ tempdir /;
+
+# A multipart/related part other than the start part is an upload named after
+# its Content-ID. XFormsMultipart used to set its name before the MultiPart
+# handler ran, which skipped both the NUL strip of the filename (RT#123615)
+# and the creation of the temporary file, so the attachment was dropped.
+my $raw = qq{--x\r\nContent-ID: <model>\r\nContent-Type:
application/xml\r\n\r\n<m/>\r\n}
+ . qq{--x\r\nContent-ID: <att\0ach>\r\nContent-Type:
text/plain\r\n\r\nATTACHMENT DATA\r\n--x--\r\n};
+
+my $body = HTTP::Body->new( 'multipart/related; boundary=x; start="<model>"',
length $raw );
+$body->tmpdir( tempdir( CLEANUP => 1 ) );
+$body->cleanup(1);
+$body->add($raw);
+
+is( $body->param->{'XForms:Model'}, '<m/>', 'the start part is the model' );
+
+my ($upload) = values %{ $body->upload };
+is( $upload->{filename}, 'attach', 'NUL is stripped from the attachment
filename' );
+is( $upload->{name}, 'attach', '... and from its name' );
+ok( $upload->{tempname} && -e $upload->{tempname}, 'the attachment is written
to a temporary file' );
+
+my $data = '';
+if ( $upload->{tempname} && open my $fh, '<', $upload->{tempname} ) {
+ local $/;
+ $data = <$fh>;
+}
+is( $data, 'ATTACHMENT DATA', 'the temporary file holds the attachment data' );
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/24part-header-lines.t
new/HTTP-Body-1.25/t/24part-header-lines.t
--- old/HTTP-Body-1.24/t/24part-header-lines.t 1970-01-01 01:00:00.000000000
+0100
+++ new/HTTP-Body-1.25/t/24part-header-lines.t 2026-11-05 18:47:11.000000000
+0100
@@ -0,0 +1,34 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use HTTP::Body;
+
+my $ct = 'multipart/form-data; boundary=x';
+
+{
+ # A continuation line with no header line before it died in parse_header
+ # with "Modification of non-creatable array value attempted".
+ my $raw = qq{--x\r\n junk\r\nContent-Disposition: form-data;
name="a"\r\n\r\nv\r\n--x--\r\n};
+ my $body = HTTP::Body->new( $ct, length $raw );
+ my $ok = eval { $body->add($raw); 1 };
+ ok( $ok, 'a part header block that starts with whitespace does not die' )
or diag $@;
+ is( $body->param->{a}, 'v', '... and the part is parsed' );
+}
+
+{
+ # A line that is no header field was stored under whatever $1 was left
+ # over from the last successful match.
+ my $raw = qq{--x\r\nContent-Disposition: form-data; name="a"\r\nthis is
not a header\r\n\r\nv\r\n--x--\r\n};
+ my $body = HTTP::Body->new( $ct, length $raw );
+ $body->add($raw);
+ is( $body->param->{a}, 'v', 'a part with a line that is no header field is
parsed' );
+ is_deeply(
+ [ sort keys %{ $body->part_data->{a}{headers} } ],
+ ['Content-Disposition'],
+ 'the line is not stored under a made-up field name'
+ );
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/25add-keeps-argument.t
new/HTTP-Body-1.25/t/25add-keeps-argument.t
--- old/HTTP-Body-1.24/t/25add-keeps-argument.t 1970-01-01 01:00:00.000000000
+0100
+++ new/HTTP-Body-1.25/t/25add-keeps-argument.t 2026-11-05 18:47:11.000000000
+0100
@@ -0,0 +1,24 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use HTTP::Body;
+
+my $ct = 'application/x-www-form-urlencoded';
+
+{
+ my $body = HTTP::Body->new( $ct, 3 );
+ my $buf = 'a=b&c=d';
+ $body->add($buf);
+ is( $buf, 'a=b&c=d', "add leaves the caller's buffer alone when it exceeds
the content length" );
+ is_deeply( $body->param, { a => 'b' }, '... and keeps only the content
length' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, 3 );
+ my $ok = eval { $body->add('a=b&c=d'); 1 };
+ ok( $ok, 'add accepts a read-only value that exceeds the content length' )
or diag $@;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/26filename-suffix-string-search.t
new/HTTP-Body-1.25/t/26filename-suffix-string-search.t
--- old/HTTP-Body-1.24/t/26filename-suffix-string-search.t 1970-01-01
01:00:00.000000000 +0100
+++ new/HTTP-Body-1.25/t/26filename-suffix-string-search.t 2026-11-05
18:47:11.000000000 +0100
@@ -0,0 +1,85 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use HTTP::Body;
+use File::Temp qw/ tempdir /;
+use Time::HiRes qw/ time /;
+
+# While $basename_regexp holds its default, the suffix is found by a string
+# search instead of by running the regexp. The two must give the same
+# result for every basename.
+
+my $default = qr/[^.]+(\.[^\\\/]+)$/;
+
+sub by_regexp { $_[0] =~ $default ? $1 : q{} }
+
+sub show { my $s = shift; $s =~ s/([^\x21-\x7e])/sprintf '\\x%02x', ord $1/ge;
"'$s'" }
+
+can_ok( 'HTTP::Body::MultiPart', '_default_suffix' );
+my $suffix = \&HTTP::Body::MultiPart::_default_suffix;
+
+is( "$HTTP::Body::MultiPart::basename_regexp", "$default", 'default
$basename_regexp is unchanged' );
+
+for my $name (
+ '', '.', '..', 'x.', '.bashrc', 'noext', 'a..b', '..a.b', 'a.b.',
+ 'foo.tar.gz', 'photo.jpeg', 'dir/x.png', 'a.b/c', 'a.b\\',
+ 'C:\\dir\\x.txt', 'C:\\a.d\\bar', 'dir\\.hidden', "f.txt\n", "f.\n",
+ "\xc3\xa4rger.txt", ( 'a.' x 127 ) . "a\\",
+) {
+ is( $suffix->($name), by_regexp($name), 'suffix of ' . show($name) );
+}
+
+{
+ srand 20261027;
+ my @alpha = ( '.', '.', '.', 'a', 'b', '\\', '/', "\n", ' ', "\xff" );
+ my ( $bad, $first ) = ( 0, undef );
+ for ( 1 .. 100_000 ) {
+ my $name = join '', map { $alpha[ rand @alpha ] } 1 .. int rand 12;
+ next if $suffix->($name) eq by_regexp($name);
+ $first = $name unless defined $first;
+ $bad++;
+ }
+ is( $bad, 0, 'string search matches the regexp on 100000 random basenames'
)
+ or diag( 'first mismatch: ' . show($first) );
+}
+
+my $ct = 'multipart/form-data; boundary=x';
+
+sub upload_tempname {
+ my $filename = shift;
+ my $raw = qq{--x\r\nContent-Disposition: form-data; name="f";
filename="$filename"\r\n\r\nD\r\n--x--\r\n};
+ my $body = HTTP::Body->new( $ct, length $raw );
+ $body->tmpdir( tempdir( CLEANUP => 1 ) );
+ $body->cleanup(1);
+ $body->add($raw);
+ return $body->upload->{f}{tempname};
+}
+
+{
+ local $HTTP::Body::MultiPart::file_temp_suffix = undef;
+ like( upload_tempname('C:\\photos\\holiday.tar.gz'), qr/\.tar\.gz$/,
'default suffix of an upload comes from the string search' );
+}
+
+{
+ # A regexp of its own is still run, on the last 255 bytes of the basename.
+ local $HTTP::Body::MultiPart::file_temp_suffix = undef;
+ local $HTTP::Body::MultiPart::basename_regexp = qr/(\.[^.]+)$/;
+ like( upload_tempname('archive.tar.gz'), qr/\.gz$/, 'a custom
$basename_regexp is still used' );
+ unlike( upload_tempname('archive.tar.gz'), qr/\.tar\.gz$/, 'a custom
$basename_regexp replaces the default rule' );
+}
+
+{
+ # A copy of the default pattern is a regexp of its own and is run, so the
+ # 255-byte limit is what keeps a hostile filename cheap.
+ local $HTTP::Body::MultiPart::file_temp_suffix = undef;
+ local $HTTP::Body::MultiPart::basename_regexp = qr/[^.]+(\.[^\\\/]+)$/;
+ my $t = time;
+ upload_tempname( ( 'a.' x 16000 ) . 'a\\' ) for 1 .. 2;
+ cmp_ok( time - $t, '<', 5, 'a hostile filename stays cheap with a custom
$basename_regexp' );
+}
+
+done_testing;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/HTTP-Body-1.24/t/27chunked-trailer.t
new/HTTP-Body-1.25/t/27chunked-trailer.t
--- old/HTTP-Body-1.24/t/27chunked-trailer.t 1970-01-01 01:00:00.000000000
+0100
+++ new/HTTP-Body-1.25/t/27chunked-trailer.t 2026-11-05 18:47:11.000000000
+0100
@@ -0,0 +1,103 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+
+use HTTP::Body;
+
+my $ct = 'application/x-www-form-urlencoded';
+
+# The trailing headers, or none while there is no trailer.
+sub trailer { my $h = shift->trailing_headers; return $h ? $h :
HTTP::Headers->new }
+
+# The trailer of a chunked body used to be read only from the call to add()
+# that carried the last chunk; a trailer that arrived in a later call was lost.
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\n");
+ is( $body->state, 'done', 'the body is done at the last chunk' );
+ is_deeply( $body->param, { a => 'b' }, '... with its parameters' );
+ is( $body->trailing_headers, undef, 'no trailer before it has arrived' );
+
+ $body->add("X-Foo: bar\r\n");
+ isa_ok( $body->trailing_headers, 'HTTP::Headers', 'trailer from a later
add' );
+ is( trailer($body)->header('X-Foo'), 'bar', '... with its field' );
+
+ $body->add("X-Baz: qux\r\n\r\n");
+ is( trailer($body)->header('X-Baz'), 'qux', '... and the fields that
follow it' );
+}
+
+# Some clients never send the blank line that ends the trailer; what has
+# arrived of it is read all the same, as it was before.
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\nContent-MD5: abc\r\nX-Half");
+ is( trailer($body)->header('Content-MD5'), 'abc', 'a trailer without its
blank line' );
+ is( trailer($body)->header('X-Half'), undef, '... but not a line still
incomplete' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add($_) for split //, "3\r\na=b\r\n0\r\nX-Foo: bar\r\nX-Baz:
qux\r\n\r\n";
+ is( trailer($body)->header('X-Foo'), 'bar', 'trailer fed byte by byte' );
+ is( trailer($body)->header('X-Baz'), 'qux', '... has all its fields' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\n\r\n");
+ isa_ok( $body->trailing_headers, 'HTTP::Headers', 'an empty trailer' );
+ is( scalar trailer($body)->header_field_names, 0, '... has no fields' );
+}
+
+# The blank line ends the body: nothing after it is read as a trailer field.
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\nX-Foo: bar\r\n\r\nX-Evil: 1\r\n");
+ $body->add("X-Evil2: 1\r\n\r\n");
+ is_deeply( [ trailer($body)->header_field_names ], ['X-Foo'], 'nothing
after the trailer is read' );
+ is( length $body->{chunk_buffer}, 0, '... or kept' );
+}
+
+# The trailer is collected until its blank line, so it is limited in size.
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\n");
+ eval { $body->add( 'X-Foo: ' . ( 'b' x 991 ) . "\r\n" ) for 1 .. 40 };
+ like( $@, qr/trailer exceeds 32768 bytes/, 'a trailer over the size limit
is refused' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\n");
+ eval { $body->add( 'X' x 1000 ) for 1 .. 40 };
+ like( $@, qr/trailer exceeds 32768 bytes/, 'an unterminated trailer line
over the limit is refused' );
+}
+
+# HTTP::Headers takes time quadratic in the number of fields of one name,
+# which made a trailer of 16 KiB of "a:" lines cost seconds; and 1.24 parsed
+# whatever followed the last chunk in the same call to add().
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\n");
+ eval { $body->add("a:\r\n") for 1 .. 101 };
+ like( $@, qr/trailer exceeds 100 lines/, 'a trailer over the line limit is
refused' );
+}
+
+{
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add( "3\r\na=b\r\n0\r\n" . ( "a:\r\n" x 100 ) . "\r\n" );
+ is( scalar( () = trailer($body)->header('a') ), 100, 'a trailer at the
line limit is read' );
+}
+
+{
+ local $HTTP::Body::max_trailer_size = 0;
+ local $HTTP::Body::max_trailer_lines = 0;
+ my $body = HTTP::Body->new( $ct, undef );
+ $body->add("3\r\na=b\r\n0\r\n");
+ eval { $body->add( 'X-Foo: ' . ( 'b' x 991 ) . "\r\n" ) for 1 .. 200;
$body->add("\r\n") };
+ is( $@, '', 'the trailer limits can be disabled' );
+ is( scalar( () = trailer($body)->header('X-Foo') ), 200, '... and the
whole trailer is read' );
+}
++++++ _scmsync.obsinfo ++++++
--- /var/tmp/diff_new_pack.vvjcaQ/_old 2026-11-06 20:07:35.433416637 +0100
+++ /var/tmp/diff_new_pack.vvjcaQ/_new 2026-11-06 20:07:35.440416930 +0100
@@ -1,6 +1,6 @@
-mtime: 1793220534
-commit: 25896feeebed535d080544261f74f7f90a945129e2ec54260afdb6b45b9a870e
+mtime: 1793976378
+commit: ea4c45316973ad0657521ac1fb018f72446917a2a2378a8eebda0a961ec0fe7a
url: https://src.opensuse.org/perl/perl-HTTP-Body
-revision: 25896feeebed535d080544261f74f7f90a945129e2ec54260afdb6b45b9a870e
+revision: ea4c45316973ad0657521ac1fb018f72446917a2a2378a8eebda0a961ec0fe7a
projectscmsync: https://src.opensuse.org/perl/_ObsPrj
++++++ build.specials.obscpio ++++++
++++++ build.specials.obscpio ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/.gitignore new/.gitignore
--- old/.gitignore 1970-01-01 01:00:00.000000000 +0100
+++ new/.gitignore 2026-11-06 15:46:18.000000000 +0100
@@ -0,0 +1 @@
+.osc
