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

Owner: Nobody
Requestors: kentfredric <kentnl [at] cpan.org>
Cc:
AdminCc:

Operating System: Linux
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.22.0
Fixed In: (no value)



Subject: integer overflow in line number tracking reported by caller()
Download (untitled) / with headers
text/plain 5.2k
In conjunction with any code that can declare an arbitrary line number in the form: #line N If N is larger than: ( 1 << 31 ) - 1 then caller() will return a line number with integer overflow, causing the signed integer to return negative values. This may have slight implications for security related code, as it allows strings of eval'd code to emit numerical ranges that are likely outside the scope that people have tested for, due to assuming an unsigned integer. Its hard to imagine a real usecase for this, but its a bug that probably should be fixed in some regard. Attached is a simple demonstration of an overflow condition that can be constructed, and how you could hide a backdoor in your code, despite Safe. This is not *really* a security hole as such yet, because you could easily achieve intended unusual behavior at a distance simply by passing any other unusually large line number and with a similar specific condition. So this bug is more a representation of the fact you can't *explicitly* declare negative line numbers and have them respected, so it stands to reason caller() shouldn't return negative numbers either. Additional tests attached: neg_line.t : merely tests negative values are repressed. badline.t: pokes around in bits and tries to see if LINENO avoids integer overflow if Perl's own integers could avoid integer overflow. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl 5.22.0: Configured by kent at Fri Jun 19 08:03:55 NZST 2015. Summary of my perl5 (revision 5 version 22 subversion 0) configuration: Platform: osname=linux, osvers=4.0.0-gentoo, archname=x86_64-linux uname='linux katipo2 4.0.0-gentoo #23 smp preempt sat apr 25 06:58:21 nzst 2015 x86_64 intel(r) core(tm) i5-2410m cpu @ 2.30ghz genuineintel gnulinux ' config_args='-de -Dprefix=/home/kent/perl5/perlbrew/perls/5.22.0 -Dusecbacktrace -Doptimize= -fno-stack-protector -O3 -march=native -mtune=native -Dman1dir=none -Dman3dir=none -Accflags= -fno-stack-protector -DPERL_HASH_FUNC_SDBM -DUSE_C_BACKTRACE_ON_ERROR -Aldflags= -fno-stack-protector -lbfd -Aeval:scriptdir=/home/kent/perl5/perlbrew/perls/5.22.0/bin' hint=recommended, useposix=true, d_sigaction=define useithreads=undef, usemultiplicity=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-fno-stack-protector -DPERL_HASH_FUNC_SDBM -DUSE_C_BACKTRACE_ON_ERROR -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -DUSE_C_BACKTRACE -g -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize=' -fno-stack-protector -O3 -march=native -mtune=native', cppflags='-fno-stack-protector -DPERL_HASH_FUNC_SDBM -DUSE_C_BACKTRACE_ON_ERROR -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong' ccversion='', gccversion='4.9.2', gccosandvers='' intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3 ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='cc', ldflags =' -fno-stack-protector -lbfd -fstack-protector-strong -L/usr/local/lib' libpth=/usr/lib/gcc/x86_64-pc-linux-gnu/4.9.2/include-fixed /usr/lib /usr/local/lib /lib/../lib64 /usr/lib/../lib64 /lib /lib64 /usr/lib64 /usr/local/lib64 libs=-lpthread -lnsl -lnm -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat perllibs=-lpthread -lnsl -lnm -ldl -lm -lcrypt -lutil -lc libc=libc-2.20.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.20' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -fno-stack-protector -O3 -march=native -mtune=native -L/usr/local/lib -fstack-protector-strong' --- @INC for perl 5.22.0: /home/kent/perl5/perlbrew/perls/5.22.0/lib/site_perl/5.22.0/x86_64-linux /home/kent/perl5/perlbrew/perls/5.22.0/lib/site_perl/5.22.0 /home/kent/perl5/perlbrew/perls/5.22.0/lib/5.22.0/x86_64-linux /home/kent/perl5/perlbrew/perls/5.22.0/lib/5.22.0 . --- Environment for perl 5.22.0: HOME=/home/kent LANG (unset) LANGUAGE (unset) LC_CTYPE=en_NZ.UTF8 LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/kent/perl5/perlbrew/bin:/home/kent/perl5/perlbrew/perls/5.22.0/bin:/home/kent/.perl6/2013.04/bin:/home/kent/.gem/ruby/1.8/bin/:/home/kent/.rvm/gems/ruby-2.1.2/bin:/home/kent/.rvm/gems/ruby-2.1.2@global/bin:/home/kent/.rvm/rubies/ruby-2.1.2/bin:/usr/local/bin:/usr/bin:/bin:/opt/bin:/usr/x86_64-pc-linux-gnu/gcc-bin/5.2.0:/opt/android-sdk-update-manager/tools:/opt/android-sdk-update-manager/platform-tools:/usr/games/bin:/home/kent/.rvm/bin:/home/kent/.rvm/bin PERLBREW_BASHRC_VERSION=0.72 PERLBREW_HOME=/home/kent/.perlbrew PERLBREW_MANPATH=/home/kent/perl5/perlbrew/perls/5.22.0/man PERLBREW_PATH=/home/kent/perl5/perlbrew/bin:/home/kent/perl5/perlbrew/perls/5.22.0/bin PERLBREW_PERL=5.22.0 PERLBREW_ROOT=/home/kent/perl5/perlbrew PERLBREW_VERSION=0.72 PERL_BADLANG (unset) SHELL=/bin/bash
Subject: badline.t
Download badline.t
text/plain 1.3k
#!/usr/bin/env perl # FILENAME: badline.pl # CREATED: 12/23/15 00:42:09 by Kent Fredric (kentnl) <kentfredric@gmail.com> # ABSTRACT: Bad line numbers use strict; use warnings; use Carp; sub getlineno { [ caller() ]->[2]; } sub mk_bits { my ( $bits, $pad ) = @_; return '0b1' . ( $pad x ( $bits - 1 ) ); } use Test::More; sub can_trip { my ($value) = @_; my $type = $value; { local $@; no warnings 'portable'; # binary convertable thngs get annoying before they fail use warnings FATAL => 'overflow'; # explode when they fail plz $value = eval "sprintf q[%u], $value"; if ( $@ or $value < 0 ) { local $TODO = "Invalid on this perl"; ok( 0, $type ); return; } } local $@; my $t_value = eval "\n#line $value\ngetlineno\n"; die $@ if $@; return is( $t_value, $value, $type ); } for my $bits ( 2, 31, 32, 63, 64, 65 ) { subtest "$bits bits" => sub { my $zeros = mk_bits( $bits, 0 ); note "Testing: $zeros(=$bits)"; can_trip( $zeros . ' - 1 ' ); can_trip($zeros); can_trip( $zeros . ' + 1 ' ); my $ones = mk_bits( $bits, 1 ); note "Testing: $ones(=$bits)"; can_trip( $ones . ' - 1' ); can_trip($ones); can_trip( $ones . ' + 1' ); }; } pass(); done_testing;
Subject: neg_line.t
Download neg_line.t
text/plain 484b
#!/usr/bin/env perl # ABSTRACT: Check for 32bit line number overflow use strict; use warnings; use Test::More; #line -5 isnt( sub { [caller]->[2] } ->(), '-5', "Line number negative-5 can't happen" ); #line 2147483648 cmp_ok( sub { [caller]->[2] } ->(), '>', '0', "Line numbers over SIGNED_INT_MAX don't overflow" ); #line 4294967291 isnt( sub { [caller]->[2] } ->(), '-5', "Line numbers negative-5 can't happen even with overflow" ); done_testing;
Subject: safe_attack.pl
Download safe_attack.pl
text/x-perl 676b
#!/usr/bin/env perl # ABSTRACT: Unsafe numbers use strict; use warnings; my $BAD_NUMBER = ( 1 << 31 ); my $GOOD_NUMBER = ( 1 << 31 ) - 1; my $NUMBER = $BAD_NUMBER; my $ATTACK_INPUT = "sub {\n#line $NUMBER\ngetlineno}->()"; sub getlineno { [ caller() ]->[2]; } use Safe; my $safe = Safe->new(); $safe->share('&getlineno'); sub DumperObject { require Data::Dumper; my $dd = Data::Dumper->new( [] ); $dd->Terse(1)->Indent(1)->Useqq(1)->Deparse(1)->Quotekeys(0)->Sortkeys(1); } print DumperObject->Values( [$ATTACK_INPUT] )->Dump; my $num = $safe->reval($ATTACK_INPUT); if ( $num > 0 ) { print "Safe\n"; } else { print "Hacked: $num\n"; }
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 988b
On Tue Dec 22 07:27:06 2015, kentfredric wrote: Show quoted text
> In conjunction with any code that can declare an arbitrary line number > in the form: > > #line N > > If N is larger than: > > ( 1 << 31 ) - 1 > > then caller() will return a line number with integer overflow, causing > the signed integer > to return negative values.
The line number is stored as a line_t which is a typedef for U32, but pp_caller treats it as signed: mPUSHi((I32)CopLINE(lcop)); which should probably change. This still wouldn't give us full 32-bit unsigned line numbers since gp_line in a GP is only 31 bits: GV * gp_egv; /* effective gv, if *glob */ PERL_BITFIELD32 gp_line:31; /* line first declared at (for -w) */ PERL_BITFIELD32 gp_flags:1; which results in fun like: $ ./perl -we '#line 3000000000' -e 'if ($x = 1) { }' Found = in conditional, should be == at -e line 3000000000. Name "main::x" used only once: possible typo at -e line 852516352. Patch for pp_caller attached. Tony
Subject: 0001-perl-126991-treat-cop_line-as-unsigned-in-caller-sin.patch
From f1962383f0c9d13ec9de46ef66a8a7033707ad8e Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 4 Jan 2016 14:05:32 +1100 Subject: [perl #126991] treat cop_line as unsigned in caller() (since it is) --- pp_ctl.c | 2 +- t/op/caller.t | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index c006ce9..011da56 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1808,7 +1808,7 @@ PP(pp_caller) cx->blk_sub.retop, TRUE); if (!lcop) lcop = cx->blk_oldcop; - mPUSHi((I32)CopLINE(lcop)); + mPUSHu(CopLINE(lcop)); if (!has_arg) RETURN; if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { diff --git a/t/op/caller.t b/t/op/caller.t index 6e56d67..80d3a5a 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan( tests => 95 ); + plan( tests => 96 ); } my @c; @@ -308,6 +308,11 @@ is eval "s//<<END/e;\nfoo\nEND\n(caller 0)[6]", is $w, 1, 'value from (caller 0)[9] (bitmask) works in ${^WARNING_BITS}'; } +# [perl #126991] +sub getlineno { (caller)[2] } +my $line = eval "\n#line 3000000000\ngetlineno();"; +is $line, "3000000000", "check large line numbers are preserved"; + # This was fixed with commit d4d03940c58a0177, which fixed bug #78742 fresh_perl_is <<'END', "__ANON__::doof\n", {}, package foo; -- 2.1.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 855b
On Sun Jan 03 19:08:24 2016, tonyc wrote: Show quoted text
> > The line number is stored as a line_t which is a typedef for U32, but > pp_caller treats it as signed: > > mPUSHi((I32)CopLINE(lcop)); > > which should probably change.
... Show quoted text
> Patch for pp_caller attached.
Applied as e9e9e546c6762874da180492e33c78382c00e560. Show quoted text
> This still wouldn't give us full 32-bit unsigned line numbers since > gp_line in a GP is only 31 bits: > > GV * gp_egv; /* effective gv, if *glob */ > PERL_BITFIELD32 gp_line:31; /* line first declared at (for -w) */ > PERL_BITFIELD32 gp_flags:1; > > which results in fun like: > > $ ./perl -we '#line 3000000000' -e 'if ($x = 1) { }' > Found = in conditional, should be == at -e line 3000000000. > Name "main::x" used only once: possible typo at -e line 852516352.
This isn't fixed and I don't think it's worth fixing. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1012b
On Wed Jan 20 16:05:38 2016, tonyc wrote: Show quoted text
> > This still wouldn't give us full 32-bit unsigned line numbers since > > gp_line in a GP is only 31 bits: > > > > GV * gp_egv; /* effective gv, if *glob */ > > PERL_BITFIELD32 gp_line:31; /* line first declared at (for -w) */ > > PERL_BITFIELD32 gp_flags:1; > > > > which results in fun like: > > > > $ ./perl -we '#line 3000000000' -e 'if ($x = 1) { }' > > Found = in conditional, should be == at -e line 3000000000. > > Name "main::x" used only once: possible typo at -e line 852516352.
> > This isn't fixed and I don't think it's worth fixing. > > Tony
Attempting to feed > 2 GB of perl source code per perl source code file (a 20 GB .pm, oh really?) through the compiler IMO should fail assuming the OS didn't kill the process due to resource limits first. Some example would be another tool, like a shell script, trying to feed/pipe the same statement line, an infinite number of times, into perl's STDIN. -- bulk88 ~ bulk88 at hotmail.com


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