Skip Menu |
Report information
Id: 131894
Status: open
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: brian.carpenter [at] gmail.com
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: low
Type: unknown
Perl Version: (no value)
Fixed In: (no value)

Attachments
0001-perl-131894-don-t-shift-by-a-negative-value-in-C.patch
0001-perl-131894-limit-the-digits-after-the-decimal-for-b.patch



Date: Mon, 14 Aug 2017 02:01:59 -0500
To: perlbug [...] perl.org
From: Brian Carpenter <brian.carpenter [...] gmail.com>
Subject: runtime error: shift exponent -2 is negative (toke.c:10966:54)
Download (untitled) / with headers
text/plain 761b
While fuzzing v5.27.2-135-g7aaa36b196*, undefined-behavior was triggered in the form of 'shift exponent -2 is negative' in toke.c.

./perl -e '03000000000000000000.0'

toke.c:10966:54: runtime error: shift exponent -2 is negative
    #0 0x92bbc9 in Perl_scan_num /root/perl5/toke.c:10966:54
    #1 0x825478 in Perl_yylex /root/perl5/toke.c:6828:6
    #2 0x965910 in Perl_yyparse /root/perl5/perly.c:340:34
    #3 0x6c1dfe in S_parse_body /root/perl5/perl.c:2414:9
    #4 0x6aeb39 in perl_parse /root/perl5/perl.c:1732:2
    #5 0x5251b6 in main /root/perl5/perlmain.c:121:18
    #6 0x7f9d19e294d9 in __libc_start_main (/lib64/libc.so.6+0x204d9)
    #7 0x4359d9 in _start (/root/perl5/perl+0x4359d9)

