make sprintf("%g",...) threadsafe; only taint its result iff the

formatted result looks nonstandard

p4raw-id: //depot/perl@4130

diff --git a/embed.pl b/embed.pl
index 5f0711f..eaee6f7 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1653,10 +1653,10 @@ p       |bool   |sv_upgrade     |SV* sv|U32 mt
 p      |void   |sv_usepvn      |SV* sv|char* ptr|STRLEN len
 p      |void   |sv_vcatpvfn    |SV* sv|const char* pat|STRLEN patlen \
                                |va_list* args|SV** svargs|I32 svmax \
-                               |bool *used_locale
+                               |bool *maybe_tainted
 p      |void   |sv_vsetpvfn    |SV* sv|const char* pat|STRLEN patlen \
                                |va_list* args|SV** svargs|I32 svmax \
-                               |bool *used_locale
+                               |bool *maybe_tainted
 p      |SV*    |swash_init     |char* pkg|char* name|SV* listsv \
                                |I32 minbits|I32 none
 p      |UV     |swash_fetch    |SV *sv|U8 *ptr

diff --git a/embedvar.h b/embedvar.h
index 3e83de1..65a31f1 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -49,6 +49,8 @@
 #define PL_delaymagic          (vTHX->Tdelaymagic)
 #define PL_dirty               (vTHX->Tdirty)
 #define PL_dumpindent          (vTHX->Tdumpindent)
+#define PL_efloatbuf           (vTHX->Tefloatbuf)
+#define PL_efloatsize          (vTHX->Tefloatsize)
 #define PL_extralen            (vTHX->Textralen)
 #define PL_firstgv             (vTHX->Tfirstgv)
 #define PL_formtarget          (vTHX->Tformtarget)
@@ -229,8 +231,6 @@
 #define PL_doswitches          (PERL_GET_INTERP->Idoswitches)
 #define PL_dowarn              (PERL_GET_INTERP->Idowarn)
 #define PL_e_script            (PERL_GET_INTERP->Ie_script)
-#define PL_efloatbuf           (PERL_GET_INTERP->Iefloatbuf)
-#define PL_efloatsize          (PERL_GET_INTERP->Iefloatsize)
 #define PL_egid                        (PERL_GET_INTERP->Iegid)
 #define PL_endav               (PERL_GET_INTERP->Iendav)
 #define PL_envgv               (PERL_GET_INTERP->Ienvgv)
@@ -500,8 +500,6 @@
 #define PL_doswitches          (vTHX->Idoswitches)
 #define PL_dowarn              (vTHX->Idowarn)
 #define PL_e_script            (vTHX->Ie_script)
-#define PL_efloatbuf           (vTHX->Iefloatbuf)
-#define PL_efloatsize          (vTHX->Iefloatsize)
 #define PL_egid                        (vTHX->Iegid)
 #define PL_endav               (vTHX->Iendav)
 #define PL_envgv               (vTHX->Ienvgv)
@@ -773,8 +771,6 @@
 #define PL_Idoswitches         PL_doswitches
 #define PL_Idowarn             PL_dowarn
 #define PL_Ie_script           PL_e_script
-#define PL_Iefloatbuf          PL_efloatbuf
-#define PL_Iefloatsize         PL_efloatsize
 #define PL_Iegid               PL_egid
 #define PL_Iendav              PL_endav
 #define PL_Ienvgv              PL_envgv
@@ -1002,6 +998,8 @@
 #define PL_delaymagic          (aTHX->Tdelaymagic)
 #define PL_dirty               (aTHX->Tdirty)
 #define PL_dumpindent          (aTHX->Tdumpindent)
+#define PL_efloatbuf           (aTHX->Tefloatbuf)
+#define PL_efloatsize          (aTHX->Tefloatsize)
 #define PL_extralen            (aTHX->Textralen)
 #define PL_firstgv             (aTHX->Tfirstgv)
 #define PL_formtarget          (aTHX->Tformtarget)
@@ -1136,6 +1134,8 @@
 #define PL_Tdelaymagic         PL_delaymagic
 #define PL_Tdirty              PL_dirty
 #define PL_Tdumpindent         PL_dumpindent
+#define PL_Tefloatbuf          PL_efloatbuf
+#define PL_Tefloatsize         PL_efloatsize
 #define PL_Textralen           PL_extralen
 #define PL_Tfirstgv            PL_firstgv
 #define PL_Tformtarget         PL_formtarget

diff --git a/intrpvar.h b/intrpvar.h
index a291d39..669e6f9 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -353,8 +353,6 @@ PERLVAR(Iyyval,             YYSTYPE)
 PERLVAR(Iyylval,       YYSTYPE)
 
 PERLVAR(Iglob_index,   int)
