tjh.dev
1From 918bfff86ca8d6d4e4ec5b30994451e0bd74aba9 Mon Sep 17 00:00:00 2001
2From: Leon Timmermans <fawaka@gmail.com>
3Date: Fri, 23 May 2025 15:40:41 +0200
4Subject: [PATCH] CVE-2025-40909: Clone dirhandles without fchdir
5
6This uses fdopendir and dup to dirhandles. This means it won't change
7working directory during thread cloning, which prevents race conditions
8that can happen if a third thread is active at the same time.
9---
10 Configure | 6 ++
11 Cross/config.sh-arm-linux | 1 +
12 Cross/config.sh-arm-linux-n770 | 1 +
13 Porting/Glossary | 5 ++
14 Porting/config.sh | 1 +
15 config_h.SH | 6 ++
16 configure.com | 1 +
17 plan9/config_sh.sample | 1 +
18 sv.c | 91 +----------------------------
19 t/op/threads-dirh.t | 104 +--------------------------------
20 win32/config.gc | 1 +
21 win32/config.vc | 1 +
22 12 files changed, 28 insertions(+), 191 deletions(-)
23
24diff --git a/Configure b/Configure
25index 44c12ced4014..7a13249caa96 100755
26--- a/Configure
27+++ b/Configure
28@@ -478,6 +478,7 @@ d_fd_set=''
29 d_fds_bits=''
30 d_fdclose=''
31 d_fdim=''
32+d_fdopendir=''
33 d_fegetround=''
34 d_ffs=''
35 d_ffsl=''
36@@ -13344,6 +13345,10 @@ esac
37 set i_fcntl
38 eval $setvar
39
40+: see if fdopendir exists
41+set fdopendir d_fdopendir
42+eval $inlibc
43+
44 : see if fork exists
45 set fork d_fork
46 eval $inlibc
47@@ -25052,6 +25057,7 @@ d_flockproto='$d_flockproto'
48 d_fma='$d_fma'
49 d_fmax='$d_fmax'
50 d_fmin='$d_fmin'
51+d_fdopendir='$d_fdopendir'
52 d_fork='$d_fork'
53 d_fp_class='$d_fp_class'
54 d_fp_classify='$d_fp_classify'
55diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
56index bfa0b00d5f0f..9e056539198b 100644
57--- a/Cross/config.sh-arm-linux
58+++ b/Cross/config.sh-arm-linux
59@@ -212,6 +212,7 @@ d_fd_macros='define'
60 d_fd_set='define'
61 d_fdclose='undef'
62 d_fdim='undef'
63+d_fdopendir=undef
64 d_fds_bits='undef'
65 d_fegetround='define'
66 d_ffs='undef'
67diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770
68index 47ad5c37e3fd..365e4c4f9671 100644
69--- a/Cross/config.sh-arm-linux-n770
70+++ b/Cross/config.sh-arm-linux-n770
71@@ -211,6 +211,7 @@ d_fd_macros='define'
72 d_fd_set='define'
73 d_fdclose='undef'
74 d_fdim='undef'
75+d_fdopendir=undef
76 d_fds_bits='undef'
77 d_fegetround='define'
78 d_ffs='undef'
79diff --git a/Porting/Glossary b/Porting/Glossary
80index bb505c653b0b..8b2965ca99c6 100644
81--- a/Porting/Glossary
82+++ b/Porting/Glossary
83@@ -947,6 +947,11 @@ d_fmin (d_fmin.U):
84 This variable conditionally defines the HAS_FMIN symbol, which
85 indicates to the C program that the fmin() routine is available.
86
87+d_fdopendir (d_fdopendir.U):
88+ This variable conditionally defines the HAS_FORK symbol, which
89+ indicates that the fdopen routine is available to open a
90+ directory descriptor.
91+
92 d_fork (d_fork.U):
93 This variable conditionally defines the HAS_FORK symbol, which
94 indicates to the C program that the fork() routine is available.
95diff --git a/Porting/config.sh b/Porting/config.sh
96index a921f7e1c79a..6231ea0f31ea 100644
97--- a/Porting/config.sh
98+++ b/Porting/config.sh
99@@ -223,6 +223,7 @@ d_fd_macros='define'
100 d_fd_set='define'
101 d_fdclose='undef'
102 d_fdim='define'
103+d_fdopendir='define'
104 d_fds_bits='define'
105 d_fegetround='define'
106 d_ffs='define'
107diff --git a/config_h.SH b/config_h.SH
108index da0f2dbcd7b7..5a0f81cf2011 100755
109--- a/config_h.SH
110+++ b/config_h.SH
111@@ -142,6 +142,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
112 */
113 #$d_fcntl HAS_FCNTL /**/
114
115+/* HAS_FDOPENDIR:
116+ * This symbol, if defined, indicates that the fdopen routine is
117+ * available to open a directory descriptor.
118+ */
119+#$d_fdopendir HAS_FDOPENDIR /**/
120+
121 /* HAS_FGETPOS:
122 * This symbol, if defined, indicates that the fgetpos routine is
123 * available to get the file position indicator, similar to ftell().
124diff --git a/configure.com b/configure.com
125index 99527c180bfc..7c38711bb85d 100644
126--- a/configure.com
127+++ b/configure.com
128@@ -6010,6 +6010,7 @@ $ WC "d_fd_set='" + d_fd_set + "'"
129 $ WC "d_fd_macros='define'"
130 $ WC "d_fdclose='undef'"
131 $ WC "d_fdim='" + d_fdim + "'"
132+$ WC "d_fdopendir='undef'"
133 $ WC "d_fds_bits='define'"
134 $ WC "d_fegetround='undef'"
135 $ WC "d_ffs='undef'"
136diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
137index 636acbdf6db3..246bad954424 100644
138--- a/plan9/config_sh.sample
139+++ b/plan9/config_sh.sample
140@@ -212,6 +212,7 @@ d_fd_macros='undef'
141 d_fd_set='undef'
142 d_fdclose='undef'
143 d_fdim='undef'
144+d_fdopendir=undef
145 d_fds_bits='undef'
146 d_fegetround='undef'
147 d_ffs='undef'
148diff --git a/sv.c b/sv.c
149index ae6d09dea28a..8a005b2d165b 100644
150--- a/sv.c
151+++ b/sv.c
152@@ -14096,15 +14096,6 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const param)
153 {
154 DIR *ret;
155
156-#if defined(HAS_FCHDIR) && defined(HAS_TELLDIR) && defined(HAS_SEEKDIR)
157- DIR *pwd;
158- const Direntry_t *dirent;
159- char smallbuf[256]; /* XXX MAXPATHLEN, surely? */
160- char *name = NULL;
161- STRLEN len = 0;
162- long pos;
163-#endif
164-
165 PERL_UNUSED_CONTEXT;
166 PERL_ARGS_ASSERT_DIRP_DUP;
167
168@@ -14116,89 +14107,13 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const param)
169 if (ret)
170 return ret;
171
172-#if defined(HAS_FCHDIR) && defined(HAS_TELLDIR) && defined(HAS_SEEKDIR)
173+#ifdef HAS_FDOPENDIR
174
175 PERL_UNUSED_ARG(param);
176
177- /* create anew */
178-
179- /* open the current directory (so we can switch back) */
180- if (!(pwd = PerlDir_open("."))) return (DIR *)NULL;
181-
182- /* chdir to our dir handle and open the present working directory */
183- if (fchdir(my_dirfd(dp)) < 0 || !(ret = PerlDir_open("."))) {
184- PerlDir_close(pwd);
185- return (DIR *)NULL;
186- }
187- /* Now we should have two dir handles pointing to the same dir. */
188-
189- /* Be nice to the calling code and chdir back to where we were. */
190- /* XXX If this fails, then what? */
191- PERL_UNUSED_RESULT(fchdir(my_dirfd(pwd)));
192+ ret = fdopendir(dup(my_dirfd(dp)));
193
194- /* We have no need of the pwd handle any more. */
195- PerlDir_close(pwd);
196-
197-#ifdef DIRNAMLEN
198-# define d_namlen(d) (d)->d_namlen
199-#else
200-# define d_namlen(d) strlen((d)->d_name)
201-#endif
202- /* Iterate once through dp, to get the file name at the current posi-
203- tion. Then step back. */
204- pos = PerlDir_tell(dp);
205- if ((dirent = PerlDir_read(dp))) {
206- len = d_namlen(dirent);
207- if (len > sizeof(dirent->d_name) && sizeof(dirent->d_name) > PTRSIZE) {
208- /* If the len is somehow magically longer than the
209- * maximum length of the directory entry, even though
210- * we could fit it in a buffer, we could not copy it
211- * from the dirent. Bail out. */
212- PerlDir_close(ret);
213- return (DIR*)NULL;
214- }
215- if (len <= sizeof smallbuf) name = smallbuf;
216- else Newx(name, len, char);
217- Move(dirent->d_name, name, len, char);
218- }
219- PerlDir_seek(dp, pos);
220-
221- /* Iterate through the new dir handle, till we find a file with the
222- right name. */
223- if (!dirent) /* just before the end */
224- for(;;) {
225- pos = PerlDir_tell(ret);
226- if (PerlDir_read(ret)) continue; /* not there yet */
227- PerlDir_seek(ret, pos); /* step back */
228- break;
229- }
230- else {
231- const long pos0 = PerlDir_tell(ret);
232- for(;;) {
233- pos = PerlDir_tell(ret);
234- if ((dirent = PerlDir_read(ret))) {
235- if (len == (STRLEN)d_namlen(dirent)
236- && memEQ(name, dirent->d_name, len)) {
237- /* found it */
238- PerlDir_seek(ret, pos); /* step back */
239- break;
240- }
241- /* else we are not there yet; keep iterating */
242- }
243- else { /* This is not meant to happen. The best we can do is
244- reset the iterator to the beginning. */
245- PerlDir_seek(ret, pos0);
246- break;
247- }
248- }
249- }
250-#undef d_namlen
251-
252- if (name && name != smallbuf)
253- Safefree(name);
254-#endif
255-
256-#ifdef WIN32
257+#elif defined(WIN32)
258 ret = win32_dirp_dup(dp, param);
259 #endif
260
261diff --git a/t/op/threads-dirh.t b/t/op/threads-dirh.t
262index bb4bcfc14184..14c399ca19cd 100644
263--- a/t/op/threads-dirh.t
264+++ b/t/op/threads-dirh.t
265@@ -13,16 +13,12 @@ BEGIN {
266 skip_all_if_miniperl("no dynamic loading on miniperl, no threads");
267 skip_all("runs out of memory on some EBCDIC") if $ENV{PERL_SKIP_BIG_MEM_TESTS};
268
269- plan(6);
270+ plan(1);
271 }
272
273 use strict;
274 use warnings;
275 use threads;
276-use threads::shared;
277-use File::Path;
278-use File::Spec::Functions qw 'updir catdir';
279-use Cwd 'getcwd';
280
281 # Basic sanity check: make sure this does not crash
282 fresh_perl_is <<'# this is no comment', 'ok', {}, 'crash when duping dirh';
283@@ -31,101 +27,3 @@ fresh_perl_is <<'# this is no comment', 'ok', {}, 'crash when duping dirh';
284 async{}->join for 1..2;
285 print "ok";
286 # this is no comment
287-
288-my $dir;
289-SKIP: {
290- skip "telldir or seekdir not defined on this platform", 5
291- if !$Config::Config{d_telldir} || !$Config::Config{d_seekdir};
292- my $skip = sub {
293- chdir($dir);
294- chdir updir;
295- skip $_[0], 5
296- };
297-
298- if(!$Config::Config{d_fchdir} && $^O ne "MSWin32") {
299- $::TODO = 'dir handle cloning currently requires fchdir on non-Windows platforms';
300- }
301-
302- my @w :shared; # warnings accumulator
303- local $SIG{__WARN__} = sub { push @w, $_[0] };
304-
305- $dir = catdir getcwd(), "thrext$$" . int rand() * 100000;
306-
307- rmtree($dir) if -d $dir;
308- mkdir($dir);
309-
310- # Create a dir structure like this:
311- # $dir
312- # |
313- # `- toberead
314- # |
315- # +---- thrit
316- # |
317- # +---- rile
318- # |
319- # `---- zor
320-
321- chdir($dir);
322- mkdir 'toberead';
323- chdir 'toberead';
324- {open my $fh, ">thrit" or &$skip("Cannot create file thrit")}
325- {open my $fh, ">rile" or &$skip("Cannot create file rile")}
326- {open my $fh, ">zor" or &$skip("Cannot create file zor")}
327- chdir updir;
328-
329- # Then test that dir iterators are cloned correctly.
330-
331- opendir my $toberead, 'toberead';
332- my $start_pos = telldir $toberead;
333- my @first_2 = (scalar readdir $toberead, scalar readdir $toberead);
334- my @from_thread = @{; async { [readdir $toberead ] } ->join };
335- my @from_main = readdir $toberead;
336- is join('-', sort @from_thread), join('-', sort @from_main),
337- 'dir iterator is copied from one thread to another';
338- like
339- join('-', "", sort(@first_2, @from_thread), ""),
340- qr/(?<!-rile)-rile-thrit-zor-(?!zor-)/i,
341- 'cloned iterator iterates exactly once over everything not already seen';
342-
343- seekdir $toberead, $start_pos;
344- readdir $toberead for 1 .. @first_2+@from_thread;
345- {
346- local $::TODO; # This always passes when dir handles are not cloned.
347- is
348- async { readdir $toberead // 'undef' } ->join, 'undef',
349- 'cloned dir iterator that points to the end of the directory'
350- ;
351- }
352-
353- # Make sure the cloning code can handle file names longer than 255 chars
354- SKIP: {
355- chdir 'toberead';
356- open my $fh,
357- ">floccipaucinihilopilification-"
358- . "pneumonoultramicroscopicsilicovolcanoconiosis-"
359- . "lopadotemachoselachogaleokranioleipsanodrimypotrimmatosilphiokarabo"
360- . "melitokatakechymenokichlepikossyphophattoperisteralektryonoptokephal"
361- . "liokinklopeleiolagoiosiraiobaphetraganopterygon"
362- or
363- chdir updir,
364- skip("OS does not support long file names (and I mean *long*)", 1);
365- chdir updir;
366- opendir my $dirh, "toberead";
367- my $test_name
368- = "dir iterators can be cloned when the next fn > 255 chars";
369- while() {
370- my $pos = telldir $dirh;
371- my $fn = readdir($dirh);
372- if(!defined $fn) { fail($test_name); last SKIP; }
373- if($fn =~ 'lagoio') {
374- seekdir $dirh, $pos;
375- last;
376- }
377- }
378- is length async { scalar readdir $dirh } ->join, 258, $test_name;
379- }
380-
381- is scalar @w, 0, 'no warnings during all that' or diag @w;
382- chdir updir;
383-}
384-rmtree($dir);
385diff --git a/win32/config.gc b/win32/config.gc
386index f8776188c09c..34aa8de6ed75 100644
387--- a/win32/config.gc
388+++ b/win32/config.gc
389@@ -199,6 +199,7 @@ d_fd_macros='define'
390 d_fd_set='define'
391 d_fdclose='undef'
392 d_fdim='undef'
393+d_fdopendir='undef'
394 d_fds_bits='define'
395 d_fegetround='undef'
396 d_ffs='undef'
397diff --git a/win32/config.vc b/win32/config.vc
398index 619979e22b53..536085fe94e0 100644
399--- a/win32/config.vc
400+++ b/win32/config.vc
401@@ -199,6 +199,7 @@ d_fd_macros='define'
402 d_fd_set='define'
403 d_fdclose='undef'
404 d_fdim='undef'
405+d_fdopendir='undef'
406 d_fds_bits='define'
407 d_fegetround='undef'
408 d_ffs='undef'