Add a new taint error, "%ENV is aliased to %s".

This error is thrown when taint checks are enabled and
when *ENV has been aliased, so that %ENV has no env-magic
anymore. (see bug [perl #24291].)

p4raw-id: //depot/perl@21563

3 files changed, 31 insertions, 14 deletions

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index b75793a91a..2b98439fa0 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1387,6 +1387,12 @@ a regular expression without specifying the property name.
 (F) While under the C<use filetest> pragma, switching the real and
 effective uids or gids failed.
 
+=item %ENV is aliased to %s
+
+(F) You're running under taint mode, and the C<%ENV> variable has been
+aliased to another hash, so it doesn't reflect anymore the state of the
+program's environment. This is potentially insecure.
+
 =item Error converting file specification %s
 
 (F) An error peculiar to VMS.  Because Perl may have to deal with file
diff --git a/t/op/taint.t b/t/op/taint.t
index 557b15f20c..e7740fe7f0 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -984,13 +984,12 @@ else
 }
 
 {
-    # test with a non-magical %ENV (and non-magical %ENV elements)
-    our %nonmagicalenv = ( PATH => $TAINT );
+    # [perl #24291] this used to dump core
+    our %nonmagicalenv = ( PATH => "util" );
     local *ENV = \%nonmagicalenv;
     eval { system("lskdfj"); };
-    test 207, $@ =~ /Insecure \$ENV{PATH} while running with -T switch/;
-    # [perl #24291] this used to dump core
-    %nonmagicalenv = ( PATH => "util" );
+    test 207, $@ =~ /^%ENV is aliased to another variable while running with -T switch/;
+    local *ENV = *nonmagicalenv;
     eval { system("lskdfj"); };
-    test 208, 1;
+    test 208, $@ =~ /^%ENV is aliased to %nonmagicalenv while running with -T switch/;
 }
diff --git a/taint.c b/taint.c
index c591e3f186..2c2e66e8ec 100644
--- a/taint.c
+++ b/taint.c
@@ -80,9 +80,25 @@ Perl_taint_env(pTHX)
 	NULL
     };
 
-    /* Don't bother if there's no %ENV hash */
-    if (!PL_envgv || !GvHV(PL_envgv))
+    /* 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
+     * it probably doesn't reflect the actual environment */
+    if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
+	    && mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) {
+	bool was_tainted = PL_tainted;
+	char *name = GvENAME(PL_envgv);
+	PL_tainted = TRUE;
+	if (strEQ(name,"ENV"))
+	    /* hash alias */
+	    taint_proper("%%ENV is aliased to %s%s", "another variable");
+	else
+	    /* 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;
+    }
 
 #ifdef VMS
     {
@@ -99,9 +115,7 @@ Perl_taint_env(pTHX)
 	    TAINT;
 	    taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
 	}
-	if (SvMAGICAL(*svp)
-		&& (mg = mg_find(*svp, PERL_MAGIC_envelem))
-		&& MgTAINTEDDIR(mg)) {
+	if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
 	    TAINT;
 	    taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
 	}
@@ -116,9 +130,7 @@ Perl_taint_env(pTHX)
 	    TAINT;
 	    taint_proper("Insecure %s%s", "$ENV{PATH}");
 	}
-	if (SvMAGICAL(*svp)
-		&& (mg = mg_find(*svp, PERL_MAGIC_envelem))
-		&& MgTAINTEDDIR(mg)) {
+	if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
 	    TAINT;
 	    taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
 	}