Patch origin: upstream

Patch status: will be part of next version

Synthesis of:

http://svn.apache.org/viewvc?view=revision&revision=1455340

http://svn.apache.org/viewvc?view=revision&revision=1457619

See also:

https://rt.cpan.org/Public/Bug/Display.html?id=83916

https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=702821

--- a/t/response/TestPerl/hash_attack.pm	2013-03-15 13:35:14.000000000 +0000

+++ b/t/response/TestPerl/hash_attack.pm	2013-03-15 13:38:29.000000000 +0000

@@ -5,10 +5,11 @@

 # 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 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_(SPLIT|REHASH)

 use constant START     => "a";

 # create conditions which will trigger a rehash on the current stash

@@ -57,6 +58,8 @@

     return Apache2::Const::OK;

 }

+sub buckets { scalar(%{$_[0]}) =~ m#/([0-9]+)\z# ? 0+$1 : 8 }

+

 sub attack {

     my $stash = shift;

@@ -74,9 +77,9 @@

     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 +93,7 @@

         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 +101,24 @@

         $s++;

     }

+    # If the rehash hasn't been triggered yet, it's being delayed until the

+    # next bucket split.  Add keys until a split occurs.

+    unless (Internals::HvREHASH(%$stash)) {

+        debug "Will add padding keys until hash split";

+        my $old_buckets = buckets($stash);

+        while (buckets($stash) == $old_buckets) {

+            next if exists $stash->{$s};

+            $h = hash($s);

+            $c++;

+            $stash->{$s}++;

+            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);

+            $s++;

+        }

+    }

+

     # 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 +129,12 @@

     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