From 624f773b30a208aaa6843e0d10785f40902b670b Mon Sep 17 00:00:00 2001 From: Olaf Alders Date: Sat, 4 Jul 2026 17:38:49 +0000 Subject: [PATCH] Fix ReDoS in parse_date (CVE-2026-14741) parse_date() -- and str2time(), which delegates to it -- used regexes with ambiguous adjacent greedy runs (year/clock/timezone digits and timezone/ASCII-timezone letters) before a trailing anchor. A valid-looking date prefix followed by a long interior run of digits, letters, or whitespace and a trailing junk character forced O(N^2) backtracking, so a ~100 KB string burned tens of seconds of CPU: a denial of service. Guard parse_date() with an up-front length check (reject input longer than 64 characters) so hostile strings are rejected before any regex runs. The check is on the untrimmed string, so no work happens on padded input. The cap is a hardcoded security limit, not a tunable: every format the module recognizes is far shorter, and the parsing regexes still contain adjacent unbounded quantifiers, so raising it would demand re-benchmarking against hostile input. The cap also bounds the substring later handed to Time::Zone. Add t/redos.t covering the guard, the exact length boundary, and the digit, letter, and whitespace DoS vectors. Fixes CVE-2026-14741. Co-Authored-By: Claude Opus 4.8 --- Changes | 4 +++ dist.ini | 5 +++ lib/HTTP/Date.pm | 14 +++++++++ t/redos.t | 82 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 105 insertions(+) create mode 100644 t/redos.t 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;