In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/ba0a4150f6f1604df236035adf6df18bd43de88e?hp=9f4fa7ee8c033d7f6eb68fbc58ee707b221817ee>
- Log -----------------------------------------------------------------
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.
M embed.fnc
M embed.h
M mg.c
M proto.h
M t/op/taint.t
M util.c
commit fac2c98c83b1d3b5039146aa7b14e3ed41f65cc4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sat Sep 3 10:15:22 2016 -0700
taint.t: Set up @INC before using it
The âchdir tâ line is useless if we require ./loc_tools.pl before
setting up @INC properly, as loc_tools.pl uses warnings.pm.
M t/op/taint.t
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 4 ++++
embed.h | 1 +
mg.c | 2 +-
proto.h | 3 +++
t/op/taint.t | 20 ++++++++++++++++++--
util.c | 25 ++++++++++++++++++++++---
6 files changed, 49 insertions(+), 6 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 6601c54..c547b56 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -366,6 +366,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 8220ab5..8be5109 100644
--- a/embed.h
+++ b/embed.h
@@ -1216,6 +1216,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 874933f..8b182e6 100644
--- a/mg.c
+++ b/mg.c
@@ -1217,7 +1217,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 9a4fa58..908deb2 100644
--- a/proto.h
+++ b/proto.h
@@ -664,6 +664,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 1915c38..ca0a58b 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -10,14 +10,14 @@
BEGIN {
chdir 't' if -d 't';
require './test.pl';
- require './loc_tools.pl';
set_up_inc('../lib');
+ require './loc_tools.pl';
}
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 8bc34cc..0f5533e 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;
@@ -551,6 +553,23 @@ Perl_delimcpy(char *to, const char *toend, const char
*from, const char *fromend
return (char *)from;
}
+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
--
Perl5 Master Repository
