Fix ReDoS in parse_date

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)

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]

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<undef> 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

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;