ignore PERL_XMLDUMP when tainting
authorTony Cook <tony@develop-help.com>
Wed, 8 Aug 2012 11:29:29 +0000 (13:29 +0200)
committerTony Cook <tony@develop-help.com>
Wed, 8 Aug 2012 11:38:46 +0000 (13:38 +0200)
In theory this is a security issue, but from discussion on the
security list that the system perl (or the perl used for anything
critical) is wildly unlikely to have been built with -Dmad.

MANIFEST
perl.c
t/run/mad.t [new file with mode: 0644]

index 7d51d73..054acc9 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5450,6 +5450,7 @@ t/run/dtrace.t                    Test for DTrace probes
 t/run/exit.t                   Test perl's exit status.
 t/run/fresh_perl.t             Tests that require a fresh perl.
 t/run/locale.t         Tests related to locale handling
 t/run/exit.t                   Test perl's exit status.
 t/run/fresh_perl.t             Tests that require a fresh perl.
 t/run/locale.t         Tests related to locale handling
+t/run/mad.t                    Test vs MAD environment
 t/run/noswitch.t               Test aliasing ARGV for other switch tests
 t/run/runenv.t                 Test if perl honors its environment variables.
 t/run/script.t                 See if script invocation works
 t/run/noswitch.t               Test aliasing ARGV for other switch tests
 t/run/runenv.t                 Test if perl honors its environment variables.
 t/run/script.t                 See if script invocation works
diff --git a/perl.c b/perl.c
index d836b0b..65b0a1c 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2192,7 +2192,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #ifdef PERL_MAD
     {
        const char *s;
 #ifdef PERL_MAD
     {
        const char *s;
-    if ((s = PerlEnv_getenv("PERL_XMLDUMP"))) {
+    if (!PL_tainting &&
+        (s = PerlEnv_getenv("PERL_XMLDUMP"))) {
        PL_madskills = 1;
        PL_minus_c = 1;
        if (!s || !s[0])
        PL_madskills = 1;
        PL_minus_c = 1;
        if (!s || !s[0])
diff --git a/t/run/mad.t b/t/run/mad.t
new file mode 100644 (file)
index 0000000..3c78df8
--- /dev/null
@@ -0,0 +1,46 @@
+#!./perl
+#
+# Tests for Perl mad environment
+#
+# $PERL_XMLDUMP
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    require './test.pl';
+    skip_all_without_config('mad');
+}
+
+use File::Path;
+
+my $tempdir = tempfile;
+
+mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
+chdir $tempdir or die die "Can't chdir '$tempdir': $!";
+unshift @INC, '../../lib';
+my $cleanup = 1;
+
+END {
+    if ($cleanup) {
+       chdir '..' or die "Couldn't chdir .. for cleanup: $!";
+       rmtree($tempdir);
+    }
+}
+
+plan tests => 4;
+
+{
+    local %ENV = %ENV;
+    $ENV{PERL_XMLDUMP} = "withoutT.xml";
+    fresh_perl_is('print q/hello/', '', {}, 'mad without -T');
+    ok(-f "withoutT.xml", "xml file created without -T as expected");
+}
+
+{
+    local %ENV = %ENV;
+    $ENV{PERL_XMLDUMP} = "withT.xml";
+    fresh_perl_is('print q/hello/', 'hello', { switches => [ "-T" ] },
+                 'mad with -T');
+    ok(!-e "withT.xml", "no xml file created with -T as expected");
+}