diff --git a/Changes b/Changes index 58b958b..4a2968f 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,10 @@ Change history for HTTP-Date {{$NEXT}} + - [SECURITY] Reject input longer than 64 characters in parse_date() + to prevent quadratic regex backtracking (a denial of service) on + hostile date strings. Fixes CVE-2026-14741. (Olaf Alders) + 6.07 2026-06-25 15:12:09Z - Add test with Time::Zone (GH#25) (Michal Josef Špaček) diff --git a/dist.ini b/dist.ini index ad52ee3..7847149 100644 --- a/dist.ini +++ b/dist.ini @@ -21,6 +21,11 @@ x_MailingList = mailto:libwww@perl.org perl = 5.006002 Time::Local = 1.28 +; t/redos.t uses subtest(), which needs a Test::More newer than the one +; bundled with older perls (e.g. 5.10/5.12 ship < 0.96). +[Prereqs / TestRequires] +Test::More = 0.96 + ; We run release tests in travis. but make the changes-has-content test TODO only for master. ; This will prod pull request submitters to add a Changes entry. [Test::ChangesHasContent] diff --git a/lib/HTTP/Date.pm b/lib/HTTP/Date.pm index dc4ec29..4fa4fd6 100644 --- a/lib/HTTP/Date.pm +++ b/lib/HTTP/Date.pm @@ -88,6 +88,14 @@ sub parse_date ($) { local ($_) = shift; return unless defined; + # Reject over-long input up front, before any regex runs, so hostile + # strings cannot drive the parsing regexes into pathological backtracking. + # Length is measured as given (leading/trailing whitespace included). This + # cap is a security limit, not a tunable: every format we accept is far + # shorter, and the parsing regexes still contain adjacent unbounded + # quantifiers, so raising it demands re-benchmarking against hostile input. + return if length($_) > 64; + # More lax parsing below s/^\s+//; # kill leading space s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; # Useless weekday @@ -337,6 +345,12 @@ In scalar context the numbers are interpolated in a string of the If the date is unrecognized, then the empty list is returned (C in scalar context). +As a safeguard against pathological input, strings longer than 64 +characters are rejected without being parsed. The length is measured on the +string as given, before any leading or trailing whitespace is trimmed, so +heavily padded input may be rejected even if its trimmed payload would fit. +Every date format this module recognizes is far shorter than this limit. + The function is able to parse the following formats: "Wed, 09 Feb 1994 22:23:32 GMT" -- HTTP format diff --git a/t/redos.t b/t/redos.t new file mode 100644 index 0000000..cf98e55 --- /dev/null +++ b/t/redos.t @@ -0,0 +1,82 @@ +#!perl + +use strict; +use warnings; + +use Test::More; +use Time::HiRes qw(time); +use HTTP::Date qw(str2time parse_date); + +# Regression test: parse_date must not exhibit catastrophic (quadratic) +# backtracking on hostile input. A valid-looking date prefix followed by a +# long interior run of digits, letters, or whitespace and a trailing junk +# character used to force the parsing regex to explore O(N^2) states, so a +# ~40 KB string burned tens of seconds of CPU -- a denial of service. +# parse_date now rejects input longer than the cap below, up front, so such +# strings are handled instantly. + +# The length cap parse_date enforces. It is hardcoded in HTTP::Date (a +# security limit, not a knob), so mirror the value here; keep the two in sync. +my $LIMIT = 64; + +subtest 'length guard rejects over-long input' => sub { + my $good = 'Wed, 09 Feb 1994 22:23:32 GMT'; + ok( defined parse_date($good), 'a normal date parses' ); + + # Padding a date that parses fine on its own pushes it past the limit and + # it is rejected -- a deterministic proof the guard fires, no timing needed. + my $padded = $good . ( q{ } x $LIMIT ); + cmp_ok( + length $padded, '>', $LIMIT, + 'padded string exceeds the length limit' + ); + is( parse_date($padded), undef, 'parse_date rejects over-length input' ); + is( str2time($padded), undef, 'str2time rejects over-length input too' ); +}; + +subtest 'length guard boundary is exactly the cap' => sub { + + # The check is "> $LIMIT", so a string of exactly the limit is still + # considered and one character longer is rejected. Guards against a future + # off-by-one turning the cap into >= (which would reject a legal boundary). + my $limit = $LIMIT; + + my $at_limit = 'Wed, 09 Feb 1994 22:23:32 GMT'; + $at_limit .= q{ } x ( $limit - length $at_limit ); # pad up to the limit + is( length $at_limit, $limit, "test string is exactly $limit bytes" ); + ok( defined parse_date($at_limit), 'input at the limit is still parsed' ); + + my $over_limit = $at_limit . q{ }; # one byte too long + is( length $over_limit, $limit + 1, "test string is $limit + 1 bytes" ); + is( parse_date($over_limit), undef, 'input past the limit is rejected' ); +}; + +subtest 'hostile input is rejected promptly' => sub { + + # Unguarded these scale as O(N^2) and take many seconds; guarded they + # return immediately. The 1-second threshold is deliberately generous so + # the test is not flaky on a loaded machine. Each case targets a distinct + # ambiguous seam in the parsing regex. + my %evil = ( + 'letter run' => '01 Jan 2000 ' . ( 'a' x 10000 ) . '!', + 'digit run' => '01 Jan ' . ( '1' x 10000 ) . '!', + 'space run' => '01 Jan 2000' . ( ' ' x 10000 ) . '!', + ); + + for my $branch ( sort keys %evil ) { + my $str = $evil{$branch}; + + my $t0 = time; + my $got = parse_date($str); + my $elapsed = time - $t0; + + is( $got, undef, "hostile input ($branch) is rejected" ); + cmp_ok( + $elapsed, '<', 1, + sprintf '%s: %d-byte input handled promptly (%.3fs)', + $branch, length $str, $elapsed + ); + } +}; + +done_testing;