-PERLVAR(Iefloatbuf,    char*)
-PERLVAR(Iefloatsize,   STRLEN)
 PERLVAR(Isrand_called, bool)
 PERLVARA(Iuudmap,256,  char)
 PERLVAR(Ibitcount,     char *)

diff --git a/objXSUB.h b/objXSUB.h
index 437a219..5da23fe 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -130,10 +130,6 @@
 #define PL_dowarn              (*Perl_Idowarn_ptr(aTHXo))
 #undef  PL_e_script
 #define PL_e_script            (*Perl_Ie_script_ptr(aTHXo))
-#undef  PL_efloatbuf
-#define PL_efloatbuf           (*Perl_Iefloatbuf_ptr(aTHXo))
-#undef  PL_efloatsize
-#define PL_efloatsize          (*Perl_Iefloatsize_ptr(aTHXo))
 #undef  PL_egid
 #define PL_egid                        (*Perl_Iegid_ptr(aTHXo))
 #undef  PL_endav
@@ -580,6 +576,10 @@
 #define PL_dirty               (*Perl_Tdirty_ptr(aTHXo))
 #undef  PL_dumpindent
 #define PL_dumpindent          (*Perl_Tdumpindent_ptr(aTHXo))
+#undef  PL_efloatbuf
+#define PL_efloatbuf           (*Perl_Tefloatbuf_ptr(aTHXo))
+#undef  PL_efloatsize
+#define PL_efloatsize          (*Perl_Tefloatsize_ptr(aTHXo))
 #undef  PL_extralen
 #define PL_extralen            (*Perl_Textralen_ptr(aTHXo))
 #undef  PL_firstgv

diff --git a/perl.c b/perl.c
index ed88bc3..de91ed4 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -409,6 +409,11 @@ perl_destruct(pTHXx)
     Safefree(PL_screamnext);
     PL_screamnext  = 0;
 
+    /* float buffer */
+    Safefree(PL_efloatbuf);
+    PL_efloatbuf = Nullch;
+    PL_efloatsize = 0;
+
     /* startup and shutdown function lists */
     SvREFCNT_dec(PL_beginav);
     SvREFCNT_dec(PL_endav);

diff --git a/perlapi.c b/perlapi.c
index f04706c..ed7ab92 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -4134,16 +4134,16 @@ Perl_sv_usepvn(pTHXo_ SV* sv, char* ptr, STRLEN len)
 
 #undef  Perl_sv_vcatpvfn
 void
-Perl_sv_vcatpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale)
+Perl_sv_vcatpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted)
 {
-    ((CPerlObj*)pPerl)->Perl_sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale);
+    ((CPerlObj*)pPerl)->Perl_sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
 }
 
 #undef  Perl_sv_vsetpvfn
 void
-Perl_sv_vsetpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale)
+Perl_sv_vsetpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted)
 {
-    ((CPerlObj*)pPerl)->Perl_sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale);
+    ((CPerlObj*)pPerl)->Perl_sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
 }
 
 #undef  Perl_swash_init

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 0d47260..995a671 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -4120,6 +4120,13 @@ If C<use locale> is in effect, the character used for the decimal
 point in formatted real numbers is affected by the LC_NUMERIC locale.
 See L<perllocale>.
 
+To cope with broken systems that allow the standard locales to be
+overridden by malicious users, the return value may be tainted
+if any of the floating point formats are used and the conversion
+yields something that doesn't look like a normal C-locale floating
+point number.  This happens regardless of whether C<use locale> is
+in effect or not.
+
 If Perl understands "quads" (64-bit integers) (this requires
 either that the platform natively supports quads or that Perl
 has been specifically compiled to support quads), the characters

diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 93d4bd7..af12297 100644 (file)
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -3649,24 +3649,26 @@ Like C<sv_usepvn>, but also handles 'set' magic.
 
        void    sv_usepvn_mg (SV* sv, char* ptr, STRLEN len)
 
-=item sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
+=item sv_vcatpvfn
 
 Processes its arguments like C<vsprintf> and appends the formatted output
 to an SV.  Uses an array of SVs if the C style variable argument list is
-missing (NULL).  Indicates if locale information has been used for formatting.
+missing (NULL).  When running with taint checks enabled, indicates via
+C<maybe_tainted> if results are untrustworthy (often due to the use of
+locales).
 
        void    sv_catpvfn (SV* sv, const char* pat, STRLEN patlen,
                            va_list *args, SV **svargs, I32 svmax,
-                           bool *used_locale);
+                           bool *maybe_tainted);
 
