else {
char *newaddr;
const STRLEN pvlen = strlen(pv)+1;
- Newx(newaddr,pvlen,char);
- return memcpy(newaddr,pv,pvlen);
+ Newx(newaddr, pvlen, char);
+ return (char*)memcpy(newaddr, pv, pvlen);
}
}
if (!newaddr) {
return write_no_mem();
}
- return memcpy(newaddr,pv,pvlen);
+ return (char*)memcpy(newaddr, pv, pvlen);
}
/*
const MEM_SIZE len_wanted = sizeof(STRLEN) + size;
PERL_UNUSED_CONTEXT;
- buffer = specialWARN(buffer) ? PerlMemShared_malloc(len_wanted)
- : PerlMemShared_realloc(buffer, len_wanted);
+ buffer = (STRLEN*)
+ (specialWARN(buffer) ?
+ PerlMemShared_malloc(len_wanted) :
+ PerlMemShared_realloc(buffer, len_wanted));
buffer[0] = size;
Copy(bits, (buffer + 1), size, char);
return buffer;
*(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
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
if (ckWARN(WARN_IO)) {
- const char * const direction = (op == OP_phoney_INPUT_ONLY) ? "in" : "out";
+ const char * const direction =
+ (const char *)((op == OP_phoney_INPUT_ONLY) ? "in" : "out");
if (name && *name)
Perl_warner(aTHX_ packWARN(WARN_IO),
"Filehandle %s opened only for %sput",
}
if (ckWARN(warn_type)) {
- const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
+ const char * const pars =
+ (const char *)(OP_IS_FILETEST(op) ? "" : "()");
const char * const func =
- op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
- op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
- op < 0 ? "" : /* handle phoney cases */
- PL_op_desc[op];
- const char * const type = OP_IS_SOCKET(op)
- || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
- ? "socket" : "filehandle";
+ (const char *)
+ (op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
+ op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
+ op < 0 ? "" : /* handle phoney cases */
+ PL_op_desc[op]);
+ const char * const type =
+ (const char *)
+ (OP_IS_SOCKET(op) ||
+ (gv && io && IoTYPE(io) == IoTYPE_SOCKET) ?
+ "socket" : "filehandle");
if (name && *name) {
Perl_warner(aTHX_ packWARN(warn_type),
"%s%s on %s %s %s", func, pars, vile, type, name);
int l = e ? e - *environ : strlen(*environ);
if (bsiz < l + 1) {
(void)safesysfree(buf);
- bsiz = l + 1;
+ bsiz = l + 1; /* + 1 for the \0. */
buf = (char*)safesysmalloc(bufsiz);
}
- my_strlcpy(buf, bufsiz, *environ, l);
- *(buf + l) = '\0';
+ my_strlcpy(buf, *environ, l + 1);
(void)unsetenv(buf);
}
(void)safesysfree(buf);