components/apache2-modules/mod_perl/patches/hattack_synthesis.patch
author Petr Sumbera <petr.sumbera@oracle.com>
Thu, 18 Dec 2014 06:53:52 -0800
changeset 3563 a34ad418afb9
permissions -rw-r--r--
20229478 mod_perl test suite wouldn't start/pass due number of reasons

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