In perl.git, the branch smoke-me/jkeenan/130635-storable has been updated <http://perl5.git.perl.org/perl.git/commitdiff/65c6575fc34c90c99cb5aefcc66a6272fda246f5?hp=706cfb1457f378d29e5407d18dae5a7ad3c52033>
discards 706cfb1457f378d29e5407d18dae5a7ad3c52033 (commit) discards 184f06c21ab10a5e633ffced54544119a0e10d9b (commit) - Log ----------------------------------------------------------------- commit 65c6575fc34c90c99cb5aefcc66a6272fda246f5 Author: John Lightsey <[email protected]> Date: Tue Jan 24 10:30:18 2017 -0600 Fix stack buffer overflow in deserialization of hooks. The use of signed lengths resulted in a stack overflow in retrieve_hook() when a negative length was provided in the storable data. The retrieve_blessed() codepath had a similar problem with the placement of the trailing null byte when negative lengths were provided. ----------------------------------------------------------------------- Summary of changes: dist/Storable/Storable.xs | 7 +++++++ dist/Storable/t/store.t | 22 +++++----------------- doio.c | 2 +- ext/B/B.pm | 2 +- ext/B/B.xs | 2 +- hv.c | 4 ++-- hv.h | 6 ++---- locale.c | 4 +--- mathoms.c | 6 ++---- mg.c | 2 +- perl.h | 2 +- perlio.c | 4 ++-- regexp.h | 2 +- toke.c | 4 ++-- 14 files changed, 29 insertions(+), 40 deletions(-) diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index ba5f3503da..829c5d73ac 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -4069,6 +4069,9 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname) if (len & 0x80) { RLEN(len); TRACEME(("** allocating %d bytes for class name", len+1)); + if (len > I32_MAX) { + CROAK(("Corrupted classname length")); + } New(10003, classname, len+1, char); malloced_classname = classname; } @@ -4253,6 +4256,10 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) else GETMARK(len); + if (len > I32_MAX) { + CROAK(("Corrupted classname length")); + } + if (len > LG_BLESS) { TRACEME(("** allocating %d bytes for class name", len+1)); New(10003, classname, len+1, char); diff --git a/dist/Storable/t/store.t b/dist/Storable/t/store.t index 134d95894f..d1ec55d60e 100644 --- a/dist/Storable/t/store.t +++ b/dist/Storable/t/store.t @@ -103,23 +103,11 @@ isnt($@, ''); { - my $pid = fork(); - if ($pid) { - waitpid( $pid, 0 ); - ok( $? == 0 || $? == 256, 'No stack smashing error when retrieving hook' ); - } - elsif ( defined $pid ) { - close STDOUT; - close STDERR; - my $frozen = - "\x70\x73\x74\x30\x04\x0a\x08\x31\x32\x33\x34\x35\x36\x37\x38\x04\x08\x08\x08\x03\x39\xff\xfa\x09\x19\x08\x17\x68\x08\x08\x08\x08\xf9\x16\x16\x13\x16\x10\x10\x10\xff\x15\x16\x16\x16\x1e\x16 ... [554 chars truncated] - open my $fh, '<', \$frozen; - eval { Storable::fd_retrieve($fh); }; - exit(0); - } - else { - die "Failed to fork: $!"; - } + my $frozen = + "\x70\x73\x74\x30\x04\x0a\x08\x31\x32\x33\x34\x35\x36\x37\x38\x04\x08\x08\x08\x03\x39\xff\xfa\x09\x19\x08\x17\x68\x08\x08\x08\x08\xf9\x16\x16\x13\x16\x10\x10\x10\xff\x15\x16\x16\x16\x1e\x16\x16 ... [550 chars truncated] + open my $fh, '<', \$frozen; + eval { Storable::fd_retrieve($fh); }; + ok('RT 130635: No stack smashing error when retrieving hook'); } diff --git a/doio.c b/doio.c index 8ca9c4b4f4..10c4c3c6d8 100644 --- a/doio.c +++ b/doio.c @@ -2113,7 +2113,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, const Stat_t *statbufp) /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat * too so it will actually look into the files for magic numbers */ - return (mode & statbufp->st_mode) ? TRUE : FALSE; + return cBOOL(mode & statbufp->st_mode); #else /* ! DOSISH */ # ifdef __CYGWIN__ diff --git a/ext/B/B.pm b/ext/B/B.pm index ff56fe71e7..5ea96fa221 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -15,7 +15,7 @@ require Exporter; # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.67'; + $B::VERSION = '1.68'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index 310f50d469..f6fdd1e902 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1791,7 +1791,7 @@ is_empty(gv) isGV_with_GP = 1 CODE: if (ix) { - RETVAL = isGV_with_GP(gv) ? TRUE : FALSE; + RETVAL = cBOOL(isGV_with_GP(gv)); } else { RETVAL = GvGP(gv) == Null(GP*); } diff --git a/hv.c b/hv.c index 7239892099..e9d5375da4 100644 --- a/hv.c +++ b/hv.c @@ -390,7 +390,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, flags = is_utf8 ? HVhek_UTF8 : 0; } } else { - is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); + is_utf8 = cBOOL(flags & HVhek_UTF8); } if (action & HV_DELETE) { @@ -1029,7 +1029,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, HE *entry; HE **oentry; HE **first_entry; - bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE; + bool is_utf8 = cBOOL(k_flags & HVhek_UTF8); int masked_flags; HEK *keysv_hek = NULL; U8 mro_changes = 0; /* 1 = isa; 2 = package moved */ diff --git a/hv.h b/hv.h index 3a46ea3309..b6b22dfd76 100644 --- a/hv.h +++ b/hv.h @@ -461,8 +461,7 @@ C<SV*>. (val), (hash))) #define hv_exists_ent(hv, keysv, hash) \ - (hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash)) \ - ? TRUE : FALSE) + cBOOL(hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash))) #define hv_fetch_ent(hv, keysv, lval, hash) \ ((HE *) hv_common((hv), (keysv), NULL, 0, 0, \ ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash))) @@ -483,8 +482,7 @@ C<SV*>. #define hv_exists(hv, key, klen) \ - (hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0) \ - ? TRUE : FALSE) + cBOOL(hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0)) #define hv_fetch(hv, key, klen, lval) \ ((SV**) hv_common_key_len((hv), (key), (klen), (lval) \ diff --git a/locale.c b/locale.c index 8521ffd398..5c1c552523 100644 --- a/locale.c +++ b/locale.c @@ -960,9 +960,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) #endif #ifdef DEBUGGING - DEBUG_INITIALIZATION_set((PerlEnv_getenv("PERL_DEBUG_LOCALE_INIT")) - ? TRUE - : FALSE); + DEBUG_INITIALIZATION_set(cBOOL(PerlEnv_getenv("PERL_DEBUG_LOCALE_INIT"))); # define DEBUG_LOCALE_INIT(category, locale, result) \ STMT_START { \ if (debug_initialization) { \ diff --git a/mathoms.c b/mathoms.c index 92cd77a3c7..66f2cc3768 100644 --- a/mathoms.c +++ b/mathoms.c @@ -865,8 +865,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) { PERL_ARGS_ASSERT_HV_EXISTS_ENT; - return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash) - ? TRUE : FALSE; + return cBOOL(hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)); } HE * @@ -927,8 +926,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) klen = klen_i32; flags = 0; } - return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0) - ? TRUE : FALSE; + return cBOOL(hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)); } SV** diff --git a/mg.c b/mg.c index 75196fa5d7..172127c865 100644 --- a/mg.c +++ b/mg.c @@ -1008,7 +1008,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; case '\027': /* ^W & $^WARNING_BITS */ if (nextchar == '\0') - sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE)); + sv_setiv(sv, (IV)cBOOL(PL_dowarn & G_WARN_ON)); else if (strEQ(remaining, "ARNING_BITS")) { if (PL_compiling.cop_warnings == pWARN_NONE) { sv_setpvn(sv, WARN_NONEstring, WARNsize) ; diff --git a/perl.h b/perl.h index d832db4531..867c30050d 100644 --- a/perl.h +++ b/perl.h @@ -3793,7 +3793,7 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) # define USEMYBINMODE /**/ # include <io.h> /* for setmode() prototype */ # define my_binmode(fp, iotype, mode) \ - (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE) + cBOOL(PerlLIO_setmode(fileno(fp), mode) != -1) #endif #ifdef __CYGWIN__ diff --git a/perlio.c b/perlio.c index ad1c6fef21..79cdc2700d 100644 --- a/perlio.c +++ b/perlio.c @@ -1314,7 +1314,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) (for example :unix which is never going to call them) it can do the flush when it is pushed. */ - return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE; + return cBOOL(PerlIO_apply_layers(aTHX_ f, NULL, names) == 0); } else { /* Fake 5.6 legacy of using this call to turn ON O_TEXT */ @@ -1355,7 +1355,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) /* Legacy binmode is now _defined_ as being equivalent to pushing :raw So code that used to be here is now in PerlIORaw_pushed(). */ - return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, NULL) ? TRUE : FALSE; + return cBOOL(PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, NULL)); } } diff --git a/regexp.h b/regexp.h index ed8c7fe8b4..601a214207 100644 --- a/regexp.h +++ b/regexp.h @@ -270,7 +270,7 @@ and check for NULL. */ #define SvRX(sv) (Perl_get_re_arg(aTHX_ sv)) -#define SvRXOK(sv) (Perl_get_re_arg(aTHX_ sv) ? TRUE : FALSE) +#define SvRXOK(sv) cBOOL(Perl_get_re_arg(aTHX_ sv)) /* Flags stored in regexp->extflags diff --git a/toke.c b/toke.c index 0e02fd51cf..3a603e1da2 100644 --- a/toke.c +++ b/toke.c @@ -2143,7 +2143,7 @@ Perl_str_to_version(pTHX_ SV *sv) STRLEN len; const char *start = SvPV_const(sv,len); const char * const end = start + len; - const bool utf = SvUTF8(sv) ? TRUE : FALSE; + const bool utf = cBOOL(SvUTF8(sv)); PERL_ARGS_ASSERT_STR_TO_VERSION; @@ -5220,7 +5220,7 @@ Perl_yylex(pTHX) } do { fake_eof = 0; - bof = PL_rsfp ? TRUE : FALSE; + bof = cBOOL(PL_rsfp); if (0) { fake_eof: fake_eof = LEX_FAKE_EOF; -- Perl5 Master Repository
