summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--mg.c26
-rw-r--r--perl.c16
-rw-r--r--sv.c8
-rw-r--r--util.c6
4 files changed, 45 insertions, 11 deletions
diff --git a/mg.c b/mg.c
index 9249df2b07..63de61249f 100644
--- a/mg.c
+++ b/mg.c
@@ -990,11 +990,16 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
#if defined(VMS) || defined(EPOC)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
-# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
+# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
PerlEnv_clearenv();
-# else
-# ifdef USE_ENVIRON_ARRAY
-# ifndef PERL_USE_SAFE_PUTENV
+# else
+# ifdef USE_ENVIRON_ARRAY
+# if defined(USE_ITHREADS)
+ /* only the parent thread can clobber the process environment */
+ if (PL_curinterp == aTHX)
+# endif
+ {
+# ifndef PERL_USE_SAFE_PUTENV
I32 i;
if (environ == PL_origenviron)
@@ -1002,11 +1007,11 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
else
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
-# endif /* PERL_USE_SAFE_PUTENV */
+# endif /* PERL_USE_SAFE_PUTENV */
environ[0] = Nullch;
-
-# endif /* USE_ENVIRON_ARRAY */
+ }
+# endif /* USE_ENVIRON_ARRAY */
# endif /* PERL_IMPLICIT_SYS || WIN32 */
#endif /* VMS || EPC */
return 0;
@@ -2239,7 +2244,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
break;
}
/* can grab env area too? */
- if (PL_origenviron && (PL_origenviron[0] == s + 1)) {
+ if (PL_origenviron
+#ifdef USE_ITHREADS
+ && PL_curinterp == aTHX
+#endif
+ && (PL_origenviron[0] == s + 1))
+ {
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
for (i = 0; PL_origenviron[i]; i++)
diff --git a/perl.c b/perl.c
index 7164d555ee..52301146c6 100644
--- a/perl.c
+++ b/perl.c
@@ -498,7 +498,13 @@ perl_destruct(pTHXx)
* so we certainly shouldn't free it here
*/
#if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
- if (environ != PL_origenviron) {
+ if (environ != PL_origenviron
+#ifdef USE_ITHREADS
+ /* only main thread can free environ[0] contents */
+ && PL_curinterp == aTHX
+#endif
+ )
+ {
I32 i;
for (i = 0; environ[i]; i++)
@@ -3576,8 +3582,14 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
*/
if (!env)
env = environ;
- if (env != environ)
+ if (env != environ
+# ifdef USE_ITHREADS
+ && PL_curinterp == aTHX
+# endif
+ )
+ {
environ[0] = Nullch;
+ }
if (env)
for (; *env; env++) {
if (!(s = strchr(*env,'=')))
diff --git a/sv.c b/sv.c
index 0350bae010..9ba91e6728 100644
--- a/sv.c
+++ b/sv.c
@@ -6594,8 +6594,14 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
if (GvHV(gv) && !HvNAME(GvHV(gv))) {
hv_clear(GvHV(gv));
#ifdef USE_ENVIRON_ARRAY
- if (gv == PL_envgv)
+ if (gv == PL_envgv
+# ifdef USE_ITHREADS
+ && PL_curinterp == aTHX
+# endif
+ )
+ {
environ[0] = Nullch;
+ }
#endif
}
}
diff --git a/util.c b/util.c
index 35d54c350a..fe93c9933b 100644
--- a/util.c
+++ b/util.c
@@ -1594,6 +1594,11 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args)
void
Perl_my_setenv(pTHX_ char *nam, char *val)
{
+#ifdef USE_ITHREADS
+ /* only parent thread can modify process environment */
+ if (PL_curinterp == aTHX)
+#endif
+ {
#ifndef PERL_USE_SAFE_PUTENV
/* most putenv()s leak, so we manipulate environ directly */
register I32 i=setenv_getix(nam); /* where does it go? */
@@ -1652,6 +1657,7 @@ Perl_my_setenv(pTHX_ char *nam, char *val)
(void)putenv(new_env);
# endif /* __CYGWIN__ */
#endif /* PERL_USE_SAFE_PUTENV */
+ }
}
#else /* WIN32 || NETWARE */