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

diff --git a/embed.fnc b/embed.fnc
index 7ffdef7..15647d0 100644 (file)
--- 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 dcb980a..f2a44e1 100644 (file)
--- 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 4e9e5e8..ec9604e 100644 (file)
--- 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 b6231a4..f40aaa5 100644 (file)
--- 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 61fab6c..492bd83 100644 (file)
--- 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 0f56a0a..3686e6b 100644 (file)
--- 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 7d71787..27f76eb 100644 (file)
--- 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 3c3776d..96e32cb 100644 (file)
--- 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)