Sync from SUSE:SLFO:1.1 perl revision a073aa82482011670171f9bbb958acc2

perl-dirdup.diff

@@ -0,0 +1,229 @@
+--- sv.c.orig	2025-06-05 10:34:12.229139274 +0000
++++ sv.c	2025-06-05 10:34:58.397076081 +0000
+@@ -13944,15 +13944,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;
+ 
+@@ -13964,87 +13955,7 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE
+     if (ret)
+         return ret;
+ 
+-#if defined(HAS_FCHDIR) && defined(HAS_TELLDIR) && defined(HAS_SEEKDIR)
+-
+-    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
+     ret = win32_dirp_dup(dp, param);
+--- t/op/threads-dirh.t.orig	2023-11-28 11:57:28.000000000 +0000
++++ t/op/threads-dirh.t	2025-06-05 10:34:23.701123572 +0000
+@@ -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);

perl-pmtrans.diff

@@ -0,0 +1,10 @@
+--- op.c.orig	2025-04-11 13:13:56.375449813 +0000
++++ op.c	2025-04-11 13:14:31.919397621 +0000
+@@ -6520,6 +6520,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *rep
+                  * same time.  But otherwise one crosses before the other */
+                 if (t_cp < 256 && r_cp_end > 255 && r_cp != t_cp) {
+                     can_force_utf8 = TRUE;
++                    max_expansion = MAX(2, max_expansion);
+                 }
+             }
+ 

perl.changes

@@ -1,3 +1,16 @@
+-------------------------------------------------------------------
+Thu Jun  5 11:15:53 CEST 2025 - mls@suse.de
+
+- do not change the current directory when cloning an open
+  directory handle [bnc#1244079] [CVE-2025-40909]
+  new patch: perl-dirdup.diff
+
+-------------------------------------------------------------------
+Fri Apr 11 15:15:49 CEST 2025 - mls@suse.de
+
+- fix heap buffer overflow with tr// [bsc#1241083] [CVE-2024-56406]
+  new patch: perl-pmtrans.diff
+
 -------------------------------------------------------------------
 Mon Nov 27 10:50:24 CET 2023 - mls@suse.de
 

perl.spec

@@ -54,6 +54,8 @@ Patch12:        perl-reproducible.patch
 Patch13:        perl_skip_flaky_tests_powerpc.patch
 # PATCH-FIX-UPSTREAM unmerged https://www.nntp.perl.org/group/perl.perl5.porters/2018/12/msg253240.html
 Patch18:        perl-reproducible2.patch
+Patch19:        perl-pmtrans.diff
+Patch20:        perl-dirdup.diff
 BuildRequires:  db-devel
 BuildRequires:  gdbm-devel
 BuildRequires:  libbz2-devel
@@ -190,6 +192,8 @@ cp -p %{SOURCE3} .
 %patch11
 %patch12 -p1
 %patch18
+%patch19
+%patch20
 
 %build
 %define _lto_cflags %{nil}