*(s+(nlen+1+vlen)) = '\0'
#ifdef USE_ENVIRON_ARRAY
- /* VMS' my_setenv() is in vms.c */
-#if !defined(WIN32) && !defined(NETWARE)
+/* VMS' my_setenv() is in vms.c */
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
{
#ifndef PERL_USE_SAFE_PUTENV
if (!PL_use_safe_putenv) {
- /* most putenv()s leak, so we manipulate environ directly */
- register I32 i=setenv_getix(nam); /* where does it go? */
- int nlen, vlen;
-
- if (environ == PL_origenviron) { /* need we copy environment? */
- I32 j;
- I32 max;
- char **tmpenv;
-
- max = i;
- while (environ[max])
- max++;
- tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
- for (j=0; j<max; j++) { /* copy environment */
- const int len = strlen(environ[j]);
- tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
- Copy(environ[j], tmpenv[j], len+1, char);
- }
- tmpenv[max] = NULL;
- environ = tmpenv; /* tell exec where it is now */
- }
- if (!val) {
- safesysfree(environ[i]);
- while (environ[i]) {
- environ[i] = environ[i+1];
- i++;
+ /* The excuse for this code was that many putenv()s used to
+ * leak, so we manipulate environ directly -- but the claim is
+ * somewhat doubtful, since manipulating environment CANNOT be
+ * made in a safe way, the env API and the whole concept are
+ * fundamentally broken. */
+ register I32 i = setenv_getix(nam); /* where does it go? */
+ int nlen, vlen;
+
+ if (i >= 0) {
+ if (environ == PL_origenviron) { /* need we copy environment? */
+ I32 j;
+ I32 max;
+ char **tmpenv;
+
+ max = i;
+ while (environ[max])
+ max++;
+ tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
+ for (j=0; j<max; j++) { /* copy environment */
+ const int len = strlen(environ[j]);
+ tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
+ Copy(environ[j], tmpenv[j], len+1, char);
+ }
+ tmpenv[max] = NULL;
+ environ = tmpenv; /* tell exec where it is now */
+ }
+ if (!val) {
+ safesysfree(environ[i]);
+ while (environ[i]) {
+ environ[i] = environ[i+1];
+ i++;
+ }
+ return;
+ }
+ if (!environ[i]) { /* does not exist yet */
+ environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
+ environ[i+1] = NULL; /* make sure it's null terminated */
+ }
+ else
+ safesysfree(environ[i]);
+ nlen = strlen(nam);
+ vlen = strlen(val);
+
+ environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
+ /* all that work just for this */
+ my_setenv_format(environ[i], nam, nlen, val, vlen);
}
- return;
- }
- if (!environ[i]) { /* does not exist yet */
- environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
- environ[i+1] = NULL; /* make sure it's null terminated */
- }
- else
- safesysfree(environ[i]);
- nlen = strlen(nam);
- vlen = strlen(val);
-
- environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
- /* all that work just for this */
- my_setenv_format(environ[i], nam, nlen, val, vlen);
} else {
# endif
# if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__) || defined(__riscos__)
}
}
-#else /* WIN32 || NETWARE */
+#else /* USE_ENVIRON_ARRAY */
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
dVAR;
- register char *envstr;
- const int nlen = strlen(nam);
- int vlen;
+#if !(defined(WIN32) || defined(NETWARE))
+# ifdef USE_ITHREADS
+ /* only parent thread can modify process environment */
+ if (PL_curinterp == aTHX)
+# endif
+#endif
+ {
+ register char *envstr;
+ const int nlen = strlen(nam);
+ int vlen;
- if (!val) {
- val = "";
+ if (!val) {
+ val = "";
+ }
+ vlen = strlen(val);
+ Newx(envstr, nlen+vlen+2, char);
+ my_setenv_format(envstr, nam, nlen, val, vlen);
+ (void)PerlEnv_putenv(envstr);
+ Safefree(envstr);
}
- vlen = strlen(val);
- Newx(envstr, nlen+vlen+2, char);
- my_setenv_format(envstr, nam, nlen, val, vlen);
- (void)PerlEnv_putenv(envstr);
- Safefree(envstr);
}
-#endif /* WIN32 || NETWARE */
+#endif /* USE_ENVIRON_ARRAY */
+
+#if !defined(VMS)
-#ifndef PERL_MICRO
I32
Perl_setenv_getix(pTHX_ const char *nam)
{
- register I32 i;
+ register I32 i = -1;
register const I32 len = strlen(nam);
PERL_UNUSED_CONTEXT;
+#ifdef USE_ENVIRON_ARRAY
for (i = 0; environ[i]; i++) {
if (
#ifdef WIN32
&& environ[i][len] == '=')
break; /* strnEQ must come first to avoid */
} /* potential SEGV's */
+#endif /* USE_ENVIRON_ARRAY */
+
return i;
}
-#endif /* !PERL_MICRO */
-#endif /* !VMS && !EPOC*/
+#endif /* !PERL_VMS */
#ifdef UNLINK_ALL_VERSIONS
I32