jpl tweak

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index 892eb6e..4ba864c 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;
@@ -5039,6 +5039,19 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                }
                break;
            default:            /* it had better be ten or less */
+#if defined(PERL_Y2KWARN)
+               if (ckWARN(WARN_MISC)) {
+                   STRLEN n;
+                   char *s = SvPV(sv,n);
+                   if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
+                       && (n == 2 || !isDIGIT(s[n-3])))
+                   {
+                       Perl_warner(aTHX_ WARN_MISC,
+                                   "Possible Y2K bug: %%%c %s",
+                                   c, "format string following '19'");
+                   }
+               }
+#endif
                do {
                    dig = uv % base;
                    *--eptr = '0' + dig;
@@ -5088,6 +5101,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;
@@ -5127,15 +5141,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;