Patch origin: upstream

Patch status: will be part of next version

Synthesis of:

See also:

--- 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