Ticket #2227: perl-5.10.0-upstream_fixes-1.patch

lib/File/CVE-2008-2827.t

@@ +1 @@
+#!perl -w
+
+# Test case derived from http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=487319
+
+my $foo = "foo-$$";
+my $bar = "bar-$$";
+
+die "Not clean [$foo] [$bar]" if -e $foo || -e $bar;
+
+eval {
+    symlink($foo, $bar) || die "Can't symlink $foo --> $bar";
+};
+if ($@) {
+    print "1..0 # Skipped: Only systems that can do symlinks are affected\n";
+    print "$@\n";
+    exit;
+}
+
+use Test;
+plan tests => 5;
+
+umask(0027);
+
+# touch foo
+open(my $fh, ">", $foo) || die "Can't create $foo\n";
+close($fh);
+
+my $m = (stat $foo)[2];
+ok(defined $m);
+
+require File::Path;
+ok(File::Path::rmtree($bar));
+ok(!-e $bar);
+
+# If the mode of $foo changed as a result of removing $bar then we are vulnerable
+ok($m, (stat $foo)[2]);
+
+unlink($foo);
+ok(!-e $foo);

ext/PerlIO/via/via.xs

@@ -89 +89 @@
             if (!s->fh) {
                 GV *gv = newGVgen(HvNAME_get(s->stash));
                 GvIOp(gv) = newIO();
-                s->fh = newRV_noinc((SV *) gv);
+                s->fh = newRV((SV *) gv);
                 s->io = GvIOp(gv);
             }
             IoIFP(s->io) = PerlIONext(f);

ext/POSIX/Makefile.PL

@@ -48 +48 @@
       MAX_INPUT MB_LEN_MAX MSG_CTRUNC MSG_DONTROUTE MSG_EOR MSG_OOB MSG_PEEK 
       MSG_TRUNC MSG_WAITALL NAME_MAX NCCS NGROUPS_MAX NOFLSH OPEN_MAX OPOST
       PARENB PARMRK PARODD PATH_MAX PIPE_BUF RAND_MAX R_OK SCHAR_MAX
-      SCHAR_MIN SEEK_CUR SEEK_END SEEK_SET SHRT_MAX SHRT_MIN SIGABRT SIGALRM
+      SCHAR_MIN SHRT_MAX SHRT_MIN SIGABRT SIGALRM
       SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT
       SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
       SIGUSR1 SIGUSR2 SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SSIZE_MAX
-      STDERR_FILENO STDIN_FILENO STDOUT_FILENO STREAM_MAX
-      S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
-      S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR TCIFLUSH TCIOFF
+      STDERR_FILENO STDIN_FILENO STDOUT_FILENO STREAM_MAX TCIFLUSH TCIOFF
       TCIOFLUSH TCION TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
       TMP_MAX TOSTOP TZNAME_MAX VEOF VEOL VERASE VINTR VKILL VMIN VQUIT
       VSTART VSTOP VSUSP VTIME WNOHANG WUNTRACED W_OK X_OK

ext/POSIX/POSIX.pm

@@ -13 +13 @@
 use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
              F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
              O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
-             O_WRONLY);
+             O_WRONLY SEEK_CUR SEEK_END SEEK_SET
+             S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
+             S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
 
 # Grandfather old foo_h form to new :foo_h form
 my $loaded;

lib/File/Path.pm

@@ -350 +350 @@
                 next ROOT_DIR;
             }
 
-            my $nperm = $perm & 07777 | 0600;
-            if ($nperm != $perm and not chmod $nperm, $root) {
-                if ($Force_Writeable) {
+            if ($Force_Writeable) {
+                my $nperm = $perm & 07777 | 0600;
+                if ($nperm != $perm and not chmod $nperm, $root) {
                     _error($arg, "cannot make file writeable", $canon);
                 }
             }

pp_sort.c

@@ -1553 +1553 @@
         max = AvFILL(av) + 1;
         if (SvMAGICAL(av)) {
             MEXTEND(SP, max);
-            p2 = SP;
             for (i=0; i < max; i++) {
                 SV **svp = av_fetch(av, i, FALSE);
                 *SP++ = (svp) ? *svp : NULL;
             }
+            SP--;
+            p1 = p2 = SP - (max-1);
         }
         else {
             if (SvREADONLY(av))
@@ -1713 +1714 @@
         SvREADONLY_off(av);
     else if (av && !sorting_av) {
         /* simulate pp_aassign of tied AV */
-        SV** const base = ORIGMARK+1;
+        SV** const base = MARK+1;
         for (i=0; i < max; i++) {
             base[i] = newSVsv(base[i]);
         }

t/lib/proxy_constant_subs.t

@@ -7 +7 @@
         print "1..0 # Skip -- Perl configured without B module\n";
         exit 0;
     }
-    if ($Config::Config{'extensions'} !~ /\bPOSIX\b/) {
-        print "1..0 # Skip -- Perl configured without POSIX\n";
+    if ($Config::Config{'extensions'} !~ /\bFcntl\b/) {
+        print "1..0 # Skip -- Perl configured without Fcntl\n";
         exit 0;
     }
-    # errno is a real subroutine, and acts as control
+    # S_IFMT is a real subroutine, and acts as control
     # SEEK_SET is a proxy constant subroutine.
-    @symbols = qw(errno SEEK_SET);
+    @symbols = qw(S_IFMT SEEK_SET);
 }
 
 use strict;
 use warnings;
 use Test::More tests => 4 * @symbols;
 use B qw(svref_2object GVf_IMPORTED_CV);
-use POSIX @symbols;
+use Fcntl @symbols;
 
 # GVf_IMPORTED_CV should not be set on the original, but should be set on the
 # imported GV.
@@ -29 +29 @@
     my ($ps, $ms);
     {
         no strict 'refs';
-        $ps = svref_2object(\*{"POSIX::$symbol"});
+        $ps = svref_2object(\*{"Fcntl::$symbol"});
         $ms = svref_2object(\*{"::$symbol"});
     }
     isa_ok($ps, 'B::GV');

perl-5.10.

@@ -1543 +1543 @@
     stash = GvSTASH(
         SvTYPE(mg->mg_obj) == SVt_PVGV
             ? (GV*)mg->mg_obj
-            : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+            : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
     );
 
     mro_isa_changed_in(stash);