From: Gurusamy Sarathy Date: Sun, 12 Sep 1999 20:08:56 +0000 (+0000) Subject: make sprintf("%g",...) threadsafe; only taint its result iff the X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d5ea4e771e13c538d9f0504cb48d13891fcb5c9;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4120,6 +4120,13 @@ If C is in effect, the character used for the decimal point in formatted real numbers is affected by the LC_NUMERIC locale. See L. +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 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 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -3649,24 +3649,26 @@ Like C, 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 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 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 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 --- 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 --- 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 --- 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 --- 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 *)