-=item sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
+=item sv_vsetpvfn
 
 Works like C<vcatpvfn> but copies the text into the SV instead of
 appending it.
 
        void    sv_setpvfn (SV* sv, const char* pat, STRLEN patlen,
                            va_list *args, SV **svargs, I32 svmax,
-                           bool *used_locale);
+                           bool *maybe_tainted);
 
 =item SvUV
 

diff --git a/proto.h b/proto.h
index ddb3142..38c7ce6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -630,8 +630,8 @@ VIRTUAL void        Perl_sv_unref(pTHX_ SV* sv);
 VIRTUAL void   Perl_sv_untaint(pTHX_ SV* sv);
 VIRTUAL bool   Perl_sv_upgrade(pTHX_ SV* sv, U32 mt);
 VIRTUAL void   Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len);
-VIRTUAL void   Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale);
-VIRTUAL void   Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *used_locale);
+VIRTUAL void   Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
+VIRTUAL void   Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
 VIRTUAL SV*    Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none);
 VIRTUAL UV     Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr);
 VIRTUAL void   Perl_taint_env(pTHX);

diff --git a/sv.c b/sv.c
index 956f3b9..acded31 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4645,14 +4645,14 @@ Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
 }
 
 void
-Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale)
+Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
 {
     sv_setpvn(sv, "", 0);
-    sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale);
+    sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
 }
 
 void
-Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale)
+Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
 {
     dTHR;
     char *p;
@@ -5086,6 +5086,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                Safefree(PL_efloatbuf);
                PL_efloatsize = need + 20; /* more fudge */
                New(906, PL_efloatbuf, PL_efloatsize, char);
+               PL_efloatbuf[0] = '\0';
            }
 
            eptr = ebuf + sizeof ebuf;
@@ -5125,15 +5126,36 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            eptr = PL_efloatbuf;
            elen = strlen(PL_efloatbuf);
 
-#ifdef LC_NUMERIC
+#ifdef USE_LOCALE_NUMERIC
            /*
             * User-defined locales may include arbitrary characters.
-            * And, unfortunately, some system may alloc the "C" locale
-            * to be overridden by a malicious user.
+            * And, unfortunately, some (broken) systems may allow the
+            * "C" locale to be overridden by a malicious user.
+            * XXX This is an extreme way to cope with broken systems.
             */
-           if (used_locale)
-               *used_locale = TRUE;
-#endif /* LC_NUMERIC */
+           if (maybe_tainted && PL_tainting) {
+               /* safe if it matches /[-+]?\d*(\.\d*)?([eE][-+]?\d*)?/ */
+               if (*eptr == '-' || *eptr == '+')
+                   ++eptr;
+               while (isDIGIT(*eptr))
+                   ++eptr;
+               if (*eptr == '.') {
+                   ++eptr;
+                   while (isDIGIT(*eptr))
+                       ++eptr;
+               }
+               if (*eptr == 'e' || *eptr == 'E') {
+                   ++eptr;
+                   if (*eptr == '-' || *eptr == '+')
+                       ++eptr;
+                   while (isDIGIT(*eptr))
+                       ++eptr;
+               }
+               if (*eptr)
+                   *maybe_tainted = TRUE;      /* results are suspect */
+               eptr = PL_efloatbuf;
+           }
+#endif /* USE_LOCALE_NUMERIC */
 
            break;
 

diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index 82adcf3..c453c47 100755 (executable)
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -78,9 +78,9 @@ check_taint       7, "\L$a";
 check_taint       8, lcfirst($a);
 check_taint       9, "\l$a";
 
-check_taint      10, sprintf('%e', 123.456);
-check_taint      11, sprintf('%f', 123.456);
-check_taint      12, sprintf('%g', 123.456);
+check_taint_not  10, sprintf('%e', 123.456);
+check_taint_not  11, sprintf('%f', 123.456);
+check_taint_not  12, sprintf('%g', 123.456);
 check_taint_not  13, sprintf('%d', 123.456);
 check_taint_not  14, sprintf('%x', 123.456);
 

diff --git a/thrdvar.h b/thrdvar.h
index 4434b5d..06bcb5b 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -119,6 +119,10 @@ PERLVAR(Tfirstgv,  GV *)           /* $a */
 PERLVAR(Tsecondgv,     GV *)           /* $b */
 PERLVAR(Tsortcxix,     I32)            /* from pp_ctl.c */
 
+/* float buffer */
+PERLVAR(Tefloatbuf,    char*)
+PERLVAR(Tefloatsize,   STRLEN)
+
 /* regex stuff */
 
 PERLVAR(Tscreamfirst,  I32 *)