Change 29984 by [EMAIL PROTECTED] on 2007/01/25 22:41:11
Integrate:
[ 28183]
Subject: Re: [PATCH] my_snprintf
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Fri, 12 May 2006 22:28:49 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28186]
Subject: [PATCH] sv.c: printf %d wants int not size_t
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Message-Id: <[EMAIL PROTECTED]>
Date: Sat, 13 May 2006 10:15:32 +0300 (EEST)
[ 28216]
Subject: Re: Change 28183 has broken 64-bit builds?
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Wed, 17 May 2006 22:19:51 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28217]
Parenthesize uses of macro arguments
[ 28222]
Adjust calling of Perl_va_copy(), noticed by Jarkko
[ 28234]
Subject: [PATCH] Re: [PATCH] Re: Change 28183 has broken 64-bit builds?
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Thu, 18 May 2006 22:44:14 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28247]
Perl_croak() needs an aTHX_ in PerlIO_vsprintf().
[ 28249]
Solaris was happy, but change 28247 removed the wrong dTHX as far as
some other operating systems were concerned.
[ 28299]
The 'f' flag was missing for my_snprintf().
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#192 integrate
... //depot/maint-5.8/perl/global.sym#55 integrate
... //depot/maint-5.8/perl/perl.h#138 integrate
... //depot/maint-5.8/perl/perlio.c#93 integrate
... //depot/maint-5.8/perl/pod/perlapi.pod#91 integrate
... //depot/maint-5.8/perl/pp_ctl.c#159 integrate
... //depot/maint-5.8/perl/proto.h#182 integrate
... //depot/maint-5.8/perl/regcomp.c#91 integrate
... //depot/maint-5.8/perl/sv.c#318 integrate
... //depot/maint-5.8/perl/toke.c#149 integrate
... //depot/maint-5.8/perl/universal.c#59 integrate
... //depot/maint-5.8/perl/util.c#130 integrate
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#192 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#191~29981~ 2007-01-25 13:31:37.000000000 -0800
+++ perl/embed.fnc 2007-01-25 14:41:11.000000000 -0800
@@ -1657,6 +1657,9 @@
Apnod |int |my_sprintf |NN char *buffer|NN const char *pat|...
#endif
+Apnodf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char
*format|...
+Apnod |int |my_vsnprintf |NN char *buffer|const Size_t len|NN const char
*format|va_list ap
+
END_EXTERN_C
/*
* ex: set ts=8 sts=4 sw=4 noet:
==== //depot/maint-5.8/perl/global.sym#55 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#54~29979~ 2007-01-25 13:01:25.000000000 -0800
+++ perl/global.sym 2007-01-25 14:41:11.000000000 -0800
@@ -737,4 +737,6 @@
Perl_gv_fetchpvn_flags
Perl_gv_fetchsv
Perl_my_sprintf
+Perl_my_snprintf
+Perl_my_vsnprintf
# ex: set ro:
==== //depot/maint-5.8/perl/perl.h#138 (text) ====
Index: perl/perl.h
--- perl/perl.h#137~29964~ 2007-01-24 15:53:28.000000000 -0800
+++ perl/perl.h 2007-01-25 14:41:11.000000000 -0800
@@ -291,11 +291,17 @@
#endif
#if defined(PERL_GCC_PEDANTIC)
-# if !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
#endif
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) &&
!defined(__cplusplus)
+# ifndef PERL_USE_GCC_BRACE_GROUPS
+# define PERL_USE_GCC_BRACE_GROUPS
+# endif
+#endif
+
/*
* STMT_START { statements; } STMT_END;
* can be used as a single statement, as in
@@ -304,7 +310,7 @@
* Trying to select a version that gives no warnings...
*/
#if !(defined(STMT_START) && defined(STMT_END))
-# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) &&
!defined(__cplusplus)
+# ifdef PERL_USE_GCC_BRACE_GROUPS
# define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */
# define STMT_END )
# else
@@ -1378,14 +1384,47 @@
*/
#ifdef SPRINTF_RETURNS_STRLEN
# define my_sprintf sprintf
-# ifdef HAS_SNPRINTF
-# define USE_SNPRINTF
+#else
+# define my_sprintf Perl_my_sprintf
+#endif
+
+/*
+ * If we have v?snprintf() and the C99 variadic macros, we can just
+ * use just the v?snprintf(). It is nice to try to trap the buffer
+ * overflow, however, so if we are DEBUGGING, and we cannot use the
+ * gcc brace groups, then use the function wrappers which try to trap
+ * the overflow. If we can use the gcc brace groups, we can try that
+ * even with the version that uses the C99 variadic macros.
+ */
+
+/* Note that we do not check against snprintf()/vsnprintf() returning
+ * negative values because that is non-standard behaviour and we use
+ * snprintf/vsnprintf only iff HAS_VSNPRINTF has been defined, and
+ * that should be true only if the snprintf()/vsnprintf() are true
+ * to the standard. */
+
+#if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) &&
!(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS))
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define my_snprintf(buffer, len, ...) ({ int __len__ = snprintf(buffer,
len, __VA_ARGS__); if ((len) > 0 && __len__ >= (len)) Perl_croak(aTHX_ "panic:
snprintf buffer overflow"); __len__; })
+# define PERL_MY_SNPRINTF_GUARDED
+# else
+# define my_snprintf(buffer, len, ...) snprintf(buffer, len, __VA_ARGS__)
# endif
-# ifdef HAS_VSNPRINTF
-# define USE_VSNPRINTF
+#else
+# define my_snprintf Perl_my_snprintf
+# define PERL_MY_SNPRINTF_GUARDED
+#endif
+
+#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) &&
!(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS))
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define my_vsnprintf(buffer, len, ...) ({ int __len__ =
vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && __len__ >= (len))
Perl_croak(aTHX_ "panic: vsnprintf buffer overflow"); __len__; })
+# define PERL_MY_VSNPRINTF_GUARDED
+# else
+# define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__)
# endif
#else
-# define my_sprintf Perl_my_sprintf
+# define my_vsnprintf Perl_my_vsnprintf
+# define PERL_MY_VSNPRINTF_GUARDED
#endif
/* Configure gets this right but the UTS compiler gets it wrong.
==== //depot/maint-5.8/perl/perlio.c#93 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#92~29981~ 2007-01-25 13:31:37.000000000 -0800
+++ perl/perlio.c 2007-01-25 14:41:11.000000000 -0800
@@ -477,13 +477,9 @@
const char * const s = CopFILE(PL_curcop);
/* Use fixed buffer as sv_catpvf etc. needs SVs */
char buffer[1024];
- const STRLEN len = my_sprintf(buffer, "%.40s:%" IVdf " ", s ? s :
"(none)", (IV) CopLINE(PL_curcop));
-# ifdef USE_VSNPRINTF
- const STRLEN len2 = vsnprintf(buffer+len, sizeof(buffer) - len, fmt,
ap);
-# else
- const STRLEN len2 = vsprintf(buffer+len, fmt, ap);
-# endif /* USE_VSNPRINTF */
- PerlLIO_write(dbg, buffer, len + len2);
+ const STRLEN len1 = my_snprintf(buffer, sizeof(buffer), "%.40s:%" IVdf
" ", s ? s : "(none)", (IV) CopLINE(PL_curcop));
+ const STRLEN len2 = my_vsnprintf(buffer + len1, sizeof(buffer) - len1,
fmt, ap);
+ PerlLIO_write(dbg, buffer, len1 + len2);
#else
const char *s = CopFILE(PL_curcop);
STRLEN len;
@@ -5094,19 +5090,13 @@
int
PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
{
-#ifdef USE_VSNPRINTF
- const int val = vsnprintf(s, n > 0 ? n : 0, fmt, ap);
-#else
- const int val = vsprintf(s, fmt, ap);
-#endif /* #ifdef USE_VSNPRINTF */
- if (n >= 0) {
- if (strlen(s) >= (STRLEN) n) {
- dTHX;
- (void) PerlIO_puts(Perl_error_log,
- "panic: sprintf overflow - memory corrupted!\n");
- my_exit(1);
- }
+ dTHX;
+ const int val = my_vsnprintf(s, n > 0 ? n : 0, fmt, ap);
+#ifndef PERL_MY_VSNPRINTF_GUARDED
+ if (val < 0 || (n > 0 ? val >= n : 0)) {
+ Perl_croak(aTHX_ "panic: my_vsnprintf overflow in PerlIO_vsprintf\n");
}
+#endif
return val;
}
#endif
==== //depot/maint-5.8/perl/pod/perlapi.pod#91 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod#90~29968~ 2007-01-25 02:55:13.000000000 -0800
+++ perl/pod/perlapi.pod 2007-01-25 14:41:11.000000000 -0800
@@ -2227,6 +2227,21 @@
=for hackers
Found in file util.c
+=item my_snprintf
+X<my_snprintf>
+
+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>.
+
+ int my_snprintf(char *buffer, const Size_t len, const char *format,
...)
+
+=for hackers
+Found in file util.c
+
=item my_sprintf
X<my_sprintf>
@@ -2239,6 +2254,20 @@
=for hackers
Found in file util.c
+=item my_vsnprintf
+X<my_vsnprintf>
+
+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>.
+
+ int my_vsnprintf(char *buffer, const Size_t len, const char
*format, va_list ap)
+
+=for hackers
+Found in file util.c
+
=item strEQ
X<strEQ>
==== //depot/maint-5.8/perl/pp_ctl.c#159 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#158~29967~ 2007-01-25 02:34:50.000000000 -0800
+++ perl/pp_ctl.c 2007-01-25 14:41:11.000000000 -0800
@@ -773,11 +773,7 @@
/* Formats aren't yet marked for locales, so assume "yes". */
{
STORE_NUMERIC_STANDARD_SET_LOCAL();
-#ifdef USE_SNPRINTF
- snprintf(t, SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)),
fmt, (int) fieldsize, (int) arg & 255, value);
-#else
- sprintf(t, fmt, (int) fieldsize, (int) arg & 255, value);
-#endif /* ifdef USE_SNPRINTF */
+ my_snprintf(t, SvLEN(PL_formtarget) - (t -
SvPVX(PL_formtarget)), fmt, (int) fieldsize, (int) arg & 255, value);
RESTORE_NUMERIC_STANDARD();
}
t += fieldsize;
@@ -2671,13 +2667,8 @@
len = SvCUR(sv);
}
else
-#ifdef USE_SNPRINTF
- len = snprintf(tmpbuf, sizeof(tbuf), "_<(%.10s_eval %lu)", code,
- (unsigned long)++PL_evalseq);
-#else
- len = my_sprintf(tmpbuf, "_<(%.10s_eval %lu)", code,
- (unsigned long)++PL_evalseq);
-#endif /* ifdef USE_SNPRINTF */
+ len = my_snprintf(tmpbuf, sizeof(tbuf), "_<(%.10s_eval %lu)", code,
+ (unsigned long)++PL_evalseq);
SAVECOPFILE_FREE(&PL_compiling);
CopFILE_set(&PL_compiling, tmpbuf+2);
SAVECOPLINE(&PL_compiling);
@@ -3441,11 +3432,7 @@
len = SvCUR(temp_sv);
}
else
-#ifdef USE_SNPRINTF
- len = snprintf(tmpbuf, sizeof(tbuf), "_<(eval %lu)", (unsigned
long)++PL_evalseq);
-#else
- len = my_sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
-#endif /* ifdef USE_SNPRINTF */
+ len = my_snprintf(tmpbuf, sizeof(tbuf), "_<(eval %lu)", (unsigned
long)++PL_evalseq);
SAVECOPFILE_FREE(&PL_compiling);
CopFILE_set(&PL_compiling, tmpbuf+2);
SAVECOPLINE(&PL_compiling);
==== //depot/maint-5.8/perl/proto.h#182 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#181~29981~ 2007-01-25 13:31:37.000000000 -0800
+++ perl/proto.h 2007-01-25 14:41:11.000000000 -0800
@@ -2311,6 +2311,15 @@
PERL_CALLCONV OP* Perl_ck_require(pTHX_ OP *o)
__attribute__warn_unused_result__;
+PERL_CALLCONV int Perl_my_snprintf(char *buffer, const Size_t len, const
char *format, ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3);
+
+PERL_CALLCONV int Perl_my_vsnprintf(char *buffer, const Size_t len, const
char *format, va_list ap)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3);
+
+
PERL_CALLCONV OP* Perl_ck_return(pTHX_ OP *o)
__attribute__warn_unused_result__;
==== //depot/maint-5.8/perl/regcomp.c#91 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c#90~29981~ 2007-01-25 13:31:37.000000000 -0800
+++ perl/regcomp.c 2007-01-25 14:41:11.000000000 -0800
@@ -5086,11 +5086,7 @@
for (i = 1; i <= rx->nparens; i++) {
GV *gv;
char digits[TYPE_CHARS(long)];
-#ifdef USE_SNPRINTF
- const STRLEN len = snprintf(digits, sizeof(digits), "%lu",
(long)i);
-#else
- const STRLEN len = my_sprintf(digits, "%lu", (long)i);
-#endif /* #ifdef USE_SNPRINTF */
+ const STRLEN len = my_snprintf(digits, sizeof(digits), "%lu",
(long)i);
GV *const *const gvp
= (GV**)hv_fetch(PL_defstash, digits, len, 0);
==== //depot/maint-5.8/perl/sv.c#318 (text) ====
Index: perl/sv.c
--- perl/sv.c#317~29980~ 2007-01-25 13:15:39.000000000 -0800
+++ perl/sv.c 2007-01-25 14:41:11.000000000 -0800
@@ -1042,8 +1042,9 @@
/* computed count doesnt reflect the 1st slot reservation */
DEBUG_m(PerlIO_printf(Perl_debug_log,
"arena %p end %p arena-size %d type %d size %d ct
%d\n",
- start, end, bdp->arena_size, sv_type, body_size,
- bdp->arena_size / body_size));
+ start, end,
+ (int)bdp->arena_size, sv_type, (int)body_size,
+ (int)bdp->arena_size / (int)body_size));
*root = (void *)start;
@@ -2579,13 +2580,8 @@
if (SvIOKp(sv)) {
len = SvIsUV(sv)
-#ifdef USE_SNPRINTF
- ? snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv))
- : snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv));
-#else
- ? my_sprintf(tbuf, "%"UVuf, (UV)SvUVX(sv))
- : my_sprintf(tbuf, "%"IVdf, (IV)SvIVX(sv));
-#endif /* #ifdef USE_SNPRINTF */
+ ? my_snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv))
+ : my_snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv));
} else {
Gconvert(SvNVX(sv), NV_DIG, 0, tbuf);
len = strlen(tbuf);
@@ -8686,13 +8682,8 @@
* --jhi */
#if defined(HAS_LONG_DOUBLE)
elen = ((intsize == 'q')
-# ifdef USE_SNPRINTF
- ? snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
- : snprintf(PL_efloatbuf, PL_efloatsize, ptr,
(double)nv));
-# else
- ? my_sprintf(PL_efloatbuf, ptr, nv)
- : my_sprintf(PL_efloatbuf, ptr, (double)nv));
-# endif /* #ifdef USE_SNPRINTF */
+ ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
+ : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr,
(double)nv));
#else
elen = my_sprintf(PL_efloatbuf, ptr, nv);
#endif
==== //depot/maint-5.8/perl/toke.c#149 (text) ====
Index: perl/toke.c
--- perl/toke.c#148~29980~ 2007-01-25 13:15:39.000000000 -0800
+++ perl/toke.c 2007-01-25 14:41:11.000000000 -0800
@@ -4983,11 +4983,7 @@
if (!PL_in_my_stash) {
char tmpbuf[1024];
PL_bufptr = s;
-#ifdef USE_SNPRINTF
- snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s",
PL_tokenbuf);
-#else
- sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
-#endif /* #ifdef USE_SNPRINTF */
+ my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class
%.1000s", PL_tokenbuf);
yyerror(tmpbuf);
}
}
==== //depot/maint-5.8/perl/util.c#130 (text) ====
Index: perl/util.c
--- perl/util.c#129~29982~ 2007-01-25 14:04:51.000000000 -0800
+++ perl/util.c 2007-01-25 14:41:11.000000000 -0800
@@ -4790,44 +4790,30 @@
/* We can't use SVs or PerlIO for obvious reasons,
* so we'll use stdio and low-level IO instead. */
char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
-# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+# ifdef PERL_MEM_LOG_TIMESTAMP
struct timeval tv;
+# ifdef HAS_GETTIMEOFDAY
gettimeofday(&tv, 0);
+# endif
+ /* If there are other OS specific ways of hires time than
+ * gettimeofday() (see ext/Time/HiRes), the easiest way is
+ * probably that they would be used to fill in the struct
+ * timeval. */
+# endif
{
const STRLEN len =
-# ifdef USE_SNPRINTF
- snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
- "%10d.%06d: alloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf"\n",
- (int)tv.tv_sec, (int)tv.tv_usec,
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(newalloc));
-# else
- my_sprintf(buf,
- "%10d.%06d: alloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf"\n",
- (int)tv.tv_sec, (int)tv.tv_usec,
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(newalloc));
-# endif
-# else
- const STRLEN len =
-# ifdef USE_SNPRINTF
- snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
- "alloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf"\n",
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(newalloc));
-# else
- my_sprintf(buf,
- "alloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf"\n",
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(newalloc));
-# endif
+ my_snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+# ifdef PERL_MEM_LOG_TIMESTAMP
+ "%10d.%06d: "
# endif
+ "alloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf"\n",
+# ifdef PERL_MEM_LOG_TIMESTAMP
+ (int)tv.tv_sec, (int)tv.tv_usec,
+# endif
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(newalloc));
# ifdef PERL_MEM_LOG_ENV_FD
s = PerlEnv_getenv("PERL_MEM_LOG_FD");
PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
@@ -4855,48 +4841,25 @@
/* We can't use SVs or PerlIO for obvious reasons,
* so we'll use stdio and low-level IO instead. */
char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
-# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+# ifdef PERL_MEM_LOG_TIMESTAMP
struct timeval tv;
gettimeofday(&tv, 0);
+# endif
{
const STRLEN len =
-# ifdef USE_SNPRINTF
- snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
- "%10d.%06d: realloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
- (int)tv.tv_sec, (int)tv.tv_usec,
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(oldalloc),
- PTR2UV(newalloc));
-# else
- my_sprintf(buf,
- "%10d.%06d: realloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
- (int)tv.tv_sec, (int)tv.tv_usec,
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(oldalloc),
- PTR2UV(newalloc));
-# endif
-# else
- const STRLEN len =
-# ifdef USE_SNPRINTF
- snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
- "realloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(oldalloc),
- PTR2UV(newalloc));
-# else
- my_sprintf(buf,
- "realloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(oldalloc),
- PTR2UV(newalloc));
-# endif
+ my_snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+# ifdef PERL_MEM_LOG_TIMESTAMP
+ "%10d.%06d: "
# endif
+ "realloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+# ifdef PERL_MEM_LOG_TIMESTAMP
+ (int)tv.tv_sec, (int)tv.tv_usec,
+# endif
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(oldalloc),
+ PTR2UV(newalloc));
# ifdef PERL_MEM_LOG_ENV_FD
s = PerlEnv_getenv("PERL_MEM_LOG_FD");
PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
@@ -4924,32 +4887,23 @@
/* We can't use SVs or PerlIO for obvious reasons,
* so we'll use stdio and low-level IO instead. */
char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
-# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+# ifdef PERL_MEM_LOG_TIMESTAMP
struct timeval tv;
gettimeofday(&tv, 0);
+# endif
{
const STRLEN len =
-# ifdef USE_SNPRINTF
- snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
- "%10d.%06d: free: %s:%d:%s: %"UVxf"\n",
- (int)tv.tv_sec, (int)tv.tv_usec,
- filename, linenumber, funcname,
- PTR2UV(oldalloc));
-# else
- my_sprintf(buf,
- "%10d.%06d: free: %s:%d:%s: %"UVxf"\n",
- (int)tv.tv_sec, (int)tv.tv_usec,
- filename, linenumber, funcname,
- PTR2UV(oldalloc));
-# endif
-# else
- const STRLEN len =
- my_sprintf(buf,
- "free: %s:%d:%s: %"UVxf"\n",
- filename, linenumber, funcname,
- PTR2UV(oldalloc));
+ my_snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+# ifdef PERL_MEM_LOG_TIMESTAMP
+ "%10d.%06d: "
+# endif
+ "free: %s:%d:%s: %"UVxf"\n",
+# ifdef PERL_MEM_LOG_TIMESTAMP
+ (int)tv.tv_sec, (int)tv.tv_usec,
# endif
+ filename, linenumber, funcname,
+ PTR2UV(oldalloc));
# ifdef PERL_MEM_LOG_ENV_FD
s = PerlEnv_getenv("PERL_MEM_LOG_FD");
PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
@@ -4985,6 +4939,74 @@
}
#endif
+/*
+=for apidoc my_snprintf
+
+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
+Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
+{
+ dTHX;
+ int retval;
+ va_list ap;
+ va_start(ap, format);
+#ifdef HAS_VSNPRINTF
+ retval = vsnprintf(buffer, len, format, ap);
+#else
+ retval = vsprintf(buffer, format, ap);
+#endif
+ va_end(ap);
+ /* vsnprintf() shows failure with >= len, vsprintf() with < 0 */
+ if (retval < 0 || (len > 0 && retval >= len))
+ Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
+ return retval;
+}
+
+/*
+=for apidoc my_vsnprintf
+
+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
+*/
+int
+Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list
ap)
+{
+ dTHX;
+ int retval;
+#ifdef NEED_VA_COPY
+ va_list apc;
+ Perl_va_copy(ap, apc);
+# ifdef HAS_VSNPRINTF
+ retval = vsnprintf(buffer, len, format, apc);
+# else
+ retval = vsprintf(buffer, format, apc);
+# endif
+#else
+# ifdef HAS_VSNPRINTF
+ retval = vsnprintf(buffer, len, format, ap);
+# else
+ retval = vsprintf(buffer, format, ap);
+# endif
+#endif /* #ifdef NEED_VA_COPY */
+ /* vsnprintf() shows failure with >= len, vsprintf() with < 0 */
+ if (retval < 0 || (len > 0 && retval >= len))
+ Perl_croak(aTHX_ "panic: my_vsnprintf buffer overflow");
+ return retval;
+}
+
void
Perl_my_clearenv(pTHX)
{
End of Patch.
