perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From steve...@apache.org
Subject svn commit: r1455340 - in /perl/modperl/trunk: Changes t/response/TestPerl/hash_attack.pm
Date Mon, 11 Mar 2013 21:38:15 GMT
Author: stevehay
Date: Mon Mar 11 21:38:15 2013
New Revision: 1455340

URL: http://svn.apache.org/r1455340
Log:
Fix t/perl/hash_attack.t to work with Perl 5.14.4, 5.16.3 etc, which contain a fix for CVE-2013-1667
(memory exhaustion with arbitrary hash keys). This resolves rt.perl.org #116863, from where
the patch by Hugo van der Sanden was taken (with a minor edit in a comment by the committer).
Tested by the committer on Windows 7 x64 with VC++ 2010 using Perls 5.14.3, 5.14.4, 5.16.2
and 5.16.3-RC1, all against Apache 2.2.22.

Modified:
    perl/modperl/trunk/Changes
    perl/modperl/trunk/t/response/TestPerl/hash_attack.pm

Modified: perl/modperl/trunk/Changes
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/Changes?rev=1455340&r1=1455339&r2=1455340&view=diff
==============================================================================
--- perl/modperl/trunk/Changes (original)
+++ perl/modperl/trunk/Changes Mon Mar 11 21:38:15 2013
@@ -12,6 +12,11 @@ Also refer to the Apache::Test changes l
 
 =item 2.0.8-dev
 
+Fix t/perl/hash_attack.t to work with Perl 5.14.4, 5.16.3 etc, which
+contain a fix for CVE-2013-1667 (memory exhaustion with arbitrary hash
+keys). This resolves rt.perl.org #116863, from where the patch was taken.
+[Hugo van der Sanden]
+
 use APR::Finfo instead of Perl's stat() in ModPerl::RegistryCooker to
 generate HTTP code 404 even if the requested filename contains newlines
 [Torsten]

Modified: perl/modperl/trunk/t/response/TestPerl/hash_attack.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/t/response/TestPerl/hash_attack.pm?rev=1455340&r1=1455339&r2=1455340&view=diff
==============================================================================
--- perl/modperl/trunk/t/response/TestPerl/hash_attack.pm (original)
+++ perl/modperl/trunk/t/response/TestPerl/hash_attack.pm Mon Mar 11 21:38:15 2013
@@ -5,10 +5,11 @@ package TestPerl::hash_attack;
 # and fixup handlers in this test). Moreover it must not fail to find
 # that entry on the subsequent requests.
 #
-# the hash attack is detected when HV_MAX_LENGTH_BEFORE_SPLIT keys
-# find themselves in the same hash bucket, in which case starting from
-# 5.8.2 the hash will rehash all its keys using a random hash seed
-# (PL_new_hash_seed, set in mod_perl or via PERL_HASH_SEED environment
+# the hash attack is detected when HV_MAX_LENGTH_BEFORE_REHASH keys find
+# themselves in the same hash bucket on splitting (which happens when the
+# number of keys crosses the threshold of a power of 2), in which case
+# starting from 5.8.2 the hash will rehash all its keys using a random hash
+# seed (PL_new_hash_seed, set in mod_perl or via PERL_HASH_SEED environment
 # variable)
 #
 # Prior to the attack condition hashes use the PL_hash_seed, which is
@@ -29,7 +30,7 @@ use Math::BigInt;
 
 use constant MASK_U32  => 2**32;
 use constant HASH_SEED => 0; # 5.8.2: always zero before the rehashing
-use constant THRESHOLD => 14; #define HV_MAX_LENGTH_BEFORE_SPLIT
+use constant THRESHOLD => 14; #define HV_MAX_LENGTH_BEFORE_REHASH
 use constant START     => "a";
 
 # create conditions which will trigger a rehash on the current stash
@@ -74,9 +75,9 @@ sub attack {
     my $bits = $keys ? log($keys)/log(2) : 0;
     $bits = $min_bits if $min_bits > $bits;
 
-    $bits = int($bits) < $bits ? int($bits) + 1 : int($bits);
-    # need to add 2 bits to cover the internal split cases
-    $bits += 2;
+    $bits = ceil($bits);
+    # need to add 3 bits to cover the internal split cases
+    $bits += 3;
     my $mask = 2**$bits-1;
     debug "mask: $mask ($bits)";
 
@@ -90,7 +91,7 @@ sub attack {
         next unless ($h & $mask) == 0;
         $c++;
         $stash->{$s}++;
-        debug sprintf "%2d: %5s, %10s, %s", $c, $s, $h, scalar(%$stash);
+        debug sprintf "%2d: %5s, %08x %s", $c, $s, $h, scalar(%$stash);
         push @keys, $s;
         debug "The hash collision attack has been successful"
             if Internals::HvREHASH(%$stash);
@@ -98,6 +99,14 @@ sub attack {
         $s++;
     }
 
+    # Now add more keys until we reach a power of 2, to force the number
+    # of buckets to be doubled (at which point the longest chain is checked).
+    $keys = scalar keys %$stash;
+    $bits = log($keys)/log(2);
+    my $limit = 2 ** ceil($bits);
+    debug "pad keys from $keys to $limit";
+    $stash->{$s++}++ while keys(%$stash) <= $limit;
+
     # this verifies that the attack was mounted successfully. If
     # HvREHASH is on it is. Otherwise the sequence wasn't successful.
     die "Failed to mount the hash collision attack"
@@ -108,6 +117,12 @@ sub attack {
     return @keys;
 }
 
+# least integer >= n
+sub ceil {
+    my $value = shift;
+    return int($value) < $value ? int($value) + 1 : int($value);
+}
+
 # trying to provide the fastest equivalent of C macro's PERL_HASH in
 # Perl - the main complication is that the C macro uses U32 integer
 # (unsigned int), which we can't do it Perl (it can do I32, with 'use



Mime
View raw message