In perl.git, the branch maint-5.8 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2674b61957c26a4924831d5110afa454ae7ae5a6?hp=03fe696d61d94bd59d878a9f81b0af85465d7e1e>
- Log ----------------------------------------------------------------- commit 2674b61957c26a4924831d5110afa454ae7ae5a6 Author: Yves Orton <[email protected]> Date: Tue Feb 12 10:53:05 2013 +0100 Prevent premature hsplit() calls, and only trigger REHASH after hsplit() Triggering a hsplit due to long chain length allows an attacker to create a carefully chosen set of keys which can cause the hash to use 2 * (2**32) * sizeof(void *) bytes ram. AKA a DOS via memory exhaustion. Doing so also takes non trivial time. Eliminating this check, and only inspecting chain length after a normal hsplit() (triggered when keys>buckets) prevents the attack entirely, and makes such attacks relatively benign. (cherry picked from commit f14269908e5f8b4cab4b55643d7dd9de577e7918) (which was itself cherry picked from commit f2a571dae7d70f7e3b59022834d8003ecd2df884) (which was itself cherry picked (with changes) from commit f1220d61455253b170e81427c9d0357831ca0fac) M hv.c M t/op/hash.t commit d327d01be059078a0f4dd9e2f675f7b4d867764a Author: Andy Dougherty <[email protected]> Date: Wed Jan 16 12:30:43 2013 -0500 Avoid wraparound when casting unsigned size_t to signed ssize_t. Practically, this only affects a perl compiled with 64-bit IVs on a 32-bit system. In that instance a value of count >= 2**31 would turn negative when cast to (ssize_t). (cherry picked from commit 94e529cc4d56863d7272c254a29eda2b002a4335) M perlio.c commit b8e030d7be30225a257a94c419bdffe8b996cbe3 Author: Yves Orton <[email protected]> Date: Thu Feb 14 08:05:37 2013 +0100 use blead linux/hints.sh M hints/linux.sh ----------------------------------------------------------------------- Summary of changes: hints/linux.sh | 53 +++++++++++++++++++++++++++++++++++++++++------------ hv.c | 26 ++++++-------------------- perlio.c | 8 ++++---- t/op/hash.t | 20 +++++++++++++++++--- 4 files changed, 68 insertions(+), 39 deletions(-) diff --git a/hints/linux.sh b/hints/linux.sh index ac264c3..a148248 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -13,11 +13,14 @@ # Updated Thu May 30 10:50:22 EDT 1996 by <[email protected]> # Updated Fri Jun 21 11:07:54 EDT 1996 -# NDBM support for ELF renabled by <[email protected]> +# NDBM support for ELF re-enabled by <[email protected]> # No version of Linux supports setuid scripts. d_suidsafe='undef' +# No version of Linux needs libutil for perl. +i_libutil='undef' + # Debian and Red Hat, and perhaps other vendors, provide both runtime and # development packages for some libraries. The runtime packages contain shared # libraries with version information in their names (e.g., libgdbm.so.1.7.3); @@ -54,6 +57,9 @@ set `echo X "$libswanted "| sed -e 's/ bsd / /' -e 's/ net / /' -e 's/ bind / /' shift libswanted="$*" +# Debian 4.0 puts ndbm in the -lgdbm_compat library. +libswanted="$libswanted gdbm_compat" + # If you have glibc, then report the version for ./myconfig bug reporting. # (Configure doesn't need to know the specific version since it just uses # gcc to load the library for all tests.) @@ -84,6 +90,11 @@ esac # Check if we're about to use Intel's ICC compiler case "`${cc:-cc} -V 2>&1`" in *"Intel(R) C++ Compiler"*|*"Intel(R) C Compiler"*) + # record the version, formats: + # icc (ICC) 10.1 20080801 + # icpc (ICC) 10.1 20080801 + # followed by a copyright on the second line + ccversion=`${cc:-cc} --version | sed -n -e 's/^icp\?c \((ICC) \)\?//p'` # This is needed for Configure's prototype checks to work correctly # The -mp flag is needed to pass various floating point related tests # The -no-gcc flag is needed otherwise, icc pretends (poorly) to be gcc @@ -143,6 +154,34 @@ case "$optimize" in ;; esac +# Ubuntu 11.04 (and later, presumably) doesn't keep most libraries +# (such as -lm) in /lib or /usr/lib. So we have to ask gcc to tell us +# where to look. We don't want gcc's own libraries, however, so we +# filter those out. +# This could be conditional on Unbuntu, but other distributions may +# follow suit, and this scheme seems to work even on rather old gcc's. +# This unconditionally uses gcc because even if the user is using another +# compiler, we still need to find the math library and friends, and I don't +# know how other compilers will cope with that situation. +# Morever, if the user has their own gcc earlier in $PATH than the system gcc, +# we don't want its libraries. So we try to prefer the system gcc +# Still, as an escape hatch, allow Configure command line overrides to +# plibpth to bypass this check. +if [ -x /usr/bin/gcc ] ; then + gcc=/usr/bin/gcc +else + gcc=gcc +fi + +case "$plibpth" in +'') plibpth=`LANG=C LC_ALL=C $gcc -print-search-dirs | grep libraries | + cut -f2- -d= | tr ':' $trnl | grep -v 'gcc' | sed -e 's:/$::'` + set X $plibpth # Collapse all entries on one line + shift + plibpth="$*" + ;; +esac + # Are we using ELF? Thanks to Kenneth Albanowski <[email protected]> # for this test. cat >try.c <<'EOM' @@ -328,7 +367,7 @@ fi cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) - ccflags="-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS $ccflags" + ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags" if echo $libswanted | grep -v pthread >/dev/null then set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` @@ -375,16 +414,6 @@ $define|true|[yY]*) ;; esac -# If we are using g++ we must use nm and force ourselves to use -# the /usr/lib/libc.a (resetting the libc below to an empty string -# makes Configure to look for the right one) because the symbol -# scanning tricks of Configure will crash and burn horribly. -case "$cc" in -*g++*) usenm=true - libc='' - ;; -esac - # If using g++, the Configure scan for dlopen() and (especially) # dlerror() might fail, easier just to forcibly hint them in. case "$cc" in diff --git a/hv.c b/hv.c index 030db74..0d15a40 100644 --- a/hv.c +++ b/hv.c @@ -31,7 +31,8 @@ holds the key and hash value. #define PERL_HASH_INTERNAL_ACCESS #include "perl.h" -#define HV_MAX_LENGTH_BEFORE_SPLIT 14 +#define HV_MAX_LENGTH_BEFORE_REHASH 14 +#define SHOULD_DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */ STATIC void S_more_he(pTHX) @@ -705,23 +706,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if (!counter) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - } else if (xhv->xhv_keys > (IV)xhv->xhv_max) { + } else if ( SHOULD_DO_HSPLIT(xhv) ) { hsplit(hv); - } else if(!HvREHASH(hv)) { - U32 n_links = 1; - - while ((counter = HeNEXT(counter))) - n_links++; - - if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) { - /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit - bucket splits on a rehashed hash, as we're not going to - split it again, and if someone is lucky (evil) enough to - get all the keys in one list they could exhaust our memory - as we repeatedly double the number of buckets on every - entry. Linear search feels a less worse thing to do. */ - hsplit(hv); - } } } @@ -1048,7 +1034,7 @@ S_hsplit(pTHX_ HV *hv) /* Pick your policy for "hashing isn't working" here: */ - if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */ + if (longest_chain <= HV_MAX_LENGTH_BEFORE_REHASH /* split worked? */ || HvREHASH(hv)) { return; } @@ -1966,8 +1952,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if (!next) { /* initial entry? */ xhv->xhv_fill++; /* HvFILL(hv)++ */ - } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) { - hsplit(PL_strtab); + } else if ( SHOULD_DO_HSPLIT(xhv) ) { + hsplit(PL_strtab); } } diff --git a/perlio.c b/perlio.c index b54b9b1..35379e3 100644 --- a/perlio.c +++ b/perlio.c @@ -2125,7 +2125,7 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) SSize_t avail = PerlIO_get_cnt(f); SSize_t take = 0; if (avail > 0) - take = ((SSize_t)count < avail) ? (SSize_t)count : avail; + take = (((SSize_t) count >= 0) && ((SSize_t)count < avail)) ? (SSize_t)count : avail; if (take > 0) { STDCHAR *ptr = PerlIO_get_ptr(f); Copy(ptr, buf, take, STDCHAR); @@ -3936,7 +3936,7 @@ PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) */ b->posn -= b->bufsiz; } - if (avail > (SSize_t) count) { + if ((SSize_t) count >= 0 && avail > (SSize_t) count) { /* * If we have space for more than count, just move count */ @@ -3986,7 +3986,7 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } while (count > 0) { SSize_t avail = b->bufsiz - (b->ptr - b->buf); - if ((SSize_t) count < avail) + if ((SSize_t) count >= 0 && (SSize_t) count < avail) avail = count; if (flushptr > buf && flushptr <= buf + avail) avail = flushptr - buf; @@ -4262,7 +4262,7 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { SSize_t avail = PerlIO_get_cnt(f); SSize_t got = 0; - if ((SSize_t)count < avail) + if ((SSize_t) count >= 0 && (SSize_t)count < avail) avail = count; if (avail > 0) got = PerlIOBuf_read(aTHX_ f, vbuf, avail); diff --git a/t/op/hash.t b/t/op/hash.t index 9bde518..45eb782 100644 --- a/t/op/hash.t +++ b/t/op/hash.t @@ -39,22 +39,36 @@ use constant THRESHOLD => 14; use constant START => "a"; # some initial hash data -my %h2 = map {$_ => 1} 'a'..'cc'; +my %h2; +my $counter= "a"; +$h2{$counter++}++ while $counter ne 'cd'; ok (!Internals::HvREHASH(%h2), "starting with pre-populated non-pathological hash (rehash flag if off)"); my @keys = get_keys(\%h2); +my $buckets= buckets(\%h2); $h2{$_}++ for @keys; +$h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split ok (Internals::HvREHASH(%h2), - scalar(@keys) . " colliding into the same bucket keys are triggering rehash"); + scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split"); + +# returns the number of buckets in a hash +sub buckets { + my $hr = shift; + my $keys_buckets= scalar(%$hr); + if ($keys_buckets=~m!/([0-9]+)\z!) { + return 0+$1; + } else { + return 8; + } +} sub get_keys { my $hr = shift; # the minimum of bits required to mount the attack on a hash my $min_bits = log(THRESHOLD)/log(2); - # if the hash has already been populated with a significant amount # of entries the number of mask bits can be higher my $keys = scalar keys %$hr; -- Perl5 Master Repository
