Introduce (global) variable PL_earlytaint which

is set very early in main(), before perl_parse()
has been called and PL_tainting (or PL_taint_warn)
might have been set.

p4raw-id: //depot/perl@19863

8 files changed, 22 insertions, 13 deletions

diff --git a/embed.fnc b/embed.fnc
index 7ffdef7873..15647d0278 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -45,7 +45,7 @@ Anod	|void	|perl_free	|PerlInterpreter* interp
 Anod	|int	|perl_run	|PerlInterpreter* interp
 Anod	|int	|perl_parse	|PerlInterpreter* interp|XSINIT_t xsinit \
 				|int argc|char** argv|char** env
-np	|int	|doing_taint	|int argc|char** argv|char** env
+np	|bool	|doing_taint	|int argc|char** argv|char** env
 #if defined(USE_ITHREADS)
 Anod	|PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags
 #  if defined(PERL_IMPLICIT_SYS)
diff --git a/embedvar.h b/embedvar.h
index dcb980add3..f2a44e1c97 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -897,6 +897,7 @@
 #define PL_curinterp		(PL_Vars.Gcurinterp)
 #define PL_do_undump		(PL_Vars.Gdo_undump)
 #define PL_dollarzero_mutex	(PL_Vars.Gdollarzero_mutex)
+#define PL_earlytaint		(PL_Vars.Gearlytaint)
 #define PL_hexdigit		(PL_Vars.Ghexdigit)
 #define PL_malloc_mutex		(PL_Vars.Gmalloc_mutex)
 #define PL_op_mutex		(PL_Vars.Gop_mutex)
@@ -911,6 +912,7 @@
 #define PL_Gcurinterp		PL_curinterp
 #define PL_Gdo_undump		PL_do_undump
 #define PL_Gdollarzero_mutex	PL_dollarzero_mutex
+#define PL_Gearlytaint		PL_earlytaint
 #define PL_Ghexdigit		PL_hexdigit
 #define PL_Gmalloc_mutex	PL_malloc_mutex
 #define PL_Gop_mutex		PL_op_mutex
diff --git a/miniperlmain.c b/miniperlmain.c
index 4e9e5e889e..ec9604eae6 100644
--- a/miniperlmain.c
+++ b/miniperlmain.c
@@ -56,6 +56,9 @@ main(int argc, char **argv, char **env)
     /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
     PERL_GPROF_MONCONTROL(0);
 
+    /* To be used instead PL_taining before perl_parse() */
+    PL_earlytaint = doing_taint(argc, argv, env);
+
     PERL_SYS_INIT3(&argc,&argv,&env);
 
 #if defined(USE_ITHREADS)
diff --git a/perl.c b/perl.c
index b6231a480b..f40aaa56e5 100644
--- a/perl.c
+++ b/perl.c
@@ -154,7 +154,6 @@ perl_construct(pTHXx)
    if (PL_perl_destruct_level > 0)
        init_interp();
 #endif
-
    /* Init the real globals (and main thread)? */
     if (!PL_linestr) {
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
@@ -3329,24 +3328,25 @@ S_init_ids(pTHX)
 
 /* This is used very early in the lifetime of the program,
  * before even the options are parsed, so PL_tainting has
- * not been initialized properly.*/
-int
+ * not been initialized properly.  The variable PL_earlytaint
+ * is set early in main() to the result of this function. */
+bool
 Perl_doing_taint(int argc, char *argv[], char *envp[])
 {
-    int uid = PerlProc_getuid();
+    int uid  = PerlProc_getuid();
     int euid = PerlProc_geteuid();
-    int gid = PerlProc_getgid();
+    int gid  = PerlProc_getgid();
     int egid = PerlProc_getegid();
 
 #ifdef VMS
-    uid |= gid << 16;
+    uid  |=  gid << 16;
     euid |= egid << 16;
 #endif
     if (uid && (euid != uid || egid != gid))
 	return 1;
-    /* This is a really primitive check; $ENV{PERL_MALLOC_OPT} is
-	ignored only if -T are the first chars together; otherwise one
-	gets "Too late" message. */
+    /* This is a really primitive check; environment gets ignored only
+     * if -T are the first chars together; otherwise one gets
+     *  "Too late" message. */
     if ( argc > 1 && argv[1][0] == '-'
          && (argv[1][1] == 't' || argv[1][1] == 'T') )
 	return 1;
diff --git a/perl.h b/perl.h
index 61fab6cfca..492bd832cb 100644
--- a/perl.h
+++ b/perl.h
@@ -498,9 +498,8 @@ int usleep(unsigned int);
 		if (newval) {					\
 		  panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
 		  exit(1); })
-extern int Perl_doing_taint(int argc, char *argv[], char *envp[]);
 #  define MALLOC_CHECK_TAINT(argc,argv,env)	STMT_START {	\
-	if (Perl_doing_taint(argc, argv, env))	{		\
+	if (Perl_doing_taint(argc,argv,env)) {			\
 		MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1;	\
     }} STMT_END;
 #else  /* MYMALLOC */
diff --git a/perlapi.h b/perlapi.h
index 0f56a0af7e..3686e6b189 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -934,6 +934,8 @@ END_EXTERN_C
 #define PL_do_undump		(*Perl_Gdo_undump_ptr(NULL))
 #undef  PL_dollarzero_mutex
 #define PL_dollarzero_mutex	(*Perl_Gdollarzero_mutex_ptr(NULL))
+#undef  PL_earlytaint
+#define PL_earlytaint		(*Perl_Gearlytaint_ptr(NULL))
 #undef  PL_hexdigit
 #define PL_hexdigit		(*Perl_Ghexdigit_ptr(NULL))
 #undef  PL_malloc_mutex
diff --git a/perlvars.h b/perlvars.h
index 7d71787064..27f76ebb8d 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -54,3 +54,6 @@ PERLVAR(Gdollarzero_mutex, perl_mutex)	/* Modifying $0 */
 
 /* This is constant on most architectures, a global on OS/2 */
 PERLVARI(Gsh_path,	char *,	SH_PATH)/* full path of shell */
+
+PERLVAR(Gearlytaint,	bool)	/* Early warning for taint, before PL_tainting  is set */
+
diff --git a/proto.h b/proto.h
index 3c3776dccd..96e32cbc45 100644
--- a/proto.h
+++ b/proto.h
@@ -26,7 +26,7 @@ PERL_CALLCONV int	perl_destruct(PerlInterpreter* interp);
 PERL_CALLCONV void	perl_free(PerlInterpreter* interp);
 PERL_CALLCONV int	perl_run(PerlInterpreter* interp);
 PERL_CALLCONV int	perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env);
-PERL_CALLCONV int	Perl_doing_taint(int argc, char** argv, char** env);
+PERL_CALLCONV bool	Perl_doing_taint(int argc, char** argv, char** env);
 #if defined(USE_ITHREADS)
 PERL_CALLCONV PerlInterpreter*	perl_clone(PerlInterpreter* interp, UV flags);
 #  if defined(PERL_IMPLICIT_SYS)