From owner-freebsd-bugs Sun Sep 12 13:28:55 1999 Delivered-To: freebsd-bugs@freebsd.org Received: from activestate.com (maul.activestate.com [199.60.48.19]) by hub.freebsd.org (Postfix) with ESMTP id C2FC114E24 for ; Sun, 12 Sep 1999 13:28:31 -0700 (PDT) (envelope-from gsar@activestate.com) Received: from localhost (IDENT:gsar@localhost [127.0.0.1]) by activestate.com (8.9.3/8.9.3) with ESMTP id NAA27081; Sun, 12 Sep 1999 13:32:17 -0700 Message-Id: <199909122032.NAA27081@activestate.com> To: David Muir Sharnoff Cc: perl5-porters@perl.org, freebsd-bugs@freebsd.org Subject: Re: [ID 19990727.005] sprintf considered insecure? In-reply-to: Your message of "Tue, 27 Jul 1999 00:00:18 PDT." <199907270700.AAA48007@idiom.com> Date: Sun, 12 Sep 1999 13:32:17 -0700 From: Gurusamy Sarathy Sender: owner-freebsd-bugs@FreeBSD.ORG Precedence: bulk X-Loop: FreeBSD.org On Tue, 27 Jul 1999 00:00:18 PDT, David Muir Sharnoff wrote: >This is a bug report for perl from muir@idiom.com, >generated with the help of perlbug 1.26 running under perl 5.00502. > > >----------------------------------------------------------------- > >The following script dies with: > > Insecure dependency in system while running with -T switch at ./x line >6. > >The script is: > > #!/usr/local/bin/perl -T > > $ENV{PATH} = "/bin:/usr/bin"; > $a = 77; > $b = sprintf("%1.2f", $a); > system("echo $b"); > >Changing the 5th line to "$b = $a" fixes the problem. > >Does someone have something against sprintf? > >-Dave > >PS. The platform information below is wrong. Here's the right stuff: > >FreeBSD idiom.com 3.2-RELEASE FreeBSD 3.2-RELEASE #12: Tue Jun 1 15:34:35 PDT > 1999 root@grin.idiom.com:/build/src/sys/compile/NEW i386 Perl's sprintf() uses the system's sprintf() for formatting floats, which is apparently not safe on systems where locales can be overridden by users. I don't know if this is still true on real systems (and freebsd), but it is unfortunate that such brokenness should affect Perl code. The attached patch will help most common scenarios. Sarathy gsar@activestate.com -----------------------------------8<----------------------------------- Change 4130 by gsar@auger on 1999/09/12 20:08:56 make sprintf("%g",...) threadsafe; only taint its result iff the formatted result looks nonstandard Affected files ... ... //depot/perl/embed.pl#63 edit ... //depot/perl/embedvar.h#71 edit ... //depot/perl/intrpvar.h#41 edit ... //depot/perl/objXSUB.h#68 edit ... //depot/perl/perl.c#166 edit ... //depot/perl/perlapi.c#17 edit ... //depot/perl/pod/perlfunc.pod#101 edit ... //depot/perl/pod/perlguts.pod#49 edit ... //depot/perl/proto.h#156 edit ... //depot/perl/sv.c#146 edit ... //depot/perl/t/pragma/locale.t#18 edit ... //depot/perl/thrdvar.h#33 edit Differences ... ==== //depot/perl/embed.pl#63 (xtext) ==== Index: perl/embed.pl --- perl/embed.pl.~1~ Sun Sep 12 13:09:05 1999 +++ perl/embed.pl Sun Sep 12 13:09:05 1999 @@ -1653,10 +1653,10 @@ 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 ==== //depot/perl/embedvar.h#71 (text+w) ==== Index: perl/embedvar.h --- perl/embedvar.h.~1~ Sun Sep 12 13:09:05 1999 +++ perl/embedvar.h Sun Sep 12 13:09:05 1999 @@ -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 ==== //depot/perl/intrpvar.h#41 (text) ==== Index: perl/intrpvar.h --- perl/intrpvar.h.~1~ Sun Sep 12 13:09:05 1999 +++ perl/intrpvar.h Sun Sep 12 13:09:05 1999 @@ -353,8 +353,6 @@ PERLVAR(Iyylval, YYSTYPE) PERLVAR(Iglob_index, int) -PERLVAR(Iefloatbuf, char*) -PERLVAR(Iefloatsize, STRLEN) PERLVAR(Isrand_called, bool) PERLVARA(Iuudmap,256, char) PERLVAR(Ibitcount, char *) ==== //depot/perl/objXSUB.h#68 (text+w) ==== Index: perl/objXSUB.h --- perl/objXSUB.h.~1~ Sun Sep 12 13:09:05 1999 +++ perl/objXSUB.h Sun Sep 12 13:09:05 1999 @@ -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 ==== //depot/perl/perl.c#166 (text) ==== Index: perl/perl.c --- perl/perl.c.~1~ Sun Sep 12 13:09:05 1999 +++ perl/perl.c Sun Sep 12 13:09:05 1999 @@ -409,6 +409,11 @@ 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); ==== //depot/perl/perlapi.c#17 (text+w) ==== Index: perl/perlapi.c --- perl/perlapi.c.~1~ Sun Sep 12 13:09:05 1999 +++ perl/perlapi.c Sun Sep 12 13:09:05 1999 @@ -4134,16 +4134,16 @@ #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 ==== //depot/perl/pod/perlfunc.pod#101 (text) ==== Index: perl/pod/perlfunc.pod --- perl/pod/perlfunc.pod.~1~ Sun Sep 12 13:09:05 1999 +++ perl/pod/perlfunc.pod Sun Sep 12 13:09:05 1999 @@ -4120,6 +4120,13 @@ 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 ==== //depot/perl/pod/perlguts.pod#49 (text) ==== Index: perl/pod/perlguts.pod --- perl/pod/perlguts.pod.~1~ Sun Sep 12 13:09:05 1999 +++ perl/pod/perlguts.pod Sun Sep 12 13:09:05 1999 @@ -3649,24 +3649,26 @@ 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 ==== //depot/perl/proto.h#156 (text+w) ==== Index: perl/proto.h --- perl/proto.h.~1~ Sun Sep 12 13:09:05 1999 +++ perl/proto.h Sun Sep 12 13:09:05 1999 @@ -630,8 +630,8 @@ 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); ==== //depot/perl/sv.c#146 (text) ==== Index: perl/sv.c --- perl/sv.c.~1~ Sun Sep 12 13:09:05 1999 +++ perl/sv.c Sun Sep 12 13:09:05 1999 @@ -4645,14 +4645,14 @@ } 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 @@ 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 @@ 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; ==== //depot/perl/t/pragma/locale.t#18 (xtext) ==== Index: perl/t/pragma/locale.t --- perl/t/pragma/locale.t.~1~ Sun Sep 12 13:09:05 1999 +++ perl/t/pragma/locale.t Sun Sep 12 13:09:05 1999 @@ -78,9 +78,9 @@ 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); ==== //depot/perl/thrdvar.h#33 (text) ==== Index: perl/thrdvar.h --- perl/thrdvar.h.~1~ Sun Sep 12 13:09:05 1999 +++ perl/thrdvar.h Sun Sep 12 13:09:05 1999 @@ -119,6 +119,10 @@ PERLVAR(Tsecondgv, GV *) /* $b */ PERLVAR(Tsortcxix, I32) /* from pp_ctl.c */ +/* float buffer */ +PERLVAR(Tefloatbuf, char*) +PERLVAR(Tefloatsize, STRLEN) + /* regex stuff */ PERLVAR(Tscreamfirst, I32 *) End of Patch. To Unsubscribe: send mail to majordomo@FreeBSD.org with "unsubscribe freebsd-bugs" in the body of the message