In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/571ee10cd1538dd2cd1f37671ea9d15d030208e3?hp=b4d257e2d408f0f1c6686dcdc112f3ebfec68f44>

- Log -----------------------------------------------------------------
commit 571ee10cd1538dd2cd1f37671ea9d15d030208e3
Author: David Mitchell <[email protected]>
Date:   Tue Jun 27 09:59:41 2017 +0100

    PERL_SNPRINTF_CHECK(): off by 1 error
    
    PERL_SNPRINTF_CHECK() is used as part of a wrapper for snprintf()
    to check that snprintf didn't return more bytes than the buffer size
    given it to it (which should never happen anyway). But it was checking
    return_value >= buf_size rather than >. So a spurious panic could ensue
    if the formatted string exactly matched the buffer size.
    
    This hadn't been detected before because the old Perl_sv_vcatpvfn_flags()
    implementation added lots of fudge factors to the buffer size.
    
    At the same time, change the code in Perl_sv_vcatpvfn_flags() which grows
    PL_efloatbuf if its not big enough for float_need:
    
    1) Make it require the buf size to be at least float_need + 1 rather than
    just float_need, to accommodate the \0 appended by snprintf() (we don't
    strictly need the \0, and a conforming snprintf() implementation should
    just return the string without trailing \0 if there isn't room for it,
    but its possible an snprintf() out there might stumble).
    
    2) When growing PL_efloatbuf, grow by an extra margin of 0x20, to
    reduce the likelihood of multiple reallocs.
-----------------------------------------------------------------------

Summary of changes:
 perl.h         |  2 +-
 sv.c           | 10 +++++++++-
 t/op/sprintf.t |  1 +
 3 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/perl.h b/perl.h
index 9022114121..88c0a3f24a 100644
--- a/perl.h
+++ b/perl.h
@@ -1569,7 +1569,7 @@ EXTERN_C char *crypt(const char *, const char *);
  * that should be true only if the snprintf()/vsnprintf() are true
  * to the standard. */
 
-#define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && 
(Size_t)len >= (max)) Perl_croak_nocontext("panic: %s buffer overflow", 
STRINGIFY(api)); } STMT_END
+#define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && 
(Size_t)len > (max)) Perl_croak_nocontext("panic: %s buffer overflow", 
STRINGIFY(api)); } STMT_END
 
 #ifdef USE_QUADMATH
 #  define my_snprintf Perl_my_snprintf
diff --git a/sv.c b/sv.c
index 4576f9c2e0..cb3c1d128c 100644
--- a/sv.c
+++ b/sv.c
@@ -13067,7 +13067,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
            if (float_need < width)
                float_need = width;
 
-           if (PL_efloatsize < float_need) {
+           if (PL_efloatsize <= float_need) {
+                /* PL_efloatbuf should be at least 1 greater than
+                 * float_need to allow a trailing \0 to be returned by
+                 * snprintf().  If we need to grow, overgrow for the
+                 * benefit of future generations */
+                const STRLEN extra = 0x20;
+                if (float_need >= ((STRLEN)~0) - extra)
+                    croak_memory_wrap();
+                float_need += extra;
                Safefree(PL_efloatbuf);
                PL_efloatsize = float_need;
                Newx(PL_efloatbuf, PL_efloatsize, char);
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 3bde5dfde1..ae481b7438 100644
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -773,3 +773,4 @@ e>%vd<   >"version"<    >165.133.153.162.137.150.149<   
>perl #102586: vector fl
 >%.001f<   >123.432<   >123.4<   >by tradition, leading zeroes ignored in 
 >precison<
 >%.0f<   >[1.2, 3.4]<   >1 REDUNDANT<   >special-cased "%.0f" should check 
 >count<
 >%.0f<   >[]<   >0 MISSING<   >special-cased "%.0f" should check count<
+>%53.0f<   >69.0<   >                                                   69<   
>#131659<

--
Perl5 Master Repository

Reply via email to