From 466f7336ba76c702a959df198942aa517540f0ea 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
---
....1-Fix-checks-for-tainted-dir-in-ENV-PATH.patch | 185 +++++++++++++++++++++
perl.spec | 7 +
2 files changed, 192 insertions(+)
create mode 100644 perl-5.24.1-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
diff --git a/perl-5.24.1-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
b/perl-5.24.1-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
new file mode 100644
index 0000000..0092b24
--- /dev/null
+++ b/perl-5.24.1-Fix-checks-for-tainted-dir-in-ENV-PATH.patch
@@ -0,0 +1,185 @@
+From ab412ef46f7ded04234bfd31ce9e73ce5c8b23cb 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.24.1:
+
+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 | 3 +++
+ t/op/taint.t | 18 +++++++++++++++++-
+ util.c | 25 ++++++++++++++++++++++---
+ 6 files changed, 48 insertions(+), 5 deletions(-)
+
+diff --git a/embed.fnc b/embed.fnc
+index 2395efb..4aeb767 100644
+--- a/embed.fnc
++++ b/embed.fnc
+@@ -344,6 +344,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 42c65b2..5b2998d 100644
+--- a/embed.h
++++ b/embed.h
+@@ -1206,6 +1206,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 4321a40..1c43c9d 100644
+--- a/mg.c
++++ b/mg.c
+@@ -1259,7 +1259,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 2b2004a..6c1f840 100644
+--- a/proto.h
++++ b/proto.h
+@@ -659,6 +659,9 @@ PERL_CALLCONV void Perl_delete_eval_scope(pTHX);
+ PERL_CALLCONV char* Perl_delimcpy(char* to, const char* toend, const char*
from, const char* fromend, int delim, I32* retlen);
+ #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);
++#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 101c6da..846ac23 100644
+--- a/t/op/taint.t
++++ b/t/op/taint.t
+@@ -17,7 +17,7 @@ BEGIN {
+ use strict;
+ use Config;
+
+-plan tests => 808;
++plan tests => 812;
+
+ $| = 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 89c44e7..ef59fba 100644
+--- a/util.c
++++ b/util.c
+@@ -524,15 +524,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;
+@@ -1314,6 +1316,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 0273278..af9a8da 100644
--- a/perl.spec
+++ b/perl.spec
@@ -366,6 +366,10 @@ Patch102:
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
Patch103:
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
+Patch104: perl-5.24.1-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
@@ -3107,6 +3111,7 @@ popd
%patch101 -p1
%patch102 -p1
%patch103 -p1
+%patch104 -p1
%patch200 -p1
%patch201 -p1
@@ -3190,6 +3195,7 @@ perl -x patchlevel.h \
'Fedora Patch100: Fix cloning :via handles on thread creation (RT#131221)'
\
'Fedora Patch102: Fix glob UTF-8 flag on a glob reassignment (RT#131263)' \
'Fedora Patch103: Fix a buffer overflow in my_atof2() (RT#131526)' \
+ 'Fedora Patch104: 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}
@@ -5488,6 +5494,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
* Fri Mar 31 2017 Petr Pisar <ppi...@redhat.com> - 4:5.24.1-391
- Introduce build-conditions for groff, systemtap, syslog tests, and tcsh
--
cgit v1.1
https://src.fedoraproject.org/cgit/perl.git/commit/?h=f26&id=466f7336ba76c702a959df198942aa517540f0ea
_______________________________________________
perl-devel mailing list -- perl-devel@lists.fedoraproject.org
To unsubscribe send an email to perl-devel-le...@lists.fedoraproject.org
