In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/6ee81574cd3682da001e8c3e7a931f034c4c31b9?hp=957a9e817d29a86f12809f29f95d467754b8707b>
- Log -----------------------------------------------------------------
commit 6ee81574cd3682da001e8c3e7a931f034c4c31b9
Merge: 957a9e817d adebb90ded
Author: David Mitchell <da...@iabyn.com>
Date: Fri Jun 29 14:38:10 2018 +0100
[MERGE] fixups to Perl_my_setenv()
commit adebb90ded7502ff44bd789b300b1193c89c047c
Author: David Mitchell <da...@iabyn.com>
Date: Fri Jun 29 14:30:17 2018 +0100
Perl_my_setenv(): re-indent cpp directive lines
The indentation was all over the place. Whitespace-only changes apart
from fixing code comments at end of '#endif' lines.
commit de5576aa52889a6b4c37e8137a9ebfe0abe75619
Author: David Mitchell <da...@iabyn.com>
Date: Fri Jun 29 14:12:18 2018 +0100
Perl_my_setenv: move code comment
This comment about VMS seems to have drifted over time away from the
ifdef it refs to
commit 34716e2a6ee2af96078d62b065b7785c001194be
Author: David Mitchell <da...@iabyn.com>
Date: Fri Jun 29 13:37:03 2018 +0100
Perl_my_setenv(); handle integer wrap
RT #133204
Wean this function off int/I32 and onto UV/Size_t.
Also, replace all malloc-ish calls with a wrapper that does
overflow checks,
In particular, it was doing (nlen + vlen + 2) which could wrap when
the combined length of the environment variable name and value
exceeded around 0x7fffffff.
The wrapper check function is probably overkill, but belt and braces...
NB this function has several variant parts, #ifdef'ed by platform
type; I have blindly changed the parts that aren't compiled under linux.
-----------------------------------------------------------------------
Summary of changes:
util.c | 154 ++++++++++++++++++++++++++++++++++++++++++++---------------------
1 file changed, 104 insertions(+), 50 deletions(-)
diff --git a/util.c b/util.c
index 7282dd9cfe..53fa197b60 100644
--- a/util.c
+++ b/util.c
@@ -2060,149 +2060,203 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer,
const char *const bits,
Copy(val, s+(nlen+1), vlen, char); \
*(s+(nlen+1+vlen)) = '\0'
+
+
#ifdef USE_ENVIRON_ARRAY
- /* VMS' my_setenv() is in vms.c */
-#if !defined(WIN32) && !defined(NETWARE)
+/* NB: VMS' my_setenv() is in vms.c */
+
+/* small wrapper for use by Perl_my_setenv that mallocs, or reallocs if
+ * 'current' is non-null, with up to three sizes that are added together.
+ * It handles integer overflow.
+ */
+static char *
+S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t l3, Size_t size)
+{
+ void *p;
+ Size_t sl, l = l1 + l2;
+
+ if (l < l2)
+ goto panic;
+ l += l3;
+ if (l < l3)
+ goto panic;
+ sl = l * size;
+ if (sl < l)
+ goto panic;
+
+ p = current
+ ? safesysrealloc(current, sl)
+ : safesysmalloc(sl);
+ if (p)
+ return (char*)p;
+
+ panic:
+ croak_memory_wrap();
+}
+
+
+# if !defined(WIN32) && !defined(NETWARE)
+
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
dVAR;
-#ifdef __amigaos4__
+# ifdef __amigaos4__
amigaos4_obtain_environ(__FUNCTION__);
-#endif
-#ifdef USE_ITHREADS
+# endif
+
+# ifdef USE_ITHREADS
/* only parent thread can modify process environment */
if (PL_curinterp == aTHX)
-#endif
+# endif
{
-#ifndef PERL_USE_SAFE_PUTENV
+
+# ifndef PERL_USE_SAFE_PUTENV
if (!PL_use_safe_putenv) {
/* most putenv()s leak, so we manipulate environ directly */
- I32 i;
- const I32 len = strlen(nam);
- int nlen, vlen;
+ UV i;
+ Size_t vlen, nlen = strlen(nam);
/* where does it go? */
for (i = 0; environ[i]; i++) {
- if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
+ if (strnEQ(environ[i], nam, nlen) && environ[i][nlen] == '=')
break;
}
if (environ == PL_origenviron) { /* need we copy environment? */
- I32 j;
- I32 max;
+ UV j, max;
char **tmpenv;
max = i;
while (environ[max])
max++;
- tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
+
+ /* XXX shouldn't that be max+1 rather than max+2 ??? - DAPM */
+ tmpenv = (char**)S_env_alloc(NULL, max, 2, 0, sizeof(char*));
+
for (j=0; j<max; j++) { /* copy environment */
- const int len = strlen(environ[j]);
- tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
+ const Size_t len = strlen(environ[j]);
+ tmpenv[j] = S_env_alloc(NULL, len, 1, 0, 1);
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++;
}
-#ifdef __amigaos4__
+# ifdef __amigaos4__
goto my_setenv_out;
-#else
+# else
return;
-#endif
+# endif
}
+
if (!environ[i]) { /* does not exist yet */
- environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
+ environ = (char**)S_env_alloc(environ, i, 2, 0, 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));
+ environ[i] = S_env_alloc(NULL, nlen, vlen, 2, 1);
/* all that work just for this */
my_setenv_format(environ[i], nam, nlen, val, vlen);
- } else {
-# endif
+ }
+ else {
+
+# endif /* !PERL_USE_SAFE_PUTENV */
+
/* This next branch should only be called #if defined(HAS_SETENV), but
- Configure doesn't test for that yet. For Solaris, setenv() and
unsetenv()
- were introduced in Solaris 9, so testing for HAS UNSETENV is sufficient.
+ Configure doesn't test for that yet. For Solaris, setenv() and
+ unsetenv() were introduced in Solaris 9, so testing for HAS
+ UNSETENV is sufficient.
*/
-# if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__) ||
(defined(__sun) && defined(HAS_UNSETENV)) || defined(PERL_DARWIN)
-# if defined(HAS_UNSETENV)
+# if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__) ||
(defined(__sun) && defined(HAS_UNSETENV)) || defined(PERL_DARWIN)
+
+# if defined(HAS_UNSETENV)
if (val == NULL) {
(void)unsetenv(nam);
} else {
(void)setenv(nam, val, 1);
}
-# else /* ! HAS_UNSETENV */
+# else /* ! HAS_UNSETENV */
(void)setenv(nam, val, 1);
-# endif /* HAS_UNSETENV */
-# elif defined(HAS_UNSETENV)
+# endif /* HAS_UNSETENV */
+
+# elif defined(HAS_UNSETENV)
+
if (val == NULL) {
if (environ) /* old glibc can crash with null environ */
(void)unsetenv(nam);
} else {
- const int nlen = strlen(nam);
- const int vlen = strlen(val);
- char * const new_env =
- (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
+ const Size_t nlen = strlen(nam);
+ const Size_t vlen = strlen(val);
+ char * const new_env = S_env_alloc(NULL, nlen, vlen, 2, 1);
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
}
-# else /* ! HAS_UNSETENV */
+
+# else /* ! HAS_UNSETENV */
+
char *new_env;
- const int nlen = strlen(nam);
- int vlen;
+ const Size_t nlen = strlen(nam);
+ Size_t vlen;
if (!val) {
val = "";
}
vlen = strlen(val);
- new_env = (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
+ new_env = S_env_alloc(NULL, nlen, vlen, 2, 1);
/* all that work just for this */
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
-# endif /* __CYGWIN__ */
-#ifndef PERL_USE_SAFE_PUTENV
+
+# endif /* __CYGWIN__ */
+
+# ifndef PERL_USE_SAFE_PUTENV
}
-#endif
+# endif
}
-#ifdef __amigaos4__
+
+# ifdef __amigaos4__
my_setenv_out:
amigaos4_release_environ(__FUNCTION__);
-#endif
+# endif
}
-#else /* WIN32 || NETWARE */
+# else /* WIN32 || NETWARE */
void
Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
dVAR;
char *envstr;
- const int nlen = strlen(nam);
- int vlen;
+ const Size_t nlen = strlen(nam);
+ Size_t vlen;
if (!val) {
val = "";
}
vlen = strlen(val);
- Newx(envstr, nlen+vlen+2, char);
+ envstr = S_env_alloc(NULL, nlen, vlen, 2, 1);
my_setenv_format(envstr, nam, nlen, val, vlen);
(void)PerlEnv_putenv(envstr);
Safefree(envstr);
}
-#endif /* WIN32 || NETWARE */
+# endif /* WIN32 || NETWARE */
+
+#endif /* USE_ENVIRON_ARRAY */
+
+
-#endif /* !VMS */
#ifdef UNLINK_ALL_VERSIONS
I32
--
Perl5 Master Repository
