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.

1 files changed, 62 insertions, 23 deletions

diff --git a/perl.c b/perl.c
index 44bd6a4722..7bd9ab96cd 100644
--- 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  */