summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xembed.pl4
-rw-r--r--embedvar.h12
-rw-r--r--intrpvar.h2
-rw-r--r--objXSUB.h8
-rw-r--r--perl.c5
-rw-r--r--perlapi.c8
-rw-r--r--pod/perlfunc.pod7
-rw-r--r--pod/perlguts.pod12
-rw-r--r--proto.h4
-rw-r--r--sv.c40
-rwxr-xr-xt/pragma/locale.t6
-rw-r--r--thrdvar.h4
12 files changed, 75 insertions, 37 deletions
diff --git a/embed.pl b/embed.pl
index 5f0711f493..eaee6f7264 100755
--- 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 3e83de1d22..65a31f1ec7 100644
--- 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 a291d393ca..669e6f97ad 100644
--- 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 437a219a70..5da23fe984 100644
--- 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 ed88bc3eb4..de91ed456f 100644
--- 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 f04706c9cd..ed7ab92d99 100644
--- 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 0d47260e10..995a671110 100644
--- 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 93d4bd70c4..af12297ec3 100644
--- 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 ddb31429fa..38c7ce6273 100644
--- 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 956f3b961a..acded3146d 100644
--- 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 82adcf3fb8..c453c47bd1 100755
--- 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 4434b5ddb2..06bcb5b4e7 100644
--- 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 *)
View Lorry Controller Status