Add C define to remove taint support from perl

By defining NO_TAINT_SUPPORT, all the various checks that perl does for
tainting become no-ops. It's not an entirely complete change: it doesn't
attempt to remove the taint-related interpreter variables, but instead
virtually eliminates access to it.

Why, you ask? Because it appears to speed up perl's run-time
significantly by avoiding various "are we running under taint" checks
and the like.

This change is not in a state to go into blead yet. The actual way I
implemented it might raise some (valid) objections. Basically, I
replaced all uses of the global taint variables (but not PL_taint_warn!)
with an extra layer of get/set macros (TAINT_get/TAINTING_get).
Furthermore, the change is not complete:

- PL_taint_warn would likely deserve the same treatment.
- Obviously, tests fail. We have tests for -t/-T
- Right now, I added a Perl warn() on startup when -t/-T are detected
  but the perl was not compiled support it. It might be argued that it
  should be silently ignored! Needs some thinking.
- Code quality concerns - needs review.
- Configure support required.
- Needs thinking: How does this tie in with CPAN XS modules that use
  PL_taint and friends? It's easy to backport the new macros via PPPort,
  but that doesn't magically change all code out there. Might be
  harmless, though, because whenever you're running under
  NO_TAINT_SUPPORT, any check of PL_taint/etc is going to come up false.
  Thus, the only CPAN code that SHOULD be adversely affected is code
  that changes taint state.

diff --git a/dist/Cwd/t/taint.t b/dist/Cwd/t/taint.t
index 60cbfeb..309b3e5 100644 (file)
--- a/dist/Cwd/t/taint.t
+++ b/dist/Cwd/t/taint.t
@@ -8,7 +8,14 @@ chdir 't' unless $ENV{PERL_CORE};
 
 use File::Spec;
 use lib File::Spec->catdir('t', 'lib');
-use Test::More tests => 17;
+use Test::More;
+BEGIN {
+    plan(
+        ${^TAINT}
+        ? (tests => 17)
+        : (skip_all => "A perl without taint support")
+    );
+}
 
 use Scalar::Util qw/tainted/;
 

diff --git a/dist/IO/t/io_taint.t b/dist/IO/t/io_taint.t
index 3cbe303..5740353 100644 (file)
--- a/dist/IO/t/io_taint.t
+++ b/dist/IO/t/io_taint.t
@@ -3,7 +3,10 @@
 use Config;
 
 BEGIN {
-    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+    if ($ENV{PERL_CORE}
+        and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS'
+        or not ${^TAINT}) # not ${^TAINT} => perl without taint support
+    {
        print "1..0\n";
        exit 0;
     }

diff --git a/dist/Locale-Maketext/t/09_compile.t b/dist/Locale-Maketext/t/09_compile.t
index 06db484..d03ba9f 100644 (file)
--- a/dist/Locale-Maketext/t/09_compile.t
+++ b/dist/Locale-Maketext/t/09_compile.t
@@ -13,7 +13,8 @@ my $tainted_value;
 do { $tainted_value = shift @ENV_values  } while(!$tainted_value || ref $tainted_value);
 $tainted_value =~ s/([\[\]])/~$1/g;
 
-ok(tainted($tainted_value), "\$tainted_value is tainted") or die('huh... %ENV has no entries? I don\'t know how to test taint without it');
+# If ${^TAINT} is not set despite -T, thsi perl doesn't have taint support
+ok(!${^TAINT} || tainted($tainted_value), "\$tainted_value is tainted") or die('huh... %ENV has no entries? I don\'t know how to test taint without it');
 
 my $result = Locale::Maketext::_compile("hello [_1]", $tainted_value);
 

diff --git a/doio.c b/doio.c
index e8eafdc..eedd374 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1599,11 +1599,11 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 
 #define APPLY_TAINT_PROPER() \
     STMT_START {                                                       \
-       if (PL_tainted) { TAINT_PROPER(what); }                         \
+       if (TAINT_get) { TAINT_PROPER(what); }                          \
     } STMT_END
 
     /* This is a first heuristic; it doesn't catch tainting magic. */
-    if (PL_tainting) {
+    if (TAINTING_get) {
        while (++mark <= sp) {
            if (SvTAINTED(*mark)) {
                TAINT;

diff --git a/doop.c b/doop.c
index c1d4fd4..f64ebb0 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -707,7 +707,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *delim, register SV **mark, register SV *
     /* sv_setpv retains old UTF8ness [perl #24846] */
     SvUTF8_off(sv);
 
-    if (PL_tainting && SvMAGICAL(sv))
+    if (TAINTING_get && SvMAGICAL(sv))
        SvTAINTED_off(sv);
 
     if (items-- > 0) {

diff --git a/dump.c b/dump.c
index 4eadad0..cdc3118 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -581,7 +581,7 @@ Perl_sv_peek(pTHX_ SV *sv)
   finish:
     while (unref--)
        sv_catpv(t, ")");
-    if (PL_tainting && SvTAINTED(sv))
+    if (TAINTING_get && SvTAINTED(sv))
        sv_catpv(t, " [tainted]");
     return SvPV_nolen(t);
 }
@@ -664,7 +664,7 @@ S_pm_description(pTHX_ const PMOP *pm)
 #endif
 
     if (regex) {
-        if (RX_EXTFLAGS(regex) & RXf_TAINTED)
+        if (RX_ISTAINTED(regex))
             sv_catpv(desc, ",TAINTED");
         if (RX_CHECK_SUBSTR(regex)) {
             if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))

diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 11217b0..c9af2d2 100644 (file)
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -550,8 +550,9 @@ do_test('scalar with pos magic',
 # VMS is setting FAKE and READONLY flags.  What VMS uses for storing
 # ENV hashes is also not always null terminated.
 #
-do_test('tainted value in %ENV',
-        $ENV{PATH}=@ARGV,  # scalar(@ARGV) is a handy known tainted value
+if (${^TAINT}) {
+  do_test('tainted value in %ENV',
+          $ENV{PATH}=@ARGV,  # scalar(@ARGV) is a handy known tainted value
 'SV = PVMG\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(GMG,SMG,RMG(?:,POK)?(?:,pIOK)?,pPOK\\)
@@ -577,6 +578,7 @@ do_test('tainted value in %ENV',
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_taint
     MG_TYPE = PERL_MAGIC_taint\\(t\\)');
+}
 
 do_test('blessed reference',
        bless(\\undef, 'Foobar'),

diff --git a/ext/File-Glob/t/taint.t b/ext/File-Glob/t/taint.t
index 3f49836..aab379b 100644 (file)
--- a/ext/File-Glob/t/taint.t
+++ b/ext/File-Glob/t/taint.t
@@ -10,7 +10,14 @@ BEGIN {
     }
 }
 
-use Test::More tests => 2;
+use Test::More;
+BEGIN {
+    plan(
+        ${^TAINT}
+        ? (skip_all => "Appear to running a perl without taint support")
+        : (tests => 2)
+    );
+}
 
 BEGIN {
     use_ok('File::Glob');

diff --git a/ext/POSIX/t/taint.t b/ext/POSIX/t/taint.t
index 3ca0174..5a960c7 100644 (file)
--- a/ext/POSIX/t/taint.t
+++ b/ext/POSIX/t/taint.t
@@ -8,9 +8,16 @@ BEGIN {
     }
 }
 
-use Test::More tests => 7;
-use Scalar::Util qw/tainted/;
+use Test::More;
+BEGIN {
+    plan(
+        ${^TAINT}
+        ? (tests => 7)
+        : (skip_all => "A perl without taint support")
+    );
+}
 
+use Scalar::Util qw/tainted/;
 
 use POSIX qw(fcntl_h open read mkfifo);
 use strict ;

diff --git a/hv.c b/hv.c
index 0375a94..ddefd65 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -526,13 +526,13 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            bool needs_store;
            hv_magic_check (hv, &needs_copy, &needs_store);
            if (needs_copy) {
-               const bool save_taint = PL_tainted;
+               const bool save_taint = TAINT_get; /* Unused var warning under NO_TAINT_SUPPORT */
                if (keysv || is_utf8) {
                    if (!keysv) {
                        keysv = newSVpvn_utf8(key, klen, TRUE);
                    }
-                   if (PL_tainting)
-                       PL_tainted = SvTAINTED(keysv);
+                   if (TAINTING_get)
+                       TAINT_set(SvTAINTED(keysv));
                    keysv = sv_2mortal(newSVsv(keysv));
                    mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY);
                } else {

diff --git a/lib/File/Basename.t b/lib/File/Basename.t
index 0d3b633..6ff3121 100644 (file)
--- a/lib/File/Basename.t
+++ b/lib/File/Basename.t
@@ -154,7 +154,9 @@ can_ok( __PACKAGE__, qw( basename fileparse dirname fileparse_set_fstype ) );
 
 
 ### Test tainting
-{
+SKIP: {
+    skip "A perl without taint support", 2
+        if not ${^TAINT};
     #   The empty tainted value, for tainting strings
     my $TAINT = substr($^X, 0, 0);
 

diff --git a/lib/File/Find/t/taint.t b/lib/File/Find/t/taint.t
index d47b21a..f696a43 100644 (file)
--- a/lib/File/Find/t/taint.t
+++ b/lib/File/Find/t/taint.t
@@ -1,12 +1,19 @@
 #!./perl -T
 use strict;
+use Test::More;
+BEGIN {
+    plan(
+        ${^TAINT}
+        ? (skip_all => "A perl without taint support") 
+        : (tests => 45)
+    );
+}
 
 my %Expect_File = (); # what we expect for $_
 my %Expect_Name = (); # what we expect for $File::Find::name/fullname
 my %Expect_Dir  = (); # what we expect for $File::Find::dir
 my ($cwd, $cwd_untainted);
 
-
 BEGIN {
     require File::Spec;
     chdir 't' if -d 't';
@@ -42,8 +49,6 @@ BEGIN {
     $ENV{'PATH'} = join($sep,@path);
 }
 
-use Test::More tests => 45;
-
 my $symlink_exists = eval { symlink("",""); 1 };
 
 use File::Find;

diff --git a/mg.c b/mg.c
index 89629a2..0cb6052 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -876,8 +876,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #endif
         }
        else if (strEQ(remaining, "AINT"))
-            sv_setiv(sv, PL_tainting
-                   ? (PL_taint_warn || PL_unsafe ? -1 : 1)
+            sv_setiv(sv, TAINTING_get
+                   ? (TAINT_WARN_get || PL_unsafe ? -1 : 1)
                    : 0);
         break;
     case '\025':               /* $^UNICODE, $^UTF8LOCALE, $^UTF8CACHE */
@@ -1132,7 +1132,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 #if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
-    if (PL_tainting) {
+    if (TAINTING_get) {
        MgTAINTEDDIR_off(mg);
 #ifdef VMS
        if (s && klen == 8 && strEQ(key, "DCL$PATH")) {
@@ -1832,7 +1832,7 @@ Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
      * fake up a temporary tainted value (this is easier than temporarily
      * re-enabling magic on sv). */
 
-    if (PL_tainting && (tmg = mg_find(sv, PERL_MAGIC_taint))
+    if (TAINTING_get && (tmg = mg_find(sv, PERL_MAGIC_taint))
        && (tmg->mg_len & 1))
     {
        val = sv_mortalcopy(sv);
@@ -2233,7 +2233,7 @@ Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_ARG(sv);
 
     /* update taint status */
-    if (PL_tainted)
+    if (TAINT_get)
        mg->mg_len |= 1;
     else
        mg->mg_len &= ~1;
@@ -2493,7 +2493,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            }
        }
        /* mg_set() has temporarily made sv non-magical */
-       if (PL_tainting) {
+       if (TAINTING_get) {
            if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1)
                SvTAINTED_on(PL_bodytarget);
            else

diff --git a/op.c b/op.c
index b67d4cb..e89f0a2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2831,7 +2831,7 @@ Perl_op_scope(pTHX_ OP *o)
 {
     dVAR;
     if (o) {
-       if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || PL_tainting) {
+       if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
            o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
            o->op_type = OP_LEAVE;
            o->op_ppaddr = PL_ppaddr[OP_LEAVE];
@@ -4677,8 +4677,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
         * preceding stacking ops;
         * OP_REGCRESET is there to reset taint before executing the
         * stacking ops */
-       if (pm->op_pmflags & PMf_KEEP || PL_tainting)
-           expr = newUNOP((PL_tainting ? OP_REGCRESET : OP_REGCMAYBE),0,expr);
+       if (pm->op_pmflags & PMf_KEEP || TAINTING_get)
+           expr = newUNOP((TAINTING_get ? OP_REGCRESET : OP_REGCMAYBE),0,expr);
 
        if (pm->op_pmflags & PMf_HAS_CV) {
            /* we have a runtime qr with literal code. This means
@@ -9094,9 +9094,9 @@ Perl_ck_index(pTHX_ OP *o)
        if (kid)
            kid = kid->op_sibling;                      /* get past "big" */
        if (kid && kid->op_type == OP_CONST) {
-           const bool save_taint = PL_tainted;
+           const bool save_taint = TAINT_get; /* accepted unused var warning if NO_TAINT_SUPPORT */
            fbm_compile(((SVOP*)kid)->op_sv, 0);
-           PL_tainted = save_taint;
+           TAINT_set(save_taint);
        }
     }
     return ck_fun(o);

diff --git a/os2/os2.c b/os2/os2.c
index 7dffd42..87f88e8 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1568,7 +1568,7 @@ my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args)
     /* `this' is what we use in the parent, `that' in the child. */
     this = (*mode == 'w');
     that = !this;
-    if (PL_tainting) {
+    if (TAINTING_get) {
        taint_env();
        taint_proper("Insecure %s%s", "EXEC");
     }

diff --git a/pad.c b/pad.c
index 673f8c7..258b39e 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1669,7 +1669,7 @@ S_pad_reset(pTHX)
            )
     );
 
-    if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
+    if (!TAINTING_get) {       /* Can't mix tainted and non-tainted temporaries. */
         I32 po;
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
            if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))

diff --git a/perl.c b/perl.c
index 44bd6a4..7bd9ab9 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1230,8 +1230,8 @@ perl_destruct(pTHXx)
        Safefree(psig_save);
     }
     nuke_stacks();
-    PL_tainting = FALSE;
-    PL_taint_warn = FALSE;
+    TAINTING_set(FALSE);
+    TAINT_WARN_set(FALSE);
     PL_hints = 0;              /* Reset hints. Should hints be per-interpreter ? */
     PL_debug = 0;
 
@@ -1594,7 +1594,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
        PL_do_undump = FALSE;
        cxstack_ix = -1;                /* start label stack again */
        init_ids();
-       assert (!PL_tainted);
+       assert (!TAINT_get);
        TAINT;
        S_set_caret_X(aTHX);
        TAINT_NOT;
@@ -1832,17 +1832,31 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            break;
 
        case 't':
+#if SILENT_NO_TAINT_SUPPORT
+            /* silently ignore */
+#elif NO_TAINT_SUPPORT
+            Perl_croak("This perl was compiled without taint support. "
+                       "Cowardly refusing to run with -t or -T flags");
+#else
            CHECK_MALLOC_TOO_LATE_FOR('t');
-           if( !PL_tainting ) {
-                PL_taint_warn = TRUE;
-                PL_tainting = TRUE;
+           if( !TAINTING_get ) {
+                TAINT_WARN_set(TRUE);
+                TAINTING_set(TRUE);
            }
+#endif
            s++;
            goto reswitch;
        case 'T':
+#if SILENT_NO_TAINT_SUPPORT
+            /* silently ignore */
+#elif NO_TAINT_SUPPORT
+            Perl_croak("This perl was compiled without taint support. "
+                       "Cowardly refusing to run with -t or -T flags");
+#else
            CHECK_MALLOC_TOO_LATE_FOR('T');
-           PL_tainting = TRUE;
-           PL_taint_warn = FALSE;
+           TAINTING_set(TRUE);
+           TAINT_WARN_set(FALSE);
+#endif
            s++;
            goto reswitch;
 
@@ -1943,16 +1957,23 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     if (
 #ifndef SECURE_INTERNAL_GETENV
-        !PL_tainting &&
+        !TAINTING_get &&
 #endif
        (s = PerlEnv_getenv("PERL5OPT")))
     {
        while (isSPACE(*s))
            s++;
        if (*s == '-' && *(s+1) == 'T') {
+#if SILENT_NO_TAINT_SUPPORT
+            /* silently ignore */
+#elif NO_TAINT_SUPPORT
+            Perl_croak("This perl was compiled without taint support. "
+                       "Cowardly refusing to run with -t or -T flags");
+#else
            CHECK_MALLOC_TOO_LATE_FOR('T');
-           PL_tainting = TRUE;
-            PL_taint_warn = FALSE;
+           TAINTING_set(TRUE);
+            TAINT_WARN_set(FALSE);
+#endif
        }
        else {
            char *popt_copy = NULL;
@@ -1982,10 +2003,17 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                    }
                }
                if (*d == 't') {
-                   if( !PL_tainting ) {
-                       PL_taint_warn = TRUE;
-                       PL_tainting = TRUE;
+#if SILENT_NO_TAINT_SUPPORT
+            /* silently ignore */
+#elif NO_TAINT_SUPPORT
+                    Perl_croak("This perl was compiled without taint support. "
+                               "Cowardly refusing to run with -t or -T flags");
+#else
+                   if( !TAINTING_get) {
+                       TAINT_WARN_set(TRUE);
+                       TAINTING_set(TRUE);
                    }
+#endif
                } else {
                    moreswitches(d);
                }
@@ -1996,7 +2024,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     /* Set $^X early so that it can be used for relocatable paths in @INC  */
     /* and for SITELIB_EXP in USE_SITECUSTOMIZE                            */
-    assert (!PL_tainted);
+    assert (!TAINT_get);
     TAINT;
     S_set_caret_X(aTHX);
     TAINT_NOT;
@@ -2052,7 +2080,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        scriptname = "-";
     }
 
-    assert (!PL_tainted);
+    assert (!TAINT_get);
     init_perllib();
 
     {
@@ -2195,7 +2223,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #ifdef PERL_MAD
     {
        const char *s;
-    if (!PL_tainting &&
+    if (!TAINTING_get &&
         (s = PerlEnv_getenv("PERL_XMLDUMP"))) {
        PL_madskills = 1;
        PL_minus_c = 1;
@@ -3299,8 +3327,15 @@ Perl_moreswitches(pTHX_ const char *s)
        return s;
     case 't':
     case 'T':
-        if (!PL_tainting)
+#if SILENT_NO_TAINT_SUPPORT
+            /* silently ignore */
+#elif NO_TAINT_SUPPORT
+        Perl_croak("This perl was compiled without taint support. "
+                   "Cowardly refusing to run with -t or -T flags");
+#else
+        if (!TAINTING_get)
            TOO_LATE_FOR(*s);
+#endif
         s++;
        return s;
     case 'u':
@@ -3796,6 +3831,9 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
 STATIC void
 S_init_ids(pTHX)
 {
+    /* no need to do anything here any more if we don't
+     * do tainting. */
+#if !NO_TAINT_SUPPORT
     dVAR;
     const UV my_uid = PerlProc_getuid();
     const UV my_euid = PerlProc_geteuid();
@@ -3804,7 +3842,8 @@ S_init_ids(pTHX)
 
     /* Should not happen: */
     CHECK_MALLOC_TAINT(my_uid && (my_euid != my_uid || my_egid != my_gid));
-    PL_tainting |= (my_uid && (my_euid != my_uid || my_egid != my_gid));
+    TAINTING_set( TAINTING_get | (my_uid && (my_euid != my_uid || my_egid != my_gid)) );
+#endif
     /* BUG */
     /* PSz 27 Feb 04
      * Should go by suidscript, not uid!=euid: why disallow
@@ -4221,7 +4260,7 @@ S_init_perllib(pTHX)
     STRLEN len;
 #endif
 
-    if (!PL_tainting) {
+    if (!TAINTING_get) {
 #ifndef VMS
        perl5lib = PerlEnv_getenv("PERL5LIB");
 /*
@@ -4337,7 +4376,7 @@ S_init_perllib(pTHX)
                      |INCPUSH_CAN_RELOCATE);
 #endif
 
-    if (!PL_tainting) {
+    if (!TAINTING_get) {
 #ifndef VMS
 /*
  * It isn't possible to delete an environment variable with
@@ -4394,7 +4433,7 @@ S_init_perllib(pTHX)
 #endif
 #endif /* !PERL_IS_MINIPERL */
 
-    if (!PL_tainting)
+    if (!TAINTING_get)
        S_incpush(aTHX_ STR_WITH_LEN("."), 0);
 }
 
@@ -4560,7 +4599,7 @@ S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags)
                    SvREFCNT_dec(libdir);
                    /* And this is the new libdir.  */
                    libdir = tempsv;
-                   if (PL_tainting &&
+                   if (TAINTING_get &&
                        (PerlProc_getuid() != PerlProc_geteuid() ||
                         PerlProc_getgid() != PerlProc_getegid())) {
                        /* Need to taint relocated paths if running set ID  */

diff --git a/perl.h b/perl.h
index ae84dba..f187eba 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -528,11 +528,51 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   define VOL
 #endif
 
-#define TAINT          (PL_tainted = TRUE)
-#define TAINT_NOT      (PL_tainted = FALSE)
-#define TAINT_IF(c)    if (c) { PL_tainted = TRUE; }
-#define TAINT_ENV()    if (PL_tainting) { taint_env(); }
-#define TAINT_PROPER(s)        if (PL_tainting) { taint_proper(NULL, s); }
+/* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT,
+ * you get a perl without taint support, but doubtlessly with a lesser
+ * degree of support. Do not do so unless you know exactly what it means
+ * technically, have a good reason to do so, and know exactly how the
+ * perl will be used. perls with -DSILENT_NO_TAINT_SUPPORT are considered
+ * a potential security risk due to flat out ignoring the security-relevant
+ * taint flags. This being said, a perl without taint support compiled in
+ * has marginal run-time performance benefits.
+ * SILENT_NO_TAINT_SUPPORT implies NO_TAINT_SUPPORT.
+ * SILENT_NO_TAINT_SUPPORT is the same as NO_TAINT_SUPPORT except it
+ * silently ignores -t/-T instead of throwing an exception.
+ */
+#if SILENT_NO_TAINT_SUPPORT && !defined(NO_TAINT_SUPPORT)
+#  define NO_TAINT_SUPPORT 1
+#endif
+
+/* NO_TAINT_SUPPORT can be set to transform virtually all taint-related
+ * operations into no-ops for a very modest speed-up. Enable only if you
+ * know what you're doing: tests and CPAN modules' tests are bound to fail.
+ */
+#if NO_TAINT_SUPPORT
+#   define TAINT               NOOP
+#   define TAINT_NOT           NOOP
+#   define TAINT_IF(c)         NOOP
+#   define TAINT_ENV()         NOOP
+#   define TAINT_PROPER(s)     NOOP
+#   define TAINT_set(s)                NOOP
+#   define TAINT_get           0
+#   define TAINTING_get                0
+#   define TAINTING_set(s)     NOOP
+#   define TAINT_WARN_get       0
+#   define TAINT_WARN_set(s)    NOOP
+#else
+#   define TAINT               (PL_tainted = TRUE)
+#   define TAINT_NOT   (PL_tainted = FALSE)
+#   define TAINT_IF(c) if (c) { PL_tainted = TRUE; }
+#   define TAINT_ENV() if (PL_tainting) { taint_env(); }
+#   define TAINT_PROPER(s)     if (PL_tainting) { taint_proper(NULL, s); }
+#   define TAINT_set(s)                (PL_tainted = (s))
+#   define TAINT_get           (PL_tainted)
+#   define TAINTING_get                (PL_tainting)
+#   define TAINTING_set(s)     (PL_tainting = (s))
+#   define TAINT_WARN_get       (PL_taint_warn)
+#   define TAINT_WARN_set(s)    (PL_taint_warn = (s))
+#endif
 
 /* flags used internally only within pp_subst and pp_substcont */
 #ifdef PERL_CORE

diff --git a/perlio.c b/perlio.c
index 4ad6ada..0b5b411 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -450,7 +450,7 @@ PerlIO_debug(const char *fmt, ...)
     dSYS;
     va_start(ap, fmt);
     if (!PL_perlio_debug_fd) {
-       if (!PL_tainting &&
+       if (!TAINTING_get &&
            PerlProc_getuid() == PerlProc_geteuid() &&
            PerlProc_getgid() == PerlProc_getegid()) {
            const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
@@ -1155,7 +1155,7 @@ PerlIO_default_layers(pTHX)
 {
     dVAR;
     if (!PL_def_layerlist) {
-       const char * const s = (PL_tainting) ? NULL : PerlEnv_getenv("PERLIO");
+       const char * const s = TAINTING_get ? NULL : PerlEnv_getenv("PERLIO");
        PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix;
        PL_def_layerlist = PerlIO_list_alloc(aTHX);
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix));
@@ -5014,7 +5014,7 @@ PerlIO_tmpfile(void)
 #    if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
      int fd = -1;
      char tempname[] = "/tmp/PerlIO_XXXXXX";
-     const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR");
+     const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR");
      SV * sv = NULL;
      /*
       * I have no idea how portable mkstemp() is ... NI-S

diff --git a/pp_ctl.c b/pp_ctl.c
index 9c4120a..0ca5f2b 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -129,7 +129,7 @@ PP(pp_regcomp)
           some day. */
        if (pm->op_type == OP_MATCH) {
            SV *lhs;
-           const bool was_tainted = PL_tainted;
+           const bool was_tainted = TAINT_get;
            if (pm->op_flags & OPf_STACKED)
                lhs = args[-1];
            else if (pm->op_private & OPpTARGET_MY)
@@ -138,8 +138,8 @@ PP(pp_regcomp)
            SvGETMAGIC(lhs);
            /* Restore the previous value of PL_tainted (which may have been
               modified by get-magic), to avoid incorrectly setting the
-              RXf_TAINTED flag further down. */
-           PL_tainted = was_tainted;
+              RXf_TAINTED flag with RX_TAINT_on further down. */
+           TAINT_set(was_tainted);
        }
        tmp = reg_temp_copy(NULL, new_re);
        ReREFCNT_dec(new_re);
@@ -151,9 +151,9 @@ PP(pp_regcomp)
     }
 
 #ifndef INCOMPLETE_TAINTS
-    if (PL_tainting && PL_tainted) {
+    if (TAINTING_get && TAINT_get) {
        SvTAINTED_on((SV*)new_re);
-       RX_EXTFLAGS(new_re) |= RXf_TAINTED;
+        RX_TAINT_on(new_re);
     }
 #endif
 
@@ -259,7 +259,7 @@ PP(pp_substcont)
            /* update the taint state of various various variables in
             * preparation for final exit.
             * See "how taint works" above pp_subst() */
-           if (PL_tainting) {
+           if (TAINTING_get) {
                if ((cx->sb_rxtainted & SUBST_TAINT_PAT) ||
                    ((cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
                                    == (SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
@@ -271,8 +271,10 @@ PP(pp_substcont)
                )
                    SvTAINTED_on(TOPs);  /* taint return value */
                /* needed for mg_set below */
-               PL_tainted = cBOOL(cx->sb_rxtainted &
-                           (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL));
+               TAINT_set(
+                    cBOOL(cx->sb_rxtainted &
+                         (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL))
+                );
                SvTAINT(TARG);
            }
            /* PL_tainted must be correctly set for this mg_set */
@@ -321,7 +323,7 @@ PP(pp_substcont)
     /* update the taint state of various various variables in preparation
      * for calling the code block.
      * See "how taint works" above pp_subst() */
-    if (PL_tainting) {
+    if (TAINTING_get) {
        if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
            cx->sb_rxtainted |= SUBST_TAINT_PAT;
 

diff --git a/pp_hot.c b/pp_hot.c
index a1c9579..212fe5f 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -122,7 +122,7 @@ PP(pp_sassign)
        SV * const temp = left;
        left = right; right = temp;
     }
-    if (PL_tainting && PL_tainted && !SvTAINTED(right))
+    if (TAINTING_get && TAINT_get && !SvTAINTED(right))
        TAINT_NOT;
     if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
        SV * const cv = SvRV(right);
@@ -1142,7 +1142,7 @@ PP(pp_aassign)
            tmp_gid  = PerlProc_getgid();
            tmp_egid = PerlProc_getegid();
        }
-       PL_tainting |= (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid));
+       TAINTING_set( TAINTING_get | (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid)) );
     }
     PL_delaymagic = 0;
 
@@ -1217,7 +1217,7 @@ PP(pp_qr)
        (void)sv_bless(rv, stash);
     }
 
-    if (RX_EXTFLAGS(rx) & RXf_TAINTED) {
+    if (RX_ISTAINTED(rx)) {
         SvTAINTED_on(rv);
         SvTAINTED_on(SvRV(rv));
     }
@@ -1264,8 +1264,8 @@ PP(pp_match)
     if (!s)
        DIE(aTHX_ "panic: pp_match");
     strend = s + len;
-    rxtainted = ((RX_EXTFLAGS(rx) & RXf_TAINTED) ||
-                (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
+    rxtainted = (RX_ISTAINTED(rx) ||
+                (TAINT_get && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
 
     RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
@@ -1976,14 +1976,19 @@ PP(pp_iter)
 /*
 A description of how taint works in pattern matching and substitution.
 
+This is all conditional on NO_TAINT_SUPPORT not being defined. Under
+NO_TAINT_SUPPORT, taint-related operations should become no-ops.
+
 While the pattern is being assembled/concatenated and then compiled,
-PL_tainted will get set if any component of the pattern is tainted, e.g.
-/.*$tainted/.  At the end of pattern compilation, the RXf_TAINTED flag
-is set on the pattern if PL_tainted is set.
+PL_tainted will get set (via TAINT_set) if any component of the pattern
+is tainted, e.g. /.*$tainted/.  At the end of pattern compilation,
+the RXf_TAINTED flag is set on the pattern if PL_tainted is set (via
+TAINT_get).
 
 When the pattern is copied, e.g. $r = qr/..../, the SV holding the ref to
 the pattern is marked as tainted. This means that subsequent usage, such
-as /x$r/, will set PL_tainted, and thus RXf_TAINTED, on the new pattern too.
+as /x$r/, will set PL_tainted using TAINT_set, and thus RXf_TAINTED,
+on the new pattern too.
 
 During execution of a pattern, locale-variant ops such as ALNUML set the
 local flag RF_tainted. At the end of execution, the engine sets the
@@ -2111,10 +2116,10 @@ PP(pp_subst)
     once = !(rpm->op_pmflags & PMf_GLOBAL);
 
     /* See "how taint works" above */
-    if (PL_tainting) {
+    if (TAINTING_get) {
        rxtainted  = (
            (SvTAINTED(TARG) ? SUBST_TAINT_STR : 0)
-         | ((RX_EXTFLAGS(rx) & RXf_TAINTED) ? SUBST_TAINT_PAT : 0)
+         | (RX_ISTAINTED(rx) ? SUBST_TAINT_PAT : 0)
          | ((pm->op_pmflags & PMf_RETAINT) ? SUBST_TAINT_RETAINT : 0)
          | ((once && !(rpm->op_pmflags & PMf_NONDESTRUCT))
                ? SUBST_TAINT_BOOLRET : 0));
@@ -2402,7 +2407,7 @@ PP(pp_subst)
     }
 
     /* See "how taint works" above */
-    if (PL_tainting) {
+    if (TAINTING_get) {
        if ((rxtainted & SUBST_TAINT_PAT) ||
            ((rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) ==
                                (SUBST_TAINT_STR|SUBST_TAINT_RETAINT))
@@ -2417,8 +2422,9 @@ PP(pp_subst)
            SvTAINTED_off(TOPs);  /* may have got tainted earlier */
 
        /* needed for mg_set below */
-       PL_tainted =
-         cBOOL(rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL));
+       TAINT_set(
+         cBOOL(rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL))
+        );
        SvTAINT(TARG);
     }
     SvSETMAGIC(TARG); /* PL_tainted must be correctly set for this mg_set */

diff --git a/pp_sys.c b/pp_sys.c
index 3a034b3..57679eb 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -387,7 +387,7 @@ PP(pp_glob)
     ENTER_with_name("glob");
 
 #ifndef VMS
-    if (PL_tainting) {
+    if (TAINTING_get) {
        /*
         * The external globbing program may use things we can't control,
         * so for security reasons we must assume the worst.
@@ -4138,11 +4138,11 @@ PP(pp_system)
     I32 value;
     int result;
 
-    if (PL_tainting) {
+    if (TAINTING_get) {
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
-           if (PL_tainted)
+           if (TAINT_get)
                break;
        }
        MARK = ORIGMARK;
@@ -4285,11 +4285,11 @@ PP(pp_exec)
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
 
-    if (PL_tainting) {
+    if (TAINTING_get) {
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
-           if (PL_tainted)
+           if (TAINT_get)
                break;
        }
        MARK = ORIGMARK;
@@ -5435,7 +5435,7 @@ PP(pp_syscall)
     I32 i = 0;
     IV retval = -1;
 
-    if (PL_tainting) {
+    if (TAINTING_get) {
        while (++MARK <= SP) {
            if (SvTAINTED(*MARK)) {
                TAINT;

diff --git a/regcomp.c b/regcomp.c
index 3002749..dbb8306 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5762,7 +5762,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     RExC_pm_flags = pm_flags;
 
     if (runtime_code) {
-       if (PL_tainting && PL_tainted)
+       if (TAINTING_get && TAINT_get)
            Perl_croak(aTHX_ "Eval-group in insecure regular expression");
 
        if (!S_compile_runtime_code(aTHX_ pRExC_state, exp, plen)) {
@@ -6743,10 +6743,14 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren,
     assert(s >= rx->subbeg);
     assert(rx->sublen >= (s - rx->subbeg) + i );
     if (i >= 0) {
-        const int oldtainted = PL_tainted;
+#if NO_TAINT_SUPPORT
+        sv_setpvn(sv, s, i);
+#else
+        const int oldtainted = TAINT_get;
         TAINT_NOT;
         sv_setpvn(sv, s, i);
-        PL_tainted = oldtainted;
+        TAINT_set(oldtainted);
+#endif
         if ( (rx->extflags & RXf_CANY_SEEN)
             ? (RXp_MATCH_UTF8(rx)
                         && (!i || is_utf8_string((U8*)s, i)))
@@ -6756,12 +6760,12 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren,
         }
         else
             SvUTF8_off(sv);
-        if (PL_tainting) {
+        if (TAINTING_get) {
             if (RXp_MATCH_TAINTED(rx)) {
                 if (SvTYPE(sv) >= SVt_PVMG) {
                     MAGIC* const mg = SvMAGIC(sv);
                     MAGIC* mgt;
-                    PL_tainted = 1;
+                    TAINT;
                     SvMAGIC_set(sv, mg->mg_moremagic);
                     SvTAINT(sv);
                     if ((mgt = SvMAGIC(sv))) {
@@ -6769,7 +6773,7 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren,
                         SvMAGIC_set(sv, mg);
                     }
                 } else {
-                    PL_tainted = 1;
+                    TAINT;
                     SvTAINT(sv);
                 }
             } else 

diff --git a/regexp.h b/regexp.h
index a462001..5b07a26 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -435,6 +435,14 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
  *
  */
 
+#if NO_TAINT_SUPPORT
+#   define RX_ISTAINTED(prog)    0
+#   define RX_TAINT_on(prog)     NOOP
+#else
+#   define RX_ISTAINTED(prog)    (RX_EXTFLAGS(prog) & RXf_TAINTED)
+#   define RX_TAINT_on(prog)     (RX_EXTFLAGS(prog) |= RXf_TAINTED)
+#endif
+
 #define RX_HAS_CUTGROUP(prog) ((prog)->intflags & PREGf_CUTGROUP_SEEN)
 #define RXp_MATCH_TAINTED(prog)        (RXp_EXTFLAGS(prog) & RXf_TAINTED_SEEN)
 #define RX_MATCH_TAINTED(prog) (RX_EXTFLAGS(prog) & RXf_TAINTED_SEEN)

diff --git a/scope.c b/scope.c
index c767571..e93517a 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -713,7 +713,7 @@ Perl_leave_scope(pTHX_ I32 base)
     char* str;
     I32 i;
     /* Localise the effects of the TAINT_NOT inside the loop.  */
-    bool was = PL_tainted;
+    bool was = TAINT_get;
 
     if (base < -1)
        Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base);
@@ -817,8 +817,8 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_BOOL:                        /* bool reference */
            ptr = SSPOPPTR;
            *(bool*)ptr = cBOOL(uv >> 8);
-
-           if (ptr == &PL_tainted) {
+#if !NO_TAINT_SUPPORT
+           if (ptr == TAINT_get) {
                /* If we don't update <was>, to reflect what was saved on the
                 * stack for PL_tainted, then we will overwrite this attempt to
                 * restore it when we exit this routine.  Note that this won't
@@ -826,6 +826,7 @@ Perl_leave_scope(pTHX_ I32 base)
                 * such as I32 */
                was = *(bool*)ptr;
            }
+#endif
            break;
        case SAVEt_I32_SMALL:
            ptr = SSPOPPTR;
@@ -1177,7 +1178,7 @@ Perl_leave_scope(pTHX_ I32 base)
        }
     }
 
-    PL_tainted = was;
+    TAINT_set(was);
 
     PERL_ASYNC_CHECK();
 }

diff --git a/sv.c b/sv.c
index d6bc23e..360de04 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12948,9 +12948,14 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origargc                = proto_perl->Iorigargc;
     PL_origargv                = proto_perl->Iorigargv;
 
+#if !NO_TAINT_SUPPORT
     /* Set tainting stuff before PerlIO_debug can possibly get called */
     PL_tainting                = proto_perl->Itainting;
     PL_taint_warn      = proto_perl->Itaint_warn;
+#else
+    PL_tainting         = FALSE;
+    PL_taint_warn      = FALSE;
+#endif
 
     PL_minus_c         = proto_perl->Iminus_c;
 
@@ -13123,7 +13128,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_timesbuf                = proto_perl->Itimesbuf;
 #endif
 
+#if !NO_TAINT_SUPPORT
     PL_tainted         = proto_perl->Itainted;
+#else
+    PL_tainted          = FALSE;
+#endif
     PL_curpm           = proto_perl->Icurpm;   /* XXX No PMOP ref count */
 
     PL_chopset         = proto_perl->Ichopset; /* XXX never deallocated */

diff --git a/sv.h b/sv.h
index bd9ae1f..d159334 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1442,14 +1442,18 @@ attention to precisely which outputs are influenced by which inputs.
 
 #define sv_taint(sv)     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0)
 
-#define SvTAINTED(sv)    (SvMAGICAL(sv) && sv_tainted(sv))
-#define SvTAINTED_on(sv)  STMT_START{ if(PL_tainting){sv_taint(sv);}   }STMT_END
-#define SvTAINTED_off(sv) STMT_START{ if(PL_tainting){sv_untaint(sv);} }STMT_END
+#if NO_TAINT_SUPPORT
+#   define SvTAINTED(sv) 0
+#else
+#   define SvTAINTED(sv)         (SvMAGICAL(sv) && sv_tainted(sv))
+#endif
+#define SvTAINTED_on(sv)  STMT_START{ if(TAINTING_get){sv_taint(sv);}   }STMT_END
+#define SvTAINTED_off(sv) STMT_START{ if(TAINTING_get){sv_untaint(sv);} }STMT_END
 
 #define SvTAINT(sv)                    \
     STMT_START {                       \
-       if (PL_tainting) {              \
-           if (PL_tainted)             \
+       if (TAINTING_get) {             \
+           if (TAINT_get)              \
                SvTAINTED_on(sv);       \
        }                               \
     } STMT_END

diff --git a/taint.c b/taint.c
index 4631b66..9a296db 100644 (file)
--- a/taint.c
+++ b/taint.c
@@ -38,7 +38,7 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s)
 
        DEBUG_u(PerlIO_printf(Perl_debug_log,
                               "%s %d %"UVuf" %"UVuf"\n",
-                              s, PL_tainted, uid, euid));
+                              s, TAINT_get, uid, euid));
     }
 #   else
     {
@@ -47,12 +47,12 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s)
 
        DEBUG_u(PerlIO_printf(Perl_debug_log,
                               "%s %d %"IVdf" %"IVdf"\n",
-                              s, PL_tainted, uid, euid));
+                              s, TAINT_get, uid, euid));
     }
 #   endif
 #endif
 
-    if (PL_tainted) {
+    if (TAINT_get) {
        const char *ug;
 
        if (!f)
@@ -61,11 +61,11 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s)
            ug = " while running setuid";
        else if (PerlProc_getgid() != PerlProc_getegid())
            ug = " while running setgid";
-       else if (PL_taint_warn)
+       else if (TAINT_WARN_get)
             ug = " while running with -t switch";
         else
            ug = " while running with -T switch";
-       if (PL_unsafe || PL_taint_warn) {
+       if (PL_unsafe || TAINT_WARN_get) {
            Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug);
         }
         else {
@@ -95,13 +95,13 @@ Perl_taint_env(pTHX)
     /* Don't bother if there's no *ENV glob */
     if (!PL_envgv)
        return;
-    /* If there's no %ENV hash of if it's not magical, croak, because
+    /* If there's no %ENV hash or if it's not magical, croak, because
      * it probably doesn't reflect the actual environment */
     if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
            && mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) {
-       const bool was_tainted = PL_tainted;
+       const bool was_tainted = TAINT_get;
        const char * const name = GvENAME(PL_envgv);
-       PL_tainted = TRUE;
+       TAINT;
        if (strEQ(name,"ENV"))
            /* hash alias */
            taint_proper("%%ENV is aliased to %s%s", "another variable");
@@ -109,7 +109,7 @@ Perl_taint_env(pTHX)
            /* glob alias: report it in the error message */
            taint_proper("%%ENV is aliased to %%%s%s", name);
        /* this statement is reached under -t or -U */
-       PL_tainted = was_tainted;
+       TAINT_set(was_tainted);
     }
 
 #ifdef VMS
@@ -154,10 +154,10 @@ Perl_taint_env(pTHX)
     svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE);
     if (svp && *svp && SvTAINTED(*svp)) {
        STRLEN len;
-       const bool was_tainted = PL_tainted;
+       const bool was_tainted = TAINT_get;
        const char *t = SvPV_const(*svp, len);
        const char * const e = t + len;
-       PL_tainted = was_tainted;
+       TAINT_set(was_tainted);
        if (t < e && isALNUM(*t))
            t++;
        while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))

diff --git a/utf8.c b/utf8.c
index fc9bfaf..6a01cf6 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -2867,8 +2867,10 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
             * PL_tainted to 1 while saving $1 etc (see the code after getrx:
             * in Perl_magic_get).  Even line to create errsv_save can turn on
             * PL_tainted.  */
-           SAVEBOOL(PL_tainted);
-           PL_tainted = 0;
+#ifndef NO_TAINT_SUPPORT
+           SAVEBOOL(TAINT_get);
+           TAINT_NOT;
+#endif
            Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
                             NULL);
            if (!SvTRUE(ERRSV))

diff --git a/util.c b/util.c
index a8cd6fe..e684075 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2488,7 +2488,7 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
     PERL_FLUSHALL_FOR_CHILD;
     This = (*mode == 'w');
     that = !This;
-    if (PL_tainting) {
+    if (TAINTING_get) {
        taint_env();
        taint_proper("Insecure %s%s", "EXEC");
     }
@@ -2634,7 +2634,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
 #endif
     This = (*mode == 'w');
     that = !This;
-    if (doexec && PL_tainting) {
+    if (doexec && TAINTING_get) {
        taint_env();
        taint_proper("Insecure %s%s", "EXEC");
     }
@@ -6366,7 +6366,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
     dVAR;
     SV * const dbsv = GvSVn(PL_DBsub);
-    const bool save_taint = PL_tainted;
+    const bool save_taint = TAINT_get; /* Accepted unused var warning under NO_TAINT_SUPPORT */
 
     /* When we are called from pp_goto (svp is null),
      * we do not care about using dbsv to call CV;
@@ -6375,7 +6375,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
 
     PERL_ARGS_ASSERT_GET_DB_SUB;
 
-    PL_tainted = FALSE;
+    TAINT_set(FALSE);
     save_item(dbsv);
     if (!PERLDB_SUB_NN) {
        GV *gv = CvGV(cv);

diff --git a/vms/vms.c b/vms/vms.c
index d731b6a..6d6e527 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1072,7 +1072,7 @@ int Perl_my_trnlnm(pTHX_ const char *lnm, char *eqv, unsigned long int idx)
     if (aTHX != NULL)
 #endif
 #ifdef SECURE_INTERNAL_GETENV
-        flags = (PL_curinterp ? PL_tainting : will_taint) ?
+        flags = (PL_curinterp ? TAINTING_get : will_taint) ?
                  PERL__TRNENV_SECURE : 0;
 #endif
 
@@ -1145,7 +1145,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
       /* Impose security constraints only if tainting */
       if (sys) {
         /* Impose security constraints only if tainting */
-        secure = PL_curinterp ? PL_tainting : will_taint;
+        secure = PL_curinterp ? TAINTING_get : will_taint;
         saverr = errno;  savvmserr = vaxc$errno;
       }
       else {
@@ -1244,7 +1244,7 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
     else {
       if (sys) {
         /* Impose security constraints only if tainting */
-        secure = PL_curinterp ? PL_tainting : will_taint;
+        secure = PL_curinterp ? TAINTING_get : will_taint;
         saverr = errno;  savvmserr = vaxc$errno;
       }
       else {