taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
- if (PerlProc_pipe(p) < 0)
+ if (PerlProc_pipe_cloexec(p) < 0)
return NULL;
/* Try for another pipe pair for error return */
- if (PerlProc_pipe(pp) >= 0)
+ if (PerlProc_pipe_cloexec(pp) >= 0)
did_pipes = 1;
while ((pid = PerlProc_fork()) < 0) {
if (errno != EAGAIN) {
#define THIS that
#define THAT This
/* Close parent's end of error status pipe (if any) */
- if (did_pipes) {
+ if (did_pipes)
PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
- /* Close error pipe automatically if exec works */
- if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
- return NULL;
-#endif
- }
/* Now dup our end of _the_ pipe to right position */
if (p[THIS] != (*mode == 'r')) {
PerlLIO_dup2(p[THIS], *mode == 'r');
#undef THAT
}
/* Parent */
- do_execfree(); /* free any memory malloced by child on fork */
if (did_pipes)
PerlLIO_close(pp[1]);
/* Keep the lower of the two fd numbers */
if (p[that] < p[This]) {
- PerlLIO_dup2(p[This], p[that]);
+ PerlLIO_dup2_cloexec(p[This], p[that]);
PerlLIO_close(p[This]);
p[This] = p[that];
}
taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
- if (PerlProc_pipe(p) < 0)
+ if (PerlProc_pipe_cloexec(p) < 0)
return NULL;
- if (doexec && PerlProc_pipe(pp) >= 0)
+ if (doexec && PerlProc_pipe_cloexec(pp) >= 0)
did_pipes = 1;
while ((pid = PerlProc_fork()) < 0) {
if (errno != EAGAIN) {
#undef THAT
#define THIS that
#define THAT This
- if (did_pipes) {
+ if (did_pipes)
PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
- if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
- return NULL;
-#endif
- }
if (p[THIS] != (*mode == 'r')) {
PerlLIO_dup2(p[THIS], *mode == 'r');
PerlLIO_close(p[THIS]);
#undef THIS
#undef THAT
}
- do_execfree(); /* free any memory malloced by child on vfork */
if (did_pipes)
PerlLIO_close(pp[1]);
if (p[that] < p[This]) {
- PerlLIO_dup2(p[This], p[that]);
+ PerlLIO_dup2_cloexec(p[This], p[that]);
PerlLIO_close(p[This]);
p[This] = p[that];
}
buflen = 64;
Newx(buf, buflen, char);
- GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
+ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* fmt checked by caller */
len = strftime(buf, buflen, fmt, &mytm);
- GCC_DIAG_RESTORE;
+ GCC_DIAG_RESTORE_STMT;
/*
** The following is needed to handle to the situation where
Renew(buf, bufsize, char);
while (buf) {
- GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
+ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* fmt checked by caller */
buflen = strftime(buf, bufsize, fmt, &mytm);
- GCC_DIAG_RESTORE;
+ GCC_DIAG_RESTORE_STMT;
if (buflen > 0 && buflen < bufsize)
break;
return -1;
}
+#ifdef SOCK_CLOEXEC
+ type &= ~SOCK_CLOEXEC;
+#endif
+
#ifdef EMULATE_SOCKETPAIR_UDP
if (type == SOCK_DGRAM)
return S_socketpair_udp(fd);
# define PERL_RANDOM_DEVICE "/dev/urandom"
# endif
#endif
- fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+ fd = PerlLIO_open_cloexec(PERL_RANDOM_DEVICE, 0);
if (fd != -1) {
if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u)
u = 0;
/*
=for apidoc my_snprintf
-The C library C<snprintf> functionality (using C<vsnprintf>).
-Consider using C<sv_vcatpvf> instead.
+The C library C<snprintf> functionality, if available and
+standards-compliant (uses C<vsnprintf>, actually). However, if the
+C<vsnprintf> is not available, will unfortunately use the unsafe
+C<vsprintf> which can overrun the buffer (there is an overrun check,
+but that may be too late). Consider using C<sv_vcatpvf> instead, or
+getting C<vsnprintf>.
=cut
*/
int retval = -1;
va_list ap;
PERL_ARGS_ASSERT_MY_SNPRINTF;
+#ifndef HAS_VSNPRINTF
+ PERL_UNUSED_VAR(len);
+#endif
va_start(ap, format);
#ifdef USE_QUADMATH
{
* Handling the "Q-less" cases right would require walking
* through the va_list and rewriting the format, calling
* quadmath for the NVs, building a new va_list, and then
- * letting vsnprintf to take care of the other
+ * letting vsnprintf/vsprintf to take care of the other
* arguments. This may be doable.
*
* We do not attempt that now. But for paranoia, we here try
* to detect some common (but not all) cases where the
* "Q-less" %[efgaEFGA] formats are present, and die if
* detected. This doesn't fix the problem, but it stops the
- * vsnprintf pulling doubles off the va_list when
+ * vsnprintf/vsprintf pulling doubles off the va_list when
* __float128 NVs should be pulled off instead.
*
* If quadmath_format_needed() returns false, we are reasonably
}
#endif
if (retval == -1)
+#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
+#else
+ retval = vsprintf(buffer, format, ap);
+#endif
va_end(ap);
+ /* vsprintf() shows failure with < 0 */
+ if (retval < 0
+#ifdef HAS_VSNPRINTF
/* vsnprintf() shows failure with >= len */
- if (len > 0 && (Size_t)retval >= len)
+ ||
+ (len > 0 && (Size_t)retval >= len)
+#endif
+ )
Perl_croak_nocontext("panic: my_snprintf buffer overflow");
return retval;
}
/*
=for apidoc my_vsnprintf
-The C library C<vsnprintf>. Consider using C<sv_vcatpvf> instead.
+The C library C<vsnprintf> if available and standards-compliant.
+However, if if the C<vsnprintf> is not available, will unfortunately
+use the unsafe C<vsprintf> which can overrun the buffer (there is an
+overrun check, but that may be too late). Consider using
+C<sv_vcatpvf> instead, or getting C<vsnprintf>.
=cut
*/
PERL_ARGS_ASSERT_MY_VSNPRINTF;
Perl_va_copy(ap, apc);
+# ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, apc);
+# else
+ PERL_UNUSED_ARG(len);
+ retval = vsprintf(buffer, format, apc);
+# endif
va_end(apc);
#else
+# ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
+# else
+ PERL_UNUSED_ARG(len);
+ retval = vsprintf(buffer, format, ap);
+# endif
#endif /* #ifdef NEED_VA_COPY */
+ /* vsprintf() shows failure with < 0 */
+ if (retval < 0
+#ifdef HAS_VSNPRINTF
/* vsnprintf() shows failure with >= len */
- if (len > 0 && (Size_t)retval >= len)
+ ||
+ (len > 0 && (Size_t)retval >= len)
+#endif
+ )
Perl_croak_nocontext("panic: my_vsnprintf buffer overflow");
return retval;
#endif
}
#endif
+/*
+=for apidoc my_strnlen
+
+The C library C<strnlen> if available, or a Perl implementation of it.
+
+C<my_strnlen()> computes the length of the string, up to C<maxlen>
+characters. It will will never attempt to address more than C<maxlen>
+characters, making it suitable for use with strings that are not
+guaranteed to be NUL-terminated.
+
+=cut
+
+Description stolen from http://man.openbsd.org/strnlen.3,
+implementation stolen from PostgreSQL.
+*/
+#ifndef HAS_STRNLEN
+Size_t
+Perl_my_strnlen(const char *str, Size_t maxlen)
+{
+ const char *p = str;
+
+ PERL_ARGS_ASSERT_MY_STRNLEN;
+
+ while(maxlen-- && *p)
+ p++;
+
+ return p - str;
+}
+#endif
+
#if defined(_MSC_VER) && (_MSC_VER >= 1300) && (_MSC_VER < 1400) && (WINVER < 0x0500)
/* VC7 or 7.1, building with pre-VC7 runtime libraries. */
long _ftol( double ); /* Defined by VC6 C libs. */
#endif
}
-#ifndef HAS_MKSTEMP
+#if !defined(HAS_MKOSTEMP) || !defined(HAS_MKSTEMP)
#define TEMP_FILE_CH "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvxyz0123456789"
#define TEMP_FILE_CH_COUNT (sizeof(TEMP_FILE_CH)-1)
-int
-Perl_my_mkstemp(char *templte) {
+static int
+S_my_mkostemp(char *templte, int flags) {
dTHX;
STRLEN len = strlen(templte);
int fd;
int attempts = 0;
- PERL_ARGS_ASSERT_MY_MKSTEMP;
-
if (len < 6 ||
templte[len-1] != 'X' || templte[len-2] != 'X' || templte[len-3] != 'X' ||
templte[len-4] != 'X' || templte[len-5] != 'X' || templte[len-6] != 'X') {
- errno = EINVAL;
+ SETERRNO(EINVAL, LIB_INVARG);
return -1;
}
for (i = 1; i <= 6; ++i) {
templte[len-i] = TEMP_FILE_CH[(int)(Perl_internal_drand48() * TEMP_FILE_CH_COUNT)];
}
- fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL, 0600);
+ fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL | flags, 0600);
} while (fd == -1 && errno == EEXIST && ++attempts <= 100);
return fd;
#endif
+#ifndef HAS_MKOSTEMP
+int
+Perl_my_mkostemp(char *templte, int flags)
+{
+ PERL_ARGS_ASSERT_MY_MKOSTEMP;
+ return S_my_mkostemp(templte, flags);
+}
+#endif
+
+#ifndef HAS_MKSTEMP
+int
+Perl_my_mkstemp(char *templte)
+{
+ PERL_ARGS_ASSERT_MY_MKSTEMP;
+ return S_my_mkostemp(templte, 0);
+}
+#endif
+
REGEXP *
Perl_get_re_arg(pTHX_ SV *sv) {
#ifdef PERL_DRAND48_QUAD
-#define DRAND48_MULT U64_CONST(0x5deece66d)
+#define DRAND48_MULT UINT64_C(0x5deece66d)
#define DRAND48_ADD 0xb
-#define DRAND48_MASK U64_CONST(0xffffffffffff)
+#define DRAND48_MASK UINT64_C(0xffffffffffff)
#else
https://perl5.git.perl.org / perl5.git / blobdiff