Package: perl Version: 5.36.0-7+deb12u3 Severity: minor Tags: patch X-Debbugs-Cc: t...@security.debian.org
Dear Maintainer, The recent upstream CVE-2025-40909, which describes a race condition in directory handle duplication when using threads, affects Perl in Bookworm as well. I have prepared a minimal backport patch for Bookworm's perl (5.36.0-7+deb12u3), based on the upstream commits and Debian's fixes already applied to trixie/sid. The patch only touches: - sv.c - t/op/threads-dirh.t This matches upstream and sid's fix without introducing broader changes or requiring regeneration of configuration files. I've attached the debdiff for your consideration. I have built the updated package locally and confirmed: - The vulnerability is reproducible on stock Bookworm. - The provided test case no longer triggers the issue after applying the patch. Please consider applying this patch as a stable security update for Bookworm. Thanks for your work on maintaining Perl in Debian. Best regards, Yang Wang <yang.w...@windriver.com> -- System Information: Debian Release: 12.11 APT prefers stable APT policy: (500, 'stable') merged-usr: no Architecture: amd64 (x86_64) Kernel: Linux 6.8.0-60-generic (SMP w/8 CPU threads; PREEMPT) Locale: LANG=C, LC_CTYPE=C (charmap=ANSI_X3.4-1968) (ignored: LC_ALL set to C), LANGUAGE not set Shell: /bin/sh linked to /bin/dash Init: unable to detect Versions of packages perl depends on: ii dpkg 1.21.22 ii libperl5.36 5.36.0-7+deb12u3 ii perl-base 5.36.0-7+deb12u3 ii perl-modules-5.36 5.36.0-7+deb12u3 Versions of packages perl recommends: ii netbase 6.4 Versions of packages perl suggests: pn libtap-harness-archive-perl <none> pn libterm-readline-gnu-perl | libterm-readline-perl-perl <none> ii make 4.3-4.1 ii perl-doc 5.36.0-7+deb12u3 -- no debconf information
diff -Nru perl-5.36.0/debian/changelog perl-5.36.0/debian/changelog --- perl-5.36.0/debian/changelog 2025-04-12 15:16:31.000000000 +0000 +++ perl-5.36.0/debian/changelog 2025-07-02 16:35:00.000000000 +0000 @@ -1,3 +1,12 @@ +perl (5.36.0-7+deb12u3) bookworm-security; urgency=medium + + * Non-maintainer upload. + * Fix CVE-2025-40909: Avoid race condition when cloning directory handles. + - Cherry-picked upstream commit 918bfff86ca8d6d4e4ec5b30994451e0bd74aba9 + - Includes regenerated configuration files from upstream + + -- Yang Wang <yang.w...@windriver.com> Wed, 02 Jul 2025 12:35:00 -0400 + perl (5.36.0-7+deb12u2) bookworm-security; urgency=medium * [SECURITY] CVE-2024-56406: Fix heap-buffer-overflow with tr// diff -Nru perl-5.36.0/debian/patches/fixes/CVE-2025-40909.diff perl-5.36.0/debian/patches/fixes/CVE-2025-40909.diff --- perl-5.36.0/debian/patches/fixes/CVE-2025-40909.diff 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.36.0/debian/patches/fixes/CVE-2025-40909.diff 2025-07-02 16:35:00.000000000 +0000 @@ -0,0 +1,258 @@ +Description: Fix CVE-2025-40909: Avoid race condition when cloning directory handles + This patch addresses a race condition when directory handles are cloned in Perl + threads, which can result in unexpected failures when accessing files. + The fix avoids changing the process's current working directory in a + thread-unsafe manner during directory handle duplication. + . + This patch is cherry-picked from upstream commit: + https://github.com/Perl/perl5/commit/918bfff86ca8d6d4e4ec5b30994451e0bd74aba9 + . + The upstream patch includes source code changes and regenerated + configuration files. Regenerated files are taken as-is from upstream + for consistency. + +Origin: upstream, commit 918bfff86ca8d6d4e4ec5b30994451e0bd74aba9 +Bug-Debian: https://bugs.debian.org/1098226 +Bug: https://github.com/Perl/perl5/issues/23010 +CVE: CVE-2025-40909 +Forwarded: yes +Last-Update: 2025-07-02 +--- +This patch header follows DEP-3: http://dep.debian.net/deps/dep3/ +Index: perl-5.36.0/sv.c +=================================================================== +--- perl-5.36.0.orig/sv.c ++++ perl-5.36.0/sv.c +@@ -13700,15 +13700,6 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE + { + DIR *ret; + +-#if defined(HAS_FCHDIR) && defined(HAS_TELLDIR) && defined(HAS_SEEKDIR) +- DIR *pwd; +- const Direntry_t *dirent; +- char smallbuf[256]; /* XXX MAXPATHLEN, surely? */ +- char *name = NULL; +- STRLEN len = 0; +- long pos; +-#endif +- + PERL_UNUSED_CONTEXT; + PERL_ARGS_ASSERT_DIRP_DUP; + +@@ -13720,89 +13711,13 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE + if (ret) + return ret; + +-#if defined(HAS_FCHDIR) && defined(HAS_TELLDIR) && defined(HAS_SEEKDIR) ++#ifdef HAS_FDOPENDIR + + PERL_UNUSED_ARG(param); + +- /* create anew */ +- +- /* open the current directory (so we can switch back) */ +- if (!(pwd = PerlDir_open("."))) return (DIR *)NULL; +- +- /* chdir to our dir handle and open the present working directory */ +- if (fchdir(my_dirfd(dp)) < 0 || !(ret = PerlDir_open("."))) { +- PerlDir_close(pwd); +- return (DIR *)NULL; +- } +- /* Now we should have two dir handles pointing to the same dir. */ +- +- /* Be nice to the calling code and chdir back to where we were. */ +- /* XXX If this fails, then what? */ +- PERL_UNUSED_RESULT(fchdir(my_dirfd(pwd))); +- +- /* We have no need of the pwd handle any more. */ +- PerlDir_close(pwd); +- +-#ifdef DIRNAMLEN +-# define d_namlen(d) (d)->d_namlen +-#else +-# define d_namlen(d) strlen((d)->d_name) +-#endif +- /* Iterate once through dp, to get the file name at the current posi- +- tion. Then step back. */ +- pos = PerlDir_tell(dp); +- if ((dirent = PerlDir_read(dp))) { +- len = d_namlen(dirent); +- if (len > sizeof(dirent->d_name) && sizeof(dirent->d_name) > PTRSIZE) { +- /* If the len is somehow magically longer than the +- * maximum length of the directory entry, even though +- * we could fit it in a buffer, we could not copy it +- * from the dirent. Bail out. */ +- PerlDir_close(ret); +- return (DIR*)NULL; +- } +- if (len <= sizeof smallbuf) name = smallbuf; +- else Newx(name, len, char); +- Move(dirent->d_name, name, len, char); +- } +- PerlDir_seek(dp, pos); +- +- /* Iterate through the new dir handle, till we find a file with the +- right name. */ +- if (!dirent) /* just before the end */ +- for(;;) { +- pos = PerlDir_tell(ret); +- if (PerlDir_read(ret)) continue; /* not there yet */ +- PerlDir_seek(ret, pos); /* step back */ +- break; +- } +- else { +- const long pos0 = PerlDir_tell(ret); +- for(;;) { +- pos = PerlDir_tell(ret); +- if ((dirent = PerlDir_read(ret))) { +- if (len == (STRLEN)d_namlen(dirent) +- && memEQ(name, dirent->d_name, len)) { +- /* found it */ +- PerlDir_seek(ret, pos); /* step back */ +- break; +- } +- /* else we are not there yet; keep iterating */ +- } +- else { /* This is not meant to happen. The best we can do is +- reset the iterator to the beginning. */ +- PerlDir_seek(ret, pos0); +- break; +- } +- } +- } +-#undef d_namlen +- +- if (name && name != smallbuf) +- Safefree(name); +-#endif ++ ret = fdopendir(dup(my_dirfd(dp))); + +-#ifdef WIN32 ++#elif defined(WIN32) + ret = win32_dirp_dup(dp, param); + #endif + +Index: perl-5.36.0/t/op/threads-dirh.t +=================================================================== +--- perl-5.36.0.orig/t/op/threads-dirh.t ++++ perl-5.36.0/t/op/threads-dirh.t +@@ -13,16 +13,12 @@ BEGIN { + skip_all_if_miniperl("no dynamic loading on miniperl, no threads"); + skip_all("runs out of memory on some EBCDIC") if $ENV{PERL_SKIP_BIG_MEM_TESTS}; + +- plan(6); ++ plan(1); + } + + use strict; + use warnings; + use threads; +-use threads::shared; +-use File::Path; +-use File::Spec::Functions qw 'updir catdir'; +-use Cwd 'getcwd'; + + # Basic sanity check: make sure this does not crash + fresh_perl_is <<'# this is no comment', 'ok', {}, 'crash when duping dirh'; +@@ -31,101 +27,3 @@ fresh_perl_is <<'# this is no comment', + async{}->join for 1..2; + print "ok"; + # this is no comment +- +-my $dir; +-SKIP: { +- skip "telldir or seekdir not defined on this platform", 5 +- if !$Config::Config{d_telldir} || !$Config::Config{d_seekdir}; +- my $skip = sub { +- chdir($dir); +- chdir updir; +- skip $_[0], 5 +- }; +- +- if(!$Config::Config{d_fchdir} && $^O ne "MSWin32") { +- $::TODO = 'dir handle cloning currently requires fchdir on non-Windows platforms'; +- } +- +- my @w :shared; # warnings accumulator +- local $SIG{__WARN__} = sub { push @w, $_[0] }; +- +- $dir = catdir getcwd(), "thrext$$" . int rand() * 100000; +- +- rmtree($dir) if -d $dir; +- mkdir($dir); +- +- # Create a dir structure like this: +- # $dir +- # | +- # `- toberead +- # | +- # +---- thrit +- # | +- # +---- rile +- # | +- # `---- zor +- +- chdir($dir); +- mkdir 'toberead'; +- chdir 'toberead'; +- {open my $fh, ">thrit" or &$skip("Cannot create file thrit")} +- {open my $fh, ">rile" or &$skip("Cannot create file rile")} +- {open my $fh, ">zor" or &$skip("Cannot create file zor")} +- chdir updir; +- +- # Then test that dir iterators are cloned correctly. +- +- opendir my $toberead, 'toberead'; +- my $start_pos = telldir $toberead; +- my @first_2 = (scalar readdir $toberead, scalar readdir $toberead); +- my @from_thread = @{; async { [readdir $toberead ] } ->join }; +- my @from_main = readdir $toberead; +- is join('-', sort @from_thread), join('-', sort @from_main), +- 'dir iterator is copied from one thread to another'; +- like +- join('-', "", sort(@first_2, @from_thread), ""), +- qr/(?<!-rile)-rile-thrit-zor-(?!zor-)/i, +- 'cloned iterator iterates exactly once over everything not already seen'; +- +- seekdir $toberead, $start_pos; +- readdir $toberead for 1 .. @first_2+@from_thread; +- { +- local $::TODO; # This always passes when dir handles are not cloned. +- is +- async { readdir $toberead // 'undef' } ->join, 'undef', +- 'cloned dir iterator that points to the end of the directory' +- ; +- } +- +- # Make sure the cloning code can handle file names longer than 255 chars +- SKIP: { +- chdir 'toberead'; +- open my $fh, +- ">floccipaucinihilopilification-" +- . "pneumonoultramicroscopicsilicovolcanoconiosis-" +- . "lopadotemachoselachogaleokranioleipsanodrimypotrimmatosilphiokarabo" +- . "melitokatakechymenokichlepikossyphophattoperisteralektryonoptokephal" +- . "liokinklopeleiolagoiosiraiobaphetraganopterygon" +- or +- chdir updir, +- skip("OS does not support long file names (and I mean *long*)", 1); +- chdir updir; +- opendir my $dirh, "toberead"; +- my $test_name +- = "dir iterators can be cloned when the next fn > 255 chars"; +- while() { +- my $pos = telldir $dirh; +- my $fn = readdir($dirh); +- if(!defined $fn) { fail($test_name); last SKIP; } +- if($fn =~ 'lagoio') { +- seekdir $dirh, $pos; +- last; +- } +- } +- is length async { scalar readdir $dirh } ->join, 258, $test_name; +- } +- +- is scalar @w, 0, 'no warnings during all that' or diag @w; +- chdir updir; +-} +-rmtree($dir); diff -Nru perl-5.36.0/debian/patches/series perl-5.36.0/debian/patches/series --- perl-5.36.0/debian/patches/series 2025-04-12 15:16:09.000000000 +0000 +++ perl-5.36.0/debian/patches/series 2025-07-02 16:35:00.000000000 +0000 @@ -52,3 +52,4 @@ fixes/lto-test-fix.diff fixes/CVE-2023-47038.diff fixes/CVE-2024-56406.diff +fixes/CVE-2025-40909.diff
