From 5b60fc14574bdb9ae86ad235a447c97e108f0a3d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppi...@redhat.com>
Date: Mon, 19 Jun 2017 17:26:31 +0200
Subject: Fix checks for tainted directory in $ENV{PATH} if a backslash escape
presents
---
....3-Fix-checks-for-tainted-dir-in-ENV-PATH.patch | 191 +++++++++++++++++++++
perl.spec | 7 +
2 files changed, 198 insertions(+)
create mode 100644 perl-5.22.3-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
diff --git a/perl-5.22.3-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
b/perl-5.22.3-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
new file mode 100644
index 0000000..4ea66de
--- /dev/null
+++ b/perl-5.22.3-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
@@ -0,0 +1,191 @@
+From 326dd098113de7c1d79c00ef1eb1860d0e502586 Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <spr...@cpan.org>
+Date: Sat, 3 Sep 2016 13:30:22 -0700
+Subject: [PATCH] Fix checks for tainted dir in $ENV{PATH}
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Ported to 5.22.3:
+
+commit ba0a4150f6f1604df236035adf6df18bd43de88e
+Author: Father Chrysostomos <spr...@cpan.org>
+Date: Sat Sep 3 13:30:22 2016 -0700
+
+ Fix checks for tainted dir in $ENV{PATH}
+
+ $ cat > foo
+ #!/usr/bin/perl
+ print "What?!\n"
+ ^D
+ $ chmod +x foo
+ $ ./perl -Ilib -Te '$ENV{PATH}="."; exec "foo"'
+ Insecure directory in $ENV{PATH} while running with -T switch at -e line 1.
+
+ That is what I expect to see. But:
+
+ $ ./perl -Ilib -Te '$ENV{PATH}="/\\:."; exec "foo"'
+ What?!
+
+ Perl is allowing the \ to escape the :, but the \ is not treated as an
+ escape by the system, allowing a relative path in PATH to be consid-
+ ered safe.
+
+Signed-off-by: Petr Písař <ppi...@redhat.com>
+---
+ embed.fnc | 4 ++++
+ embed.h | 1 +
+ mg.c | 2 +-
+ proto.h | 9 +++++++++
+ t/op/taint.t | 18 +++++++++++++++++-
+ util.c | 25 ++++++++++++++++++++++---
+ 6 files changed, 54 insertions(+), 5 deletions(-)
+
+diff --git a/embed.fnc b/embed.fnc
+index 3dbf9e8..7eed88e 100644
+--- a/embed.fnc
++++ b/embed.fnc
+@@ -343,6 +343,10 @@ Ap |I32 |debstackptrs
+ pR |SV * |defelem_target |NN SV *sv|NULLOK MAGIC *mg
+ Anp |char* |delimcpy |NN char* to|NN const char* toend|NN const
char* from \
+ |NN const char* fromend|int delim|NN I32* retlen
++np |char* |delimcpy_no_escape|NN char* to|NN const char* toend \
++ |NN const char* from \
++ |NN const char* fromend|int delim \
++ |NN I32* retlen
+ : Used in op.c, perl.c
+ pM |void |delete_eval_scope
+ Aprd |OP* |die_sv |NN SV *baseex
+diff --git a/embed.h b/embed.h
+index e09ffee..fe310b6 100644
+--- a/embed.h
++++ b/embed.h
+@@ -1161,6 +1161,7 @@
+ #define deb_stack_all() Perl_deb_stack_all(aTHX)
+ #define defelem_target(a,b) Perl_defelem_target(aTHX_ a,b)
+ #define delete_eval_scope() Perl_delete_eval_scope(aTHX)
++#define delimcpy_no_escape Perl_delimcpy_no_escape
+ #define die_unwind(a) Perl_die_unwind(aTHX_ a)
+ #define do_aexec5(a,b,c,d,e) Perl_do_aexec5(aTHX_ a,b,c,d,e)
+ #define do_dump_pad(a,b,c,d) Perl_do_dump_pad(aTHX_ a,b,c,d)
+diff --git a/mg.c b/mg.c
+index 064a1ae..b67f8e2 100644
+--- a/mg.c
++++ b/mg.c
+@@ -1254,7 +1254,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
+ #else
+ const char path_sep = ':';
+ #endif
+- s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
++ s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf,
+ s, strend, path_sep, &i);
+ s++;
+ if (i >= (I32)sizeof tmpbuf /* too long -- assume the worst */
+diff --git a/proto.h b/proto.h
+index f82c62e..3b57ca4 100644
+--- a/proto.h
++++ b/proto.h
+@@ -891,6 +891,15 @@ PERL_CALLCONV char* Perl_delimcpy(char* to, const
char* toend, const char* from,
+ #define PERL_ARGS_ASSERT_DELIMCPY \
+ assert(to); assert(toend); assert(from); assert(fromend); assert(retlen)
+
++PERL_CALLCONV char* Perl_delimcpy_no_escape(char* to, const char* toend,
const char* from, const char* fromend, int delim, I32* retlen)
++ __attribute__nonnull__(1)
++ __attribute__nonnull__(2)
++ __attribute__nonnull__(3)
++ __attribute__nonnull__(4)
++ __attribute__nonnull__(6);
++#define PERL_ARGS_ASSERT_DELIMCPY_NO_ESCAPE \
++ assert(to); assert(toend); assert(from); assert(fromend); assert(retlen)
++
+ PERL_CALLCONV void Perl_despatch_signals(pTHX);
+ PERL_CALLCONV_NO_RET OP* Perl_die(pTHX_ const char* pat, ...)
+ __attribute__noreturn__
+diff --git a/t/op/taint.t b/t/op/taint.t
+index 08afc78..5437dbd 100644
+--- a/t/op/taint.t
++++ b/t/op/taint.t
+@@ -17,7 +17,7 @@ BEGIN {
+ use strict;
+ use Config;
+
+-plan tests => 801;
++plan tests => 805;
+
+ $| = 1;
+
+@@ -187,6 +187,22 @@ my $TEST = 'TEST';
+ like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
+ }
+
++ # Relative paths in $ENV{PATH} are always implicitly tainted.
++ SKIP: {
++ skip "Do these work on VMS?", 4 if $Is_VMS;
++ skip "Not applicable to DOSish systems", 4 if! $tmp;
++
++ local $ENV{PATH} = '.';
++ is(eval { `$echo 1` }, undef);
++ like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
++
++ # Backslash should not fool perl into thinking that this is one
++ # path.
++ local $ENV{PATH} = '/\:.';
++ is(eval { `$echo 1` }, undef);
++ like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
++ }
++
+ SKIP: {
+ skip "This is not VMS", 4 unless $Is_VMS;
+
+diff --git a/util.c b/util.c
+index 457b013..6dca6f2 100644
+--- a/util.c
++++ b/util.c
+@@ -520,15 +520,17 @@ Free_t Perl_mfree (Malloc_t where)
+
+ /* copy a string up to some (non-backslashed) delimiter, if any */
+
+-char *
+-Perl_delimcpy(char *to, const char *toend, const char *from, const char
*fromend, int delim, I32 *retlen)
++static char *
++S_delimcpy(char *to, const char *toend, const char *from,
++ const char *fromend, int delim, I32 *retlen,
++ const bool allow_escape)
+ {
+ I32 tolen;
+
+ PERL_ARGS_ASSERT_DELIMCPY;
+
+ for (tolen = 0; from < fromend; from++, tolen++) {
+- if (*from == '\\') {
++ if (allow_escape && *from == '\\') {
+ if (from[1] != delim) {
+ if (to < toend)
+ *to++ = *from;
+@@ -1217,6 +1219,23 @@ Perl_form_nocontext(const char* pat, ...)
+ }
+ #endif /* PERL_IMPLICIT_CONTEXT */
+
++char *
++Perl_delimcpy(char *to, const char *toend, const char *from, const char
*fromend, int delim, I32 *retlen)
++{
++ PERL_ARGS_ASSERT_DELIMCPY;
++
++ return S_delimcpy(to, toend, from, fromend, delim, retlen, 1);
++}
++
++char *
++Perl_delimcpy_no_escape(char *to, const char *toend, const char *from,
++ const char *fromend, int delim, I32 *retlen)
++{
++ PERL_ARGS_ASSERT_DELIMCPY_NO_ESCAPE;
++
++ return S_delimcpy(to, toend, from, fromend, delim, retlen, 0);
++}
++
+ /*
+ =head1 Miscellaneous Functions
+ =for apidoc form
+--
+2.9.4
+
diff --git a/perl.spec b/perl.spec
index 5f2d572..904dade 100644
--- a/perl.spec
+++ b/perl.spec
@@ -259,6 +259,10 @@ Patch85:
perl-5.24.1-perl-131263-clear-the-UTF8-flag-on-a-glob-if-it-isn-
# Fix a buffer overflow in my_atof2(), RT#131526, in upstream after 5.27.0
Patch86:
perl-5.27.0-perl-131526-don-t-go-beyond-the-end-of-the-NUL-in-my.patch
+# Fix checks for tainted directory in $ENV{PATH} if a backslash escape
presents,
+# in upstream after 5.25.4
+Patch87: perl-5.22.3-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
+
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200:
perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@@ -2587,6 +2591,7 @@ Perl extension for Version Objects
%patch84 -p1
%patch85 -p1
%patch86 -p1
+%patch87 -p1
%patch200 -p1
%patch201 -p1
@@ -2653,6 +2658,7 @@ perl -x patchlevel.h \
'Fedora Patch83: Fix cloning :via handles on thread creation (RT#131221)' \
'Fedora Patch85: Fix glob UTF-8 flag on a glob reassignment (RT#131263)' \
'Fedora Patch86: Fix a buffer overflow in my_atof2() (RT#131526)' \
+ 'Fedora Patch87: Fix checks for tainted directory in $ENV{PATH} if a
backslash escape presents' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on
Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@@ -4913,6 +4919,7 @@ popd
- Fix cloning :via handles on thread creation (RT#131221)
- Fix glob UTF-8 flag on a glob reassignment (RT#131263)
- Fix a buffer overflow in my_atof2() (RT#131526)
+- Fix checks for tainted directory in $ENV{PATH} if a backslash escape presents
* Wed Mar 08 2017 Petr Pisar <ppi...@redhat.com> - 4:5.22.3-370
- Fix a null-pointer dereference on malformed code (RT#130815)
--
cgit v1.1
https://src.fedoraproject.org/cgit/perl.git/commit/?h=f24&id=5b60fc14574bdb9ae86ad235a447c97e108f0a3d
_______________________________________________
perl-devel mailing list -- perl-devel@lists.fedoraproject.org
To unsubscribe send an email to perl-devel-le...@lists.fedoraproject.org