SUMMARY: AddressSanitizer: undefined-behavior toke.c:10966:54
RT-Send-CC: perl5-porters [...] perl.org
On Mon, 14 Aug 2017 00:02:53 -0700, brian.carpenter@gmail.com wrote: Show quoted text
> While fuzzing v5.27.2-135-g7aaa36b196*, undefined-behavior was triggered in > the form of 'shift exponent -2 is negative' in toke.c. > > ./perl -e '03000000000000000000.0' > > toke.c:10966:54: runtime error: shift exponent -2 is negative > #0 0x92bbc9 in Perl_scan_num /root/perl5/toke.c:10966:54 > #1 0x825478 in Perl_yylex /root/perl5/toke.c:6828:6 > #2 0x965910 in Perl_yyparse /root/perl5/perly.c:340:34 > #3 0x6c1dfe in S_parse_body /root/perl5/perl.c:2414:9 > #4 0x6aeb39 in perl_parse /root/perl5/perl.c:1732:2 > #5 0x5251b6 in main /root/perl5/perlmain.c:121:18 > #6 0x7f9d19e294d9 in __libc_start_main (/lib64/libc.so.6+0x204d9) > #7 0x4359d9 in _start (/root/perl5/perl+0x4359d9) > > SUMMARY: AddressSanitizer: undefined-behavior toke.c:10966:54
Similarly for ./miniperl -e '0x030000000000000.0' The attached seems to fix it, but it would be nice if jhi took a look at it. It seems wrong to me that this code is entered for your original octal case. Tony
Subject: 0001-perl-131894-don-t-shift-by-a-negative-value-in-C.patch
From 86c0a707c9b01b8506f5a171fc05a7cb3acaf651 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Tue, 15 Aug 2017 11:18:39 +1000 Subject: (perl #131894) don't shift by a negative value in C --- t/op/hexfp.t | 9 ++++++++- toke.c | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/t/op/hexfp.t b/t/op/hexfp.t index 29378f2..a3529e4 100644 --- a/t/op/hexfp.t +++ b/t/op/hexfp.t @@ -10,7 +10,7 @@ use strict; use Config; -plan(tests => 109); +plan(tests => 110); # Test hexfloat literals. @@ -255,6 +255,13 @@ SKIP: { is(0x1p-16445, 3.6451995318824746e-4951); } +SKIP: { + skip("non-64-bit NVs", 1) + unless $Config{nvsize} == 8 && $Config{d_double_style_ieee}; + fresh_perl_is('printf qq(%a\n), 0x030000000000000.1p0', '0x1.8p+53', { stderr => 1 }, + "ASAN undefined error parsing the first"); +} + # sprintf %a/%A testing is done in sprintf2.t, # trickier than necessary because of long doubles, # and because looseness of the spec. diff --git a/toke.c b/toke.c index 6de7d09..c6c78df 100644 --- a/toke.c +++ b/toke.c @@ -10953,7 +10953,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) hexfp_uquad <<= shift; hexfp_uquad |= b; hexfp_frac_bits += shift; - } else { + } else if (significant_bits - shift < NV_MANT_DIG) { /* We are at a hexdigit either at, * or straddling, the edge of mantissa. * We will try grabbing as many as -- 2.1.4
Subject: Re: [perl #131894] runtime error: shift exponent -2 is negative (toke.c:10966:54)
From: Jarkko Hietaniemi <jhi [...] iki.fi>
Date: Wed, 16 Aug 2017 09:41:32 +0300
To: perlbug-followup [...] perl.org
Download (untitled) / with headers
text/plain 1.4k
On Tuesday-201708-15 4:21, Tony Cook via RT wrote: Show quoted text
> The attached seems to fix it, but it would be nice if jhi took a look at it.
Looks good to me, with the following nits. - test both the original octal case and the hex case - the test case probably should mention the RT ticket If you apply this to the blead I can smoke in my "private cloud" which has some non-x86 fp boxes. Though I don't have asan available there. Show quoted text
> It seems wrong to me that this code is entered for your original octal case.
Yeah, that does smell wrong. We shouldn't be doing hexfp scanning unless we have seen the "0x" leader. Though, the icky part about the hexfp syntax is though that we don't know until we see the [pP][+-]?[0-9] whether it is a hexfp, as opposed to a "hexint", so there might be a lot of lookahead before we can commit to an interpretation. This is not being helped at all by the concat operator looking a lot like the decimal separator. Relatedly: I remember there being a known "loophole" so that the scanning code currently accidentally, falling naturally out of the implementation, is also doing "binary fp" and "octal fp". Ah yes: ./miniperl -wle 'print 0b11.1p0' 3.5 ./miniperl -wle 'print 011.1p0' 9.125 This is probably not documented anywhere. I can't now think of the right search terms to find any previous discussion, there was something about should this be rejected, or not. If not (as is currently the case), maybe this possibly should be tested, documented, and made official?
Date: Wed, 16 Aug 2017 18:34:13 +1000
To: Jarkko Hietaniemi <jhi [...] iki.fi>
CC: perlbug-followup [...] perl.org
Subject: Re: [perl #131894] runtime error: shift exponent -2 is negative (toke.c:10966:54)
From: Tony Cook <tony [...] develop-help.com>
Download (untitled) / with headers
text/plain 1.9k
On Wed, Aug 16, 2017 at 09:41:32AM +0300, Jarkko Hietaniemi wrote: Show quoted text
> On Tuesday-201708-15 4:21, Tony Cook via RT wrote:
> >The attached seems to fix it, but it would be nice if jhi took a look at it.
> > Looks good to me, with the following nits. > - test both the original octal case and the hex case > - the test case probably should mention the RT ticket > > If you apply this to the blead I can smoke in my "private cloud" which has > some non-x86 fp boxes. Though I don't have asan available there. >
> >It seems wrong to me that this code is entered for your original octal case.
> > Yeah, that does smell wrong. We shouldn't be doing hexfp scanning unless we > have seen the "0x" leader. > > Though, the icky part about the hexfp syntax is though that we don't > know until we see the [pP][+-]?[0-9] whether it is a hexfp, as opposed > to a "hexint", so there might be a lot of lookahead before we can commit to > an interpretation. This is not being helped at all by the concat > operator looking a lot like the decimal separator. > > Relatedly: I remember there being a known "loophole" so that the > scanning code currently accidentally, falling naturally out of the > implementation, is also doing "binary fp" and "octal fp". Ah yes: > > ./miniperl -wle 'print 0b11.1p0' > 3.5 > ./miniperl -wle 'print 011.1p0' > 9.125 > > This is probably not documented anywhere. I can't now think of the > right search terms to find any previous discussion, there was something > about should this be rejected, or not. If not (as is currently the > case), maybe this possibly should be tested, documented, and made > official?
And fixed, since it accepts hex digits after the (binary|octal) point: tony@mars:.../git/perl$ ./perl -wle 'print 0b11.01p0' 3.25 tony@mars:.../git/perl$ ./perl -wle 'print 0b11.0Fp0' 3.75 tony@mars:.../git/perl$ ./perl -wle 'print 0b11.000Fp0' 3.9375 tony@mars:.../git/perl$ ./perl -wle 'print 0b11.0008p0' 3.5 Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 838b
On Wed, 16 Aug 2017 01:35:08 -0700, tonyc wrote: Show quoted text
> On Wed, Aug 16, 2017 at 09:41:32AM +0300, Jarkko Hietaniemi wrote:
> > Relatedly: I remember there being a known "loophole" so that the > > scanning code currently accidentally, falling naturally out of the > > implementation, is also doing "binary fp" and "octal fp". Ah yes: > > > > ./miniperl -wle 'print 0b11.1p0' > > 3.5 > > ./miniperl -wle 'print 011.1p0' > > 9.125 > > > > This is probably not documented anywhere. I can't now think of the > > right search terms to find any previous discussion, there was > > something > > about should this be rejected, or not. If not (as is currently the > > case), maybe this possibly should be tested, documented, and made > > official?
> > And fixed, since it accepts hex digits after the > (binary|octal) point:
Per the attached. Tony
Subject: 0001-perl-131894-limit-the-digits-after-the-decimal-for-b.patch
From c425976fc53a8129872836f887ea5da3f3e71952 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Tue, 5 Sep 2017 15:26:41 +1000 Subject: (perl #131894) limit the digits after the "decimal" for bin/oct fp --- t/lib/croak/toke | 18 ++++++++++++++++++ t/op/hexfp.t | 16 +++++++++++++++- toke.c | 6 ++++-- 3 files changed, 37 insertions(+), 3 deletions(-) diff --git a/t/lib/croak/toke b/t/lib/croak/toke index c477be0..3b11ced 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -404,3 +404,21 @@ Number found where operator expected at - line 1, near "--5" (Missing operator before 5?) syntax error at - line 1, near "1e" Execution of - aborted due to compilation errors. +######## +# NAME octal fp with non-octal digits after the decimal point +01.1234567p0; +07.8p0; +EXPECT +Bareword found where operator expected at - line 2, near "8p0" + (Missing operator before p0?) +syntax error at - line 2, near "8p0" +Execution of - aborted due to compilation errors. +######## +# NAME binary fp with non-binary digits after the decimal point +0b1.10p0; +0b1.2p0; +EXPECT +Bareword found where operator expected at - line 2, near "2p0" + (Missing operator before p0?) +syntax error at - line 2, near "2p0" +Execution of - aborted due to compilation errors. diff --git a/t/op/hexfp.t b/t/op/hexfp.t index a3529e4..efe908c 100644 --- a/t/op/hexfp.t +++ b/t/op/hexfp.t @@ -10,7 +10,7 @@ use strict; use Config; -plan(tests => 110); +plan(tests => 121); # Test hexfloat literals. @@ -262,6 +262,20 @@ SKIP: { "ASAN undefined error parsing the first"); } +# the implementation also allow for octal and binary fp +is(01p0, 1); +is(01.0p0, 1); +is(01.00p0, 1); +is(010.1p0, 8.125); +is(00.400p1, 1); +is(00p0, 0); +is(01.1p0, 1.125); + +is(0b0p0, 0); +is(0b1p0, 1); +is(0b10p0, 2); +is(0b1.1p0, 1.5); + # sprintf %a/%A testing is done in sprintf2.t, # trickier than necessary because of long doubles, # and because looseness of the spec. diff --git a/toke.c b/toke.c index 84dce75..c98813b 100644 --- a/toke.c +++ b/toke.c @@ -10978,9 +10978,11 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) NV nv_mult = 1.0; #endif bool accumulate = TRUE; - for (h++; (isXDIGIT(*h) || *h == '_'); h++) { + U8 b; + int lim = 1 << shift; + for (h++; ((isXDIGIT(*h) && (b = XDIGIT_VALUE(*h)) < lim) || + *h == '_'); h++) { if (isXDIGIT(*h)) { - U8 b = XDIGIT_VALUE(*h); significant_bits += shift; #ifdef HEXFP_UQUAD if (accumulate) { -- 2.1.4


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org