Package: release.debian.org
Severity: normal
User: release.debian....@packages.debian.org
Usertags: unblock
X-Debbugs-Cc: p...@packages.debian.org, p...@packages.debian.org
Control: affects -1 + src:perl
Hi, please consider pre-approving the changes in perl/5.40.1-4
in experimental for sid/trixie.
This fixes #1098226 / CVE-2025-40909, a working directory race condition
during thread creation.
The severity was a bit questionable at first, but it's now considered a
proper security issue. Upstream will be releasing updates for supported
versions (5.40 and I believe 5.38 too). So I think we should follow suit.
I intend to try and fix this later also for bookworm via a point release.
The fix took a while for upstream to get right, so there's three cherry
picked commits as separate patches. Furthermore, the changes to the
top level Configure script needed two other patches so we can keep the
Configure regeneration machinery working. (See #762638 for the background
on why we have this machinery.)
Unfortunately that means the debdiff is a bit cluttered. For your
convenience, I'm also attaching the squashed version of the changes
(output of ` git diff debian/5.40.1-3 debian/5.40.1-4 ':!debian/' `)
as `perl_5.40.1-4.gitdiff`.
I uploaded this to experimental to get the "sid pseudo-excuses" debci
results. I believe we now have those and no regressions were found.
(I'm not quite sure how to confirm the test coverage, as I see no way
to query test results scheduled by others in the ci.debian.net API.
But a manual check of a random sample found successful tests for
all of them.)
I have also tested rebuilding 5331 packages in sid including all reverse
dependencies of perl and all packages matching 'lib.*perl'. I found no
regressions with those either.
If you're OK with acking this, I plan to upload the current version
unchanged expect for an 'upload to unstable' changelog entry as 5.40.1-5.
Thanks for your work on the release,
--
Niko
diff -Nru perl-5.40.1/debian/changelog perl-5.40.1/debian/changelog
--- perl-5.40.1/debian/changelog 2025-04-12 18:34:34.000000000 +0300
+++ perl-5.40.1/debian/changelog 2025-06-27 17:26:56.000000000 +0300
@@ -1,3 +1,10 @@
+perl (5.40.1-4) experimental; urgency=medium
+
+ * [SECURITY] CVE-2025-40909: Clone dirhandles without fchdir
+ (Closes: #1098226)
+
+ -- Niko Tyni <nt...@debian.org> Fri, 27 Jun 2025 17:26:56 +0300
+
perl (5.40.1-3) unstable; urgency=high
* [SECURITY] CVE-2024-56406: Fix heap-buffer-overflow with tr//
diff -Nru perl-5.40.1/debian/patches/fixes/CVE-2025-40909-1.diff
perl-5.40.1/debian/patches/fixes/CVE-2025-40909-1.diff
--- perl-5.40.1/debian/patches/fixes/CVE-2025-40909-1.diff 1970-01-01
02:00:00.000000000 +0200
+++ perl-5.40.1/debian/patches/fixes/CVE-2025-40909-1.diff 2025-06-27
17:26:56.000000000 +0300
@@ -0,0 +1,413 @@
+From: Leon Timmermans <faw...@gmail.com>
+Date: Fri, 23 May 2025 15:40:41 +0200
+Subject: CVE-2025-40909: Clone dirhandles without fchdir
+
+This uses fdopendir and dup to dirhandles. This means it won't change
+working directory during thread cloning, which prevents race conditions
+that can happen if a third thread is active at the same time.
+
+(cherry picked from commit 918bfff86ca8d6d4e4ec5b30994451e0bd74aba9)
+
+Origin: upstream,
https://github.com/Perl/perl5/commit/84be063eb88c5b1dd26cb4c418b94d39e60b7049
+Bug: https://github.com/Perl/perl5/issues/23010
+Bug-Debian: https://bugs.debian.org/1098226
+---
+ Configure | 6 +++
+ Cross/config.sh-arm-linux | 1 +
+ Cross/config.sh-arm-linux-n770 | 1 +
+ Porting/Glossary | 5 ++
+ Porting/config.sh | 1 +
+ config_h.SH | 6 +++
+ configure.com | 1 +
+ plan9/config_sh.sample | 1 +
+ sv.c | 91 ++----------------------------------
+ t/op/threads-dirh.t | 104 +----------------------------------------
+ win32/config.gc | 1 +
+ win32/config.vc | 1 +
+ 12 files changed, 28 insertions(+), 191 deletions(-)
+
+diff --git a/Configure b/Configure
+index ee4d40d..850b2f8 100755
+--- a/Configure
++++ b/Configure
+@@ -478,6 +478,7 @@ d_fd_set=''
+ d_fds_bits=''
+ d_fdclose=''
+ d_fdim=''
++d_fdopendir=''
+ d_fegetround=''
+ d_ffs=''
+ d_ffsl=''
+@@ -13342,6 +13343,10 @@ esac
+ set i_fcntl
+ eval $setvar
+
++: see if fdopendir exists
++set fdopendir d_fdopendir
++eval $inlibc
++
+ : see if fork exists
+ set fork d_fork
+ eval $inlibc
+@@ -25045,6 +25050,7 @@ d_flockproto='$d_flockproto'
+ d_fma='$d_fma'
+ d_fmax='$d_fmax'
+ d_fmin='$d_fmin'
++d_fdopendir='$d_fdopendir'
+ d_fork='$d_fork'
+ d_fp_class='$d_fp_class'
+ d_fp_classify='$d_fp_classify'
+diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
+index c7a6a51..f5fc63e 100644
+--- a/Cross/config.sh-arm-linux
++++ b/Cross/config.sh-arm-linux
+@@ -212,6 +212,7 @@ d_fd_macros='define'
+ d_fd_set='define'
+ d_fdclose='undef'
+ d_fdim='undef'
++d_fdopendir=undef
+ d_fds_bits='undef'
+ d_fegetround='define'
+ d_ffs='undef'
+diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770
+index 27ef72b..6916219 100644
+--- a/Cross/config.sh-arm-linux-n770
++++ b/Cross/config.sh-arm-linux-n770
+@@ -211,6 +211,7 @@ d_fd_macros='define'
+ d_fd_set='define'
+ d_fdclose='undef'
+ d_fdim='undef'
++d_fdopendir=undef
+ d_fds_bits='undef'
+ d_fegetround='define'
+ d_ffs='undef'
+diff --git a/Porting/Glossary b/Porting/Glossary
+index bb505c6..8b2965c 100644
+--- a/Porting/Glossary
++++ b/Porting/Glossary
+@@ -947,6 +947,11 @@ d_fmin (d_fmin.U):
+ This variable conditionally defines the HAS_FMIN symbol, which
+ indicates to the C program that the fmin() routine is available.
+
++d_fdopendir (d_fdopendir.U):
++ This variable conditionally defines the HAS_FORK symbol, which
++ indicates that the fdopen routine is available to open a
++ directory descriptor.
++
+ d_fork (d_fork.U):
+ This variable conditionally defines the HAS_FORK symbol, which
+ indicates to the C program that the fork() routine is available.
+diff --git a/Porting/config.sh b/Porting/config.sh
+index 2a76632..a982dda 100644
+--- a/Porting/config.sh
++++ b/Porting/config.sh
+@@ -223,6 +223,7 @@ d_fd_macros='define'
+ d_fd_set='define'
+ d_fdclose='undef'
+ d_fdim='define'
++d_fdopendir='define'
+ d_fds_bits='define'
+ d_fegetround='define'
+ d_ffs='define'
+diff --git a/config_h.SH b/config_h.SH
+index da0f2db..5a0f81c 100755
+--- a/config_h.SH
++++ b/config_h.SH
+@@ -142,6 +142,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
+ */
+ #$d_fcntl HAS_FCNTL /**/
+
++/* HAS_FDOPENDIR:
++ * This symbol, if defined, indicates that the fdopen routine is
++ * available to open a directory descriptor.
++ */
++#$d_fdopendir HAS_FDOPENDIR /**/
++
+ /* HAS_FGETPOS:
+ * This symbol, if defined, indicates that the fgetpos routine is
+ * available to get the file position indicator, similar to ftell().
+diff --git a/configure.com b/configure.com
+index a21c18d..c2eadbe 100644
+--- a/configure.com
++++ b/configure.com
+@@ -6010,6 +6010,7 @@ $ WC "d_fd_set='" + d_fd_set + "'"
+ $ WC "d_fd_macros='define'"
+ $ WC "d_fdclose='undef'"
+ $ WC "d_fdim='" + d_fdim + "'"
++$ WC "d_fdopendir='undef'"
+ $ WC "d_fds_bits='define'"
+ $ WC "d_fegetround='undef'"
+ $ WC "d_ffs='undef'"
+diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
+index 8ea0456..7dc236a 100644
+--- a/plan9/config_sh.sample
++++ b/plan9/config_sh.sample
+@@ -212,6 +212,7 @@ d_fd_macros='undef'
+ d_fd_set='undef'
+ d_fdclose='undef'
+ d_fdim='undef'
++d_fdopendir=undef
+ d_fds_bits='undef'
+ d_fegetround='undef'
+ d_ffs='undef'
+diff --git a/sv.c b/sv.c
+index 0b3d142..d2661be 100644
+--- a/sv.c
++++ b/sv.c
+@@ -14013,15 +14013,6 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS
*const param)
+ {
+ 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;
+
+@@ -14033,89 +14024,13 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS
*const param)
+ 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)));
++ ret = fdopendir(dup(my_dirfd(dp)));
+
+- /* 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
+-
+-#ifdef WIN32
++#elif defined(WIN32)
+ ret = win32_dirp_dup(dp, param);
+ #endif
+
+diff --git a/t/op/threads-dirh.t b/t/op/threads-dirh.t
+index bb4bcfc..14c399c 100644
+--- a/t/op/threads-dirh.t
++++ b/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', 'ok', {}, 'crash
when duping dirh';
+ 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 --git a/win32/config.gc b/win32/config.gc
+index 64c9488..2a76f87 100644
+--- a/win32/config.gc
++++ b/win32/config.gc
+@@ -199,6 +199,7 @@ d_fd_macros='define'
+ d_fd_set='define'
+ d_fdclose='undef'
+ d_fdim='undef'
++d_fdopendir='undef'
+ d_fds_bits='define'
+ d_fegetround='undef'
+ d_ffs='undef'
+diff --git a/win32/config.vc b/win32/config.vc
+index 384ec0e..0902642 100644
+--- a/win32/config.vc
++++ b/win32/config.vc
+@@ -199,6 +199,7 @@ d_fd_macros='define'
+ d_fd_set='define'
+ d_fdclose='undef'
+ d_fdim='undef'
++d_fdopendir='undef'
+ d_fds_bits='define'
+ d_fegetround='undef'
+ d_ffs='undef'
diff -Nru perl-5.40.1/debian/patches/fixes/CVE-2025-40909-2.diff
perl-5.40.1/debian/patches/fixes/CVE-2025-40909-2.diff
--- perl-5.40.1/debian/patches/fixes/CVE-2025-40909-2.diff 1970-01-01
02:00:00.000000000 +0200
+++ perl-5.40.1/debian/patches/fixes/CVE-2025-40909-2.diff 2025-06-27
17:26:56.000000000 +0300
@@ -0,0 +1,68 @@
+From: Steve Hay <steve.m....@googlemail.com>
+Date: Sun, 1 Jun 2025 10:37:34 +0100
+Subject: Minor corrections to 1f9097b342e0e37d619dfab6ea82ea99611b30bf
+
+(cherry picked from commit d19a96bcde20e2c6d237c843120d4a2dda0bda6e)
+
+Origin: upstream,
https://github.com/Perl/perl5/commit/b088e97848411fcff31efe817397985da30a664d
+Bug: https://github.com/Perl/perl5/issues/23010
+Bug-Debian: https://bugs.debian.org/1098226
+---
+ Cross/config.sh-arm-linux | 2 +-
+ Cross/config.sh-arm-linux-n770 | 2 +-
+ config_h.SH | 2 +-
+ plan9/config_sh.sample | 2 +-
+ 4 files changed, 4 insertions(+), 4 deletions(-)
+
+diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
+index f5fc63e..c212d4e 100644
+--- a/Cross/config.sh-arm-linux
++++ b/Cross/config.sh-arm-linux
+@@ -212,7 +212,7 @@ d_fd_macros='define'
+ d_fd_set='define'
+ d_fdclose='undef'
+ d_fdim='undef'
+-d_fdopendir=undef
++d_fdopendir='undef'
+ d_fds_bits='undef'
+ d_fegetround='define'
+ d_ffs='undef'
+diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770
+index 6916219..7647591 100644
+--- a/Cross/config.sh-arm-linux-n770
++++ b/Cross/config.sh-arm-linux-n770
+@@ -211,7 +211,7 @@ d_fd_macros='define'
+ d_fd_set='define'
+ d_fdclose='undef'
+ d_fdim='undef'
+-d_fdopendir=undef
++d_fdopendir='undef'
+ d_fds_bits='undef'
+ d_fegetround='define'
+ d_ffs='undef'
+diff --git a/config_h.SH b/config_h.SH
+index 5a0f81c..ffaab1f 100755
+--- a/config_h.SH
++++ b/config_h.SH
+@@ -143,7 +143,7 @@ sed <<!GROK!THIS! >$CONFIG_H -e
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
+ #$d_fcntl HAS_FCNTL /**/
+
+ /* HAS_FDOPENDIR:
+- * This symbol, if defined, indicates that the fdopen routine is
++ * This symbol, if defined, indicates that the fdopendir routine is
+ * available to open a directory descriptor.
+ */
+ #$d_fdopendir HAS_FDOPENDIR /**/
+diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
+index 7dc236a..1e53582 100644
+--- a/plan9/config_sh.sample
++++ b/plan9/config_sh.sample
+@@ -212,7 +212,7 @@ d_fd_macros='undef'
+ d_fd_set='undef'
+ d_fdclose='undef'
+ d_fdim='undef'
+-d_fdopendir=undef
++d_fdopendir='undef'
+ d_fds_bits='undef'
+ d_fegetround='undef'
+ d_ffs='undef'
diff -Nru perl-5.40.1/debian/patches/fixes/CVE-2025-40909-3.diff
perl-5.40.1/debian/patches/fixes/CVE-2025-40909-3.diff
--- perl-5.40.1/debian/patches/fixes/CVE-2025-40909-3.diff 1970-01-01
02:00:00.000000000 +0200
+++ perl-5.40.1/debian/patches/fixes/CVE-2025-40909-3.diff 2025-06-27
17:26:56.000000000 +0300
@@ -0,0 +1,29 @@
+From: Leon Timmermans <faw...@gmail.com>
+Date: Mon, 9 Jun 2025 23:05:39 +0200
+Subject: Use PerlLIO_dup_cloexec in Perl_dirp_dup to set O_CLOEXEC
+
+dup doesn't mark the new descriptor as close-on-exec, which can lead to
+a descriptor leaking to the new process.
+
+(cherry picked from commit d6f09a896842e5288af5d3817756b67a919ad7ad)
+
+Origin: upstream,
https://github.com/Perl/perl5/commit/08dffa08a0a3822d9eaae5bd7aea9c3a5b67a3f3
+Bug: https://github.com/Perl/perl5/issues/23010
+Bug-Debian: https://bugs.debian.org/1098226
+---
+ sv.c | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/sv.c b/sv.c
+index d2661be..f051550 100644
+--- a/sv.c
++++ b/sv.c
+@@ -14028,7 +14028,7 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const
param)
+
+ PERL_UNUSED_ARG(param);
+
+- ret = fdopendir(dup(my_dirfd(dp)));
++ ret = fdopendir(PerlLIO_dup_cloexec(my_dirfd(dp)));
+
+ #elif defined(WIN32)
+ ret = win32_dirp_dup(dp, param);
diff -Nru perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig.diff
perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig.diff
--- perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig.diff
1970-01-01 02:00:00.000000000 +0200
+++ perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig.diff
2025-06-27 17:26:56.000000000 +0300
@@ -0,0 +1,45 @@
+From: "H.Merijn Brand" <pe...@tux.freedom.nl>
+Date: Tue, 3 Jun 2025 09:20:20 +0200
+Subject: Check for fdopendir
+
+Origin: backport,
https://github.com/Perl/metaconfig/commit/0a72a5cecd3e17abe67be61dd2916b6d0cb6f398
+Bug: https://github.com/Perl/perl5/issues/23010
+Bug-Debian: https://bugs.debian.org/1098226
+---
+ regen-configure/U/perl/d_fdopendir.U | 27 +++++++++++++++++++++++++++
+ 1 file changed, 27 insertions(+)
+ create mode 100644 regen-configure/U/perl/d_fdopendir.U
+
+diff --git a/regen-configure/U/perl/d_fdopendir.U
b/regen-configure/U/perl/d_fdopendir.U
+new file mode 100644
+index 0000000..5d6c20c
+--- /dev/null
++++ b/regen-configure/U/perl/d_fdopendir.U
+@@ -0,0 +1,27 @@
++?RCS: Copyright (c) 2025 H.Merijn Brand
++?RCS:
++?RCS: You may redistribute only under the terms of the Artistic License,
++?RCS: as specified in the README file that comes with the distribution.
++?RCS: You may reuse parts of this distribution only within the terms of
++?RCS: that same Artistic License; a copy of which may be found at the
++?RCS: root of the source tree for dist 4.0.
++?RCS:
++?MAKE:d_fdopendir: Inlibc
++?MAKE: -pick add $@ %<
++?S:d_fdopendir:
++?S: This variable conditionally defines HAS_FDOPENDIR if fdopendir() is
++?S: available to open a directory using an opened file descriptor already
++?S: referring to that directory.
++?S:.
++?C:HAS_FDOPENDIR:
++?C: This symbol, if defined, indicates that the fdopendir() routine is
++?C: available to open directories using an opened file descriptor already
++?C: referring to that directory.
++?C:.
++?H:#$d_fdopendir HAS_FDOPENDIR /**/
++?H:.
++?LINT:set d_fdopendir
++: see if fdopendir exists
++set fdopendir d_fdopendir
++eval $inlibc
++
diff -Nru
perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig-reorder.diff
perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig-reorder.diff
--- perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig-reorder.diff
1970-01-01 02:00:00.000000000 +0200
+++ perl-5.40.1/debian/patches/fixes/CVE-2025-40909-metaconfig-reorder.diff
2025-06-27 17:26:56.000000000 +0300
@@ -0,0 +1,86 @@
+From: Niko Tyni <nt...@debian.org>
+Date: Fri, 27 Jun 2025 17:58:05 +0300
+Subject: Slightly reorder Configure and config_h.SH to match metaconfig
+ output
+
+Although these are originally generated files, they were changed upstream
+before changing the generator (metaconfig). The resulting orderings don't
+quite match.
+---
+ Configure | 10 +++++-----
+ config_h.SH | 13 +++++++------
+ 2 files changed, 12 insertions(+), 11 deletions(-)
+
+diff --git a/Configure b/Configure
+index 850b2f8..f30dba3 100755
+--- a/Configure
++++ b/Configure
+@@ -13343,10 +13343,6 @@ esac
+ set i_fcntl
+ eval $setvar
+
+-: see if fdopendir exists
+-set fdopendir d_fdopendir
+-eval $inlibc
+-
+ : see if fork exists
+ set fork d_fork
+ eval $inlibc
+@@ -14064,6 +14060,10 @@ eval $inlibc
+ set fdim d_fdim
+ eval $inlibc
+
++: see if fdopendir exists
++set fdopendir d_fdopendir
++eval $inlibc
++
+ : see if fegetround exists
+ set fegetround d_fegetround
+ eval $inlibc
+@@ -25037,6 +25037,7 @@ d_fd_macros='$d_fd_macros'
+ d_fd_set='$d_fd_set'
+ d_fdclose='$d_fdclose'
+ d_fdim='$d_fdim'
++d_fdopendir='$d_fdopendir'
+ d_fds_bits='$d_fds_bits'
+ d_fegetround='$d_fegetround'
+ d_ffs='$d_ffs'
+@@ -25050,7 +25051,6 @@ d_flockproto='$d_flockproto'
+ d_fma='$d_fma'
+ d_fmax='$d_fmax'
+ d_fmin='$d_fmin'
+-d_fdopendir='$d_fdopendir'
+ d_fork='$d_fork'
+ d_fp_class='$d_fp_class'
+ d_fp_classify='$d_fp_classify'
+diff --git a/config_h.SH b/config_h.SH
+index ffaab1f..6397232 100755
+--- a/config_h.SH
++++ b/config_h.SH
+@@ -142,12 +142,6 @@ sed <<!GROK!THIS! >$CONFIG_H -e
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
+ */
+ #$d_fcntl HAS_FCNTL /**/
+
+-/* HAS_FDOPENDIR:
+- * This symbol, if defined, indicates that the fdopendir routine is
+- * available to open a directory descriptor.
+- */
+-#$d_fdopendir HAS_FDOPENDIR /**/
+-
+ /* HAS_FGETPOS:
+ * This symbol, if defined, indicates that the fgetpos routine is
+ * available to get the file position indicator, similar to ftell().
+@@ -2526,6 +2520,13 @@ sed <<!GROK!THIS! >$CONFIG_H -e
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
+ */
+ #$d_fdim HAS_FDIM /**/
+
++/* HAS_FDOPENDIR:
++ * This symbol, if defined, indicates that the fdopendir() routine is
++ * available to open directories using an opened file descriptor already
++ * referring to that directory.
++ */
++#$d_fdopendir HAS_FDOPENDIR /**/
++
+ /* HAS_FEGETROUND:
+ * This symbol, if defined, indicates that the fegetround routine is
+ * available to return the macro corresponding to the current rounding
diff -Nru perl-5.40.1/debian/patches/series perl-5.40.1/debian/patches/series
--- perl-5.40.1/debian/patches/series 2025-04-12 18:34:34.000000000 +0300
+++ perl-5.40.1/debian/patches/series 2025-06-27 17:26:56.000000000 +0300
@@ -41,3 +41,8 @@
fixes/json-pp-options.diff
fixes/test-harness-bailout.diff
fixes/CVE-2024-56406.diff
+fixes/CVE-2025-40909-metaconfig.diff
+fixes/CVE-2025-40909-1.diff
+fixes/CVE-2025-40909-2.diff
+fixes/CVE-2025-40909-3.diff
+fixes/CVE-2025-40909-metaconfig-reorder.diff
diff --git a/Configure b/Configure
index ee4d40d1b..f30dba394 100755
--- a/Configure
+++ b/Configure
@@ -478,6 +478,7 @@ d_fd_set=''
d_fds_bits=''
d_fdclose=''
d_fdim=''
+d_fdopendir=''
d_fegetround=''
d_ffs=''
d_ffsl=''
@@ -14059,6 +14060,10 @@ eval $inlibc
set fdim d_fdim
eval $inlibc
+: see if fdopendir exists
+set fdopendir d_fdopendir
+eval $inlibc
+
: see if fegetround exists
set fegetround d_fegetround
eval $inlibc
@@ -25032,6 +25037,7 @@ d_fd_macros='$d_fd_macros'
d_fd_set='$d_fd_set'
d_fdclose='$d_fdclose'
d_fdim='$d_fdim'
+d_fdopendir='$d_fdopendir'
d_fds_bits='$d_fds_bits'
d_fegetround='$d_fegetround'
d_ffs='$d_ffs'
diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
index c7a6a5112..c212d4eda 100644
--- a/Cross/config.sh-arm-linux
+++ b/Cross/config.sh-arm-linux
@@ -212,6 +212,7 @@ d_fd_macros='define'
d_fd_set='define'
d_fdclose='undef'
d_fdim='undef'
+d_fdopendir='undef'
d_fds_bits='undef'
d_fegetround='define'
d_ffs='undef'
diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770
index 27ef72b0b..7647591f3 100644
--- a/Cross/config.sh-arm-linux-n770
+++ b/Cross/config.sh-arm-linux-n770
@@ -211,6 +211,7 @@ d_fd_macros='define'
d_fd_set='define'
d_fdclose='undef'
d_fdim='undef'
+d_fdopendir='undef'
d_fds_bits='undef'
d_fegetround='define'
d_ffs='undef'
diff --git a/Porting/Glossary b/Porting/Glossary
index bb505c653..8b2965ca9 100644
--- a/Porting/Glossary
+++ b/Porting/Glossary
@@ -947,6 +947,11 @@ d_fmin (d_fmin.U):
This variable conditionally defines the HAS_FMIN symbol, which
indicates to the C program that the fmin() routine is available.
+d_fdopendir (d_fdopendir.U):
+ This variable conditionally defines the HAS_FORK symbol, which
+ indicates that the fdopen routine is available to open a
+ directory descriptor.
+
d_fork (d_fork.U):
This variable conditionally defines the HAS_FORK symbol, which
indicates to the C program that the fork() routine is available.
diff --git a/Porting/config.sh b/Porting/config.sh
index 2a76632bf..a982dda3b 100644
--- a/Porting/config.sh
+++ b/Porting/config.sh
@@ -223,6 +223,7 @@ d_fd_macros='define'
d_fd_set='define'
d_fdclose='undef'
d_fdim='define'
+d_fdopendir='define'
d_fds_bits='define'
d_fegetround='define'
d_ffs='define'
diff --git a/config_h.SH b/config_h.SH
index da0f2dbcd..63972321d 100755
--- a/config_h.SH
+++ b/config_h.SH
@@ -2520,6 +2520,13 @@ sed <<!GROK!THIS! >$CONFIG_H -e
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
*/
#$d_fdim HAS_FDIM /**/
+/* HAS_FDOPENDIR:
+ * This symbol, if defined, indicates that the fdopendir() routine is
+ * available to open directories using an opened file descriptor already
+ * referring to that directory.
+ */
+#$d_fdopendir HAS_FDOPENDIR /**/
+
/* HAS_FEGETROUND:
* This symbol, if defined, indicates that the fegetround routine is
* available to return the macro corresponding to the current rounding
diff --git a/configure.com b/configure.com
index a21c18d90..c2eadbec2 100644
--- a/configure.com
+++ b/configure.com
@@ -6010,6 +6010,7 @@ $ WC "d_fd_set='" + d_fd_set + "'"
$ WC "d_fd_macros='define'"
$ WC "d_fdclose='undef'"
$ WC "d_fdim='" + d_fdim + "'"
+$ WC "d_fdopendir='undef'"
$ WC "d_fds_bits='define'"
$ WC "d_fegetround='undef'"
$ WC "d_ffs='undef'"
diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
index 8ea0456ba..1e5358212 100644
--- a/plan9/config_sh.sample
+++ b/plan9/config_sh.sample
@@ -212,6 +212,7 @@ d_fd_macros='undef'
d_fd_set='undef'
d_fdclose='undef'
d_fdim='undef'
+d_fdopendir='undef'
d_fds_bits='undef'
d_fegetround='undef'
d_ffs='undef'
diff --git a/regen-configure/U/perl/d_fdopendir.U
b/regen-configure/U/perl/d_fdopendir.U
new file mode 100644
index 000000000..5d6c20ce4
--- /dev/null
+++ b/regen-configure/U/perl/d_fdopendir.U
@@ -0,0 +1,27 @@
+?RCS: Copyright (c) 2025 H.Merijn Brand
+?RCS:
+?RCS: You may redistribute only under the terms of the Artistic License,
+?RCS: as specified in the README file that comes with the distribution.
+?RCS: You may reuse parts of this distribution only within the terms of
+?RCS: that same Artistic License; a copy of which may be found at the
+?RCS: root of the source tree for dist 4.0.
+?RCS:
+?MAKE:d_fdopendir: Inlibc
+?MAKE: -pick add $@ %<
+?S:d_fdopendir:
+?S: This variable conditionally defines HAS_FDOPENDIR if fdopendir() is
+?S: available to open a directory using an opened file descriptor already
+?S: referring to that directory.
+?S:.
+?C:HAS_FDOPENDIR:
+?C: This symbol, if defined, indicates that the fdopendir() routine is
+?C: available to open directories using an opened file descriptor already
+?C: referring to that directory.
+?C:.
+?H:#$d_fdopendir HAS_FDOPENDIR /**/
+?H:.
+?LINT:set d_fdopendir
+: see if fdopendir exists
+set fdopendir d_fdopendir
+eval $inlibc
+
diff --git a/sv.c b/sv.c
index 0b3d142e8..f0515505f 100644
--- a/sv.c
+++ b/sv.c
@@ -14013,15 +14013,6 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const
param)
{
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;
@@ -14033,89 +14024,13 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS
*const param)
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)));
+ ret = fdopendir(PerlLIO_dup_cloexec(my_dirfd(dp)));
- /* 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
-
-#ifdef WIN32
+#elif defined(WIN32)
ret = win32_dirp_dup(dp, param);
#endif
diff --git a/t/op/threads-dirh.t b/t/op/threads-dirh.t
index bb4bcfc14..14c399ca1 100644
--- a/t/op/threads-dirh.t
+++ b/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', 'ok', {}, 'crash
when duping dirh';
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 --git a/win32/config.gc b/win32/config.gc
index 64c9488fe..2a76f87a5 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -199,6 +199,7 @@ d_fd_macros='define'
d_fd_set='define'
d_fdclose='undef'
d_fdim='undef'
+d_fdopendir='undef'
d_fds_bits='define'
d_fegetround='undef'
d_ffs='undef'
diff --git a/win32/config.vc b/win32/config.vc
index 384ec0e70..090264252 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -199,6 +199,7 @@ d_fd_macros='define'
d_fd_set='define'
d_fdclose='undef'
d_fdim='undef'
+d_fdopendir='undef'
d_fds_bits='define'
d_fegetround='undef'
d_ffs='undef